projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix Trac #3263: don't print Hpc tick stuff unless -dppr-debug is on
[ghc-hetmet.git]
/
compiler
/
cmm
/
CmmParse.y
diff --git
a/compiler/cmm/CmmParse.y
b/compiler/cmm/CmmParse.y
index
180aad6
..
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
@@
-52,6
+52,7
@@
import FastString
import Panic
import Constants
import Outputable
import Panic
import Constants
import Outputable
+import BasicTypes
import Bag ( emptyBag, unitBag )
import Control.Monad
import Bag ( emptyBag, unitBag )
import Control.Monad
@@
-62,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 ';') }
@@
-202,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)
+ 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) [] [] [] }
@@
-824,7
+827,7
@@
newLocal ty name = do
-- PIC code for them.
newImport :: FastString -> ExtFCode ()
newImport name
-- 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
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
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))