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
-- 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
{- 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.)
( "gtu", MO_U_Gt ),
( "ltu", MO_U_Lt ),
- ( "flt", MO_S_Lt ),
- ( "fle", MO_S_Le ),
- ( "feq", MO_Eq ),
- ( "fne", MO_Ne ),
- ( "fgt", MO_S_Gt ),
- ( "fge", MO_S_Ge ),
- ( "fneg", MO_S_Neg ),
-
- ( "and", MO_And ),
+ ( "and", MO_And ),
( "or", MO_Or ),
( "xor", MO_Xor ),
( "com", MO_Not ),
( "shrl", MO_U_Shr ),
( "shra", MO_S_Shr ),
- ( "lobits8", flip MO_UU_Conv W8 ),
+ ( "fadd", MO_F_Add ),
+ ( "fsub", MO_F_Sub ),
+ ( "fneg", MO_F_Neg ),
+ ( "fmul", MO_F_Mul ),
+ ( "fquot", MO_F_Quot ),
+
+ ( "feq", MO_F_Eq ),
+ ( "fne", MO_F_Ne ),
+ ( "fge", MO_F_Ge ),
+ ( "fle", MO_F_Le ),
+ ( "fgt", MO_F_Gt ),
+ ( "flt", MO_F_Lt ),
+
+ ( "lobits8", flip MO_UU_Conv W8 ),
( "lobits16", flip MO_UU_Conv W16 ),
( "lobits32", flip MO_UU_Conv W32 ),
( "lobits64", flip MO_UU_Conv W64 ),
+More notes (May 11)\r
+~~~~~~~~~~~~~~~~~~~\r
+In CmmNode, consider spliting CmmCall into two: call and jump\r
+\r
Notes on new codegen (Aug 10)\r
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\r
\r
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
\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
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
pprReg archWordSize reg2
]
-
pprCondRegReg :: LitString -> Size -> Cond -> Reg -> Reg -> Doc
pprCondRegReg name size cond reg1 reg2
= hcat [
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
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) }
#include "LdvProfile.h"
#include "Arena.h"
#include "Printer.h"
+#include "sm/GCThread.h"
#include <string.h>
void
heapCensus( void )
{
- nat g;
+ nat g, n;
Census *census;
+ gen_workspace *ws;
census = &censuses[era];
census->time = mut_user_time();
// 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
recent_activity = ACTIVITY_YES;
}
+ if (heap_census) {
+ debugTrace(DEBUG_sched, "performing heap census");
+ heapCensus();
+ performHeapProfile = rtsFalse;
+ }
+
#if defined(THREADED_RTS)
if (gc_type == PENDING_GC_PAR)
{
}
#endif
- if (heap_census) {
- debugTrace(DEBUG_sched, "performing heap census");
- heapCensus();
- performHeapProfile = rtsFalse;
- }
-
if (heap_overflow && sched_state < SCHED_INTERRUPTING) {
// GC set the heap_overflow flag, so we should proceed with
// an orderly shutdown now. Ultimately we want the main
gc_elapsed += GC_coll_elapsed[i];
}
+ init_cpu = end_init_cpu - start_init_cpu;
+ init_elapsed = end_init_elapsed - start_init_elapsed;
+
+ exit_cpu = end_exit_cpu - start_exit_cpu;
+ exit_elapsed = end_exit_elapsed - start_exit_elapsed;
+
+ mut_elapsed = start_exit_elapsed - end_init_elapsed - gc_elapsed;
+
+ mut_cpu = start_exit_cpu - end_init_cpu - gc_cpu
+ - PROF_VAL(RP_tot_time + HC_tot_time);
+ if (mut_cpu < 0) { mut_cpu = 0; }
+
if (RtsFlags.GcFlags.giveStats >= SUMMARY_GC_STATS) {
showStgWord64(GC_tot_alloc*sizeof(W_),
temp, rtsTrue/*commas*/);
}
#endif
- init_cpu = end_init_cpu - start_init_cpu;
- init_elapsed = end_init_elapsed - start_init_elapsed;
-
- exit_cpu = end_exit_cpu - start_exit_cpu;
- exit_elapsed = end_exit_elapsed - start_exit_elapsed;
-
statsPrintf(" INIT time %6.2fs (%6.2fs elapsed)\n",
TICK_TO_DBL(init_cpu), TICK_TO_DBL(init_elapsed));
- mut_elapsed = start_exit_elapsed - end_init_elapsed - gc_elapsed;
-
- mut_cpu = start_exit_cpu - end_init_cpu - gc_cpu
- - PROF_VAL(RP_tot_time + HC_tot_time);
- if (mut_cpu < 0) { mut_cpu = 0; }
-
statsPrintf(" MUT time %6.2fs (%6.2fs elapsed)\n",
TICK_TO_DBL(mut_cpu), TICK_TO_DBL(mut_elapsed));
statsPrintf(" GC time %6.2fs (%6.2fs elapsed)\n",
projects / ghc-hetmet.git / commitdiff