From: Jose Pedro Magalhaes Date: Tue, 10 May 2011 06:12:21 +0000 (+0200) Subject: Merge branch 'master' of http://darcs.haskell.org/ghc into ghc-generics X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=9e4c8ad32eff3bf0350480109b2f5a5ad4738f09;hp=61d89bc49eb75d74ed9196ba5f7b7b32018b914b Merge branch 'master' of darcs.haskell.org/ghc into ghc-generics --- diff --git a/compiler/cmm/CmmNode.hs b/compiler/cmm/CmmNode.hs index e67321c..ee948fe 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 e787f18..c0ccadf 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 8071da7..37cbc2d 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 9c88783..dd33cae 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 a9ed036..38b6344 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 46eef67..88e0462 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 9bd707f..7d2a450 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 @@ -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