summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/cmm/CmmNode.hs28
-rw-r--r--compiler/cmm/cmm-notes4
-rw-r--r--compiler/deSugar/Coverage.lhs9
-rw-r--r--compiler/hsSyn/HsExpr.lhs10
-rw-r--r--compiler/nativeGen/X86/Ppr.hs14
-rw-r--r--compiler/rename/RnExpr.lhs2
-rw-r--r--rts/ProfHeap.c11
7 files changed, 63 insertions, 15 deletions
diff --git a/compiler/cmm/CmmNode.hs b/compiler/cmm/CmmNode.hs
index e67321c0b0..ee948fe7ea 100644
--- a/compiler/cmm/CmmNode.hs
+++ b/compiler/cmm/CmmNode.hs
@@ -30,31 +30,51 @@ import Prelude hiding (succ)
data CmmNode e x where
CmmEntry :: Label -> CmmNode C O
+
CmmComment :: FastString -> CmmNode O O
+
CmmAssign :: CmmReg -> CmmExpr -> CmmNode O O -- Assign to register
+
CmmStore :: CmmExpr -> CmmExpr -> CmmNode O O -- Assign to memory location. Size is
-- given by cmmExprType of the rhs.
+
CmmUnsafeForeignCall :: -- An unsafe foreign call; see Note [Foreign calls]
+ -- Like a "fat machine instruction"; can occur
+ -- in the middle of a block
ForeignTarget -> -- call target
CmmFormals -> -- zero or more results
CmmActuals -> -- zero or more arguments
CmmNode O O
+ -- Semantics: kills only result regs; all other regs (both GlobalReg
+ -- and LocalReg) are preserved
+
CmmBranch :: Label -> CmmNode O C -- Goto another block in the same procedure
+
CmmCondBranch :: { -- conditional branch
cml_pred :: CmmExpr,
cml_true, cml_false :: Label
} -> CmmNode O C
+
CmmSwitch :: CmmExpr -> [Maybe Label] -> CmmNode O C -- Table branch
-- The scrutinee is zero-based;
-- zero -> first block
-- one -> second block etc
-- Undefined outside range, and when there's a Nothing
- CmmCall :: { -- A call (native or safe foreign)
+
+ CmmCall :: { -- A native call or tail call
cml_target :: CmmExpr, -- never a CmmPrim to a CallishMachOp!
cml_cont :: Maybe Label,
-- Label of continuation (Nothing for return or tail call)
+-- ToDO: add this:
+-- cml_args_regs :: [GlobalReg],
+-- It says which GlobalRegs are live for the parameters at the
+-- moment of the call. Later stages can use this to give liveness
+-- everywhere, which in turn guides register allocation.
+-- It is the companion of cml_args; cml_args says which stack words
+-- hold parameters, while cml_arg_regs says which global regs hold parameters
+
cml_args :: ByteOff,
-- Byte offset, from the *old* end of the Area associated with
-- the Label (if cml_cont = Nothing, then Old area), of
@@ -78,7 +98,9 @@ data CmmNode e x where
-- cml_ret_off are treated as live, even if the sequel of
-- the call goes into a loop.
} -> CmmNode O C
+
CmmForeignCall :: { -- A safe foreign call; see Note [Foreign calls]
+ -- Always the last node of a block
tgt :: ForeignTarget, -- call target and convention
res :: CmmFormals, -- zero or more results
args :: CmmActuals, -- zero or more arguments
@@ -89,8 +111,8 @@ data CmmNode e x where
{- Note [Foreign calls]
~~~~~~~~~~~~~~~~~~~~~~~
-A MidForeign call is used for *unsafe* foreign calls;
-a LastForeign call is used for *safe* foreign calls.
+A CmmUnsafeForeignCall is used for *unsafe* foreign calls;
+a CmmForeignCall call is used for *safe* foreign calls.
Unsafe ones are easy: think of them as a "fat machine instruction".
In particular, they do *not* kill all live registers (there was a bit
of code in GHC that conservatively assumed otherwise.)
diff --git a/compiler/cmm/cmm-notes b/compiler/cmm/cmm-notes
index e787f18b17..c0ccadfbec 100644
--- a/compiler/cmm/cmm-notes
+++ b/compiler/cmm/cmm-notes
@@ -1,3 +1,7 @@
+More notes (May 11)
+~~~~~~~~~~~~~~~~~~~
+In CmmNode, consider spliting CmmCall into two: call and jump
+
Notes on new codegen (Aug 10)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs
index 8071da756f..37cbc2d5c5 100644
--- a/compiler/deSugar/Coverage.lhs
+++ b/compiler/deSugar/Coverage.lhs
@@ -608,9 +608,12 @@ addTickCmdGRHSs (GRHSs guarded local_binds) = do
binders = collectLocalBinders local_binds
addTickCmdGRHS :: GRHS Id -> TM (GRHS Id)
-addTickCmdGRHS (GRHS stmts cmd) = do
- (stmts',expr') <- addTickLCmdStmts' stmts (addTickLHsCmd cmd)
- return $ GRHS stmts' expr'
+-- The *guards* are *not* Cmds, although the body is
+-- C.f. addTickGRHS for the BinBox stuff
+addTickCmdGRHS (GRHS stmts cmd)
+ = do { (stmts',expr') <- addTickLStmts' (Just $ BinBox $ GuardBinBox)
+ stmts (addTickLHsCmd cmd)
+ ; return $ GRHS stmts' expr' }
addTickLCmdStmts :: [LStmt Id] -> TM [LStmt Id]
addTickLCmdStmts stmts = do
diff --git a/compiler/hsSyn/HsExpr.lhs b/compiler/hsSyn/HsExpr.lhs
index 9c88783dd2..dd33cae373 100644
--- a/compiler/hsSyn/HsExpr.lhs
+++ b/compiler/hsSyn/HsExpr.lhs
@@ -1274,10 +1274,12 @@ data HsStmtContext id
\begin{code}
isListCompExpr :: HsStmtContext id -> Bool
-- Uses syntax [ e | quals ]
-isListCompExpr ListComp = True
-isListCompExpr PArrComp = True
-isListCompExpr MonadComp = True
-isListCompExpr _ = False
+isListCompExpr ListComp = True
+isListCompExpr PArrComp = True
+isListCompExpr MonadComp = True
+isListCompExpr (ParStmtCtxt c) = isListCompExpr c
+isListCompExpr (TransStmtCtxt c) = isListCompExpr c
+isListCompExpr _ = False
isMonadCompExpr :: HsStmtContext id -> Bool
isMonadCompExpr MonadComp = True
diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs
index a9ed03610e..38b6344950 100644
--- a/compiler/nativeGen/X86/Ppr.hs
+++ b/compiler/nativeGen/X86/Ppr.hs
@@ -642,8 +642,8 @@ pprInstr (FDIV size op1 op2) = pprSizeOpOp (sLit "div") size op1 op2
pprInstr (CVTSS2SD from to) = pprRegReg (sLit "cvtss2sd") from to
pprInstr (CVTSD2SS from to) = pprRegReg (sLit "cvtsd2ss") from to
-pprInstr (CVTTSS2SIQ sz from to) = pprSizeOpReg (sLit "cvttss2si") sz from to
-pprInstr (CVTTSD2SIQ sz from to) = pprSizeOpReg (sLit "cvttsd2si") sz from to
+pprInstr (CVTTSS2SIQ sz from to) = pprSizeSizeOpReg (sLit "cvttss2si") FF32 sz from to
+pprInstr (CVTTSD2SIQ sz from to) = pprSizeSizeOpReg (sLit "cvttsd2si") FF64 sz from to
pprInstr (CVTSI2SS sz from to) = pprSizeOpReg (sLit "cvtsi2ss") sz from to
pprInstr (CVTSI2SD sz from to) = pprSizeOpReg (sLit "cvtsi2sd") sz from to
@@ -1094,7 +1094,6 @@ pprSizeOpReg name size op1 reg2
pprReg archWordSize reg2
]
-
pprCondRegReg :: LitString -> Size -> Cond -> Reg -> Reg -> Doc
pprCondRegReg name size cond reg1 reg2
= hcat [
@@ -1116,11 +1115,18 @@ pprSizeSizeRegReg name size1 size2 reg1 reg2
pprSize size2,
space,
pprReg size1 reg1,
-
comma,
pprReg size2 reg2
]
+pprSizeSizeOpReg :: LitString -> Size -> Size -> Operand -> Reg -> Doc
+pprSizeSizeOpReg name size1 size2 op1 reg2
+ = hcat [
+ pprMnemonic name size2,
+ pprOperand size1 op1,
+ comma,
+ pprReg size2 reg2
+ ]
pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
pprSizeRegRegReg name size reg1 reg2 reg3
diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
index 46eef670f2..88e0462e74 100644
--- a/compiler/rename/RnExpr.lhs
+++ b/compiler/rename/RnExpr.lhs
@@ -694,6 +694,8 @@ rnStmt ctxt (L loc (ExprStmt expr _ _ _)) thing_inside
then lookupStmtName ctxt guardMName
else return (noSyntaxExpr, emptyFVs)
-- Only list/parr/monad comprehensions use 'guard'
+ -- Also for sub-stmts of same eg [ e | x<-xs, gd | blah ]
+ -- Here "gd" is a guard
; (thing, fvs3) <- thing_inside []
; return (([L loc (ExprStmt expr' then_op guard_op placeHolderType)], thing),
fv_expr `plusFV` fvs1 `plusFV` fvs2 `plusFV` fvs3) }
diff --git a/rts/ProfHeap.c b/rts/ProfHeap.c
index 9bd707fb2a..7d2a450129 100644
--- a/rts/ProfHeap.c
+++ b/rts/ProfHeap.c
@@ -18,6 +18,7 @@
#include "LdvProfile.h"
#include "Arena.h"
#include "Printer.h"
+#include "sm/GCThread.h"
#include <string.h>
@@ -1057,8 +1058,9 @@ heapCensusChain( Census *census, bdescr *bd )
void
heapCensus( void )
{
- nat g;
+ nat g, n;
Census *census;
+ gen_workspace *ws;
census = &censuses[era];
census->time = mut_user_time();
@@ -1080,6 +1082,13 @@ heapCensus( void )
// Are we interested in large objects? might be
// confusing to include the stack in a heap profile.
heapCensusChain( census, generations[g].large_objects );
+
+ for (n = 0; n < n_capabilities; n++) {
+ ws = &gc_threads[n]->gens[g];
+ heapCensusChain(census, ws->todo_bd);
+ heapCensusChain(census, ws->part_list);
+ heapCensusChain(census, ws->scavd_list);
+ }
}
// dump out the census info
View Lorry Controller Status