Commit 0f085f36 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Merge branch 'master' of http://darcs.haskell.org/ghc

parents f450d36a 32841172
......@@ -163,7 +163,7 @@ cmmMiniInlineStmts dflags uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr)
-- used (literal): try to inline at all the use sites
| Just n <- lookupUFM uses u, isLit expr
=
ncgDebugTrace ("nativeGen: inlining " ++ showSDoc dflags (pprStmt platform stmt)) $
ncgDebugTrace ("nativeGen: inlining " ++ showSDoc dflags (pprStmt stmt)) $
case lookForInlineLit u expr stmts of
(m, stmts')
| n == m -> cmmMiniInlineStmts dflags (delFromUFM uses u) stmts'
......@@ -174,7 +174,7 @@ cmmMiniInlineStmts dflags uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr)
| Just n <- lookupUFM uses u,
e@(CmmLit _) <- wrapRecExp foldExp expr
=
ncgDebugTrace ("nativeGen: inlining " ++ showSDoc dflags (pprStmt platform stmt)) $
ncgDebugTrace ("nativeGen: inlining " ++ showSDoc dflags (pprStmt stmt)) $
case lookForInlineLit u e stmts of
(m, stmts')
| n == m -> cmmMiniInlineStmts dflags (delFromUFM uses u) stmts'
......@@ -185,7 +185,7 @@ cmmMiniInlineStmts dflags uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr)
| Just 1 <- lookupUFM uses u,
Just stmts' <- lookForInline u expr stmts
=
ncgDebugTrace ("nativeGen: inlining " ++ showSDoc dflags (pprStmt platform stmt)) $
ncgDebugTrace ("nativeGen: inlining " ++ showSDoc dflags (pprStmt stmt)) $
cmmMiniInlineStmts dflags uses stmts'
where
platform = targetPlatform dflags
......
......@@ -48,7 +48,6 @@ import PprCmmExpr
import BasicTypes
import ForeignCall
import Outputable
import Platform
import FastString
import Data.List
......@@ -62,10 +61,10 @@ instance Outputable instr => Outputable (GenBasicBlock instr) where
ppr = pprBBlock
instance Outputable CmmStmt where
ppr s = sdocWithPlatform $ \platform -> pprStmt platform s
ppr s = pprStmt s
instance Outputable CmmInfo where
ppr i = sdocWithPlatform $ \platform -> pprInfo platform i
ppr i = pprInfo i
-- --------------------------------------------------------------------------
......@@ -81,14 +80,12 @@ instance Outputable CmmSafety where
-- For ideas on how to refine it, they used to be printed in the
-- style of C--'s 'stackdata' declaration, just inside the proc body,
-- and were labelled with the procedure name ++ "_info".
pprInfo :: Platform -> CmmInfo -> SDoc
pprInfo platform (CmmInfo _gc_target update_frame info_table) =
pprInfo :: CmmInfo -> SDoc
pprInfo (CmmInfo _gc_target update_frame info_table) =
vcat [{-ptext (sLit "gc_target: ") <>
maybe (ptext (sLit "<none>")) ppr gc_target,-}
ptext (sLit "update_frame: ") <>
maybe (ptext (sLit "<none>"))
(pprUpdateFrame platform)
update_frame,
maybe (ptext (sLit "<none>")) pprUpdateFrame update_frame,
ppr info_table]
-- --------------------------------------------------------------------------
......@@ -101,8 +98,8 @@ pprBBlock (BasicBlock ident stmts) =
-- --------------------------------------------------------------------------
-- Statements. C-- usually, exceptions to this should be obvious.
--
pprStmt :: Platform -> CmmStmt -> SDoc
pprStmt platform stmt = case stmt of
pprStmt :: CmmStmt -> SDoc
pprStmt stmt = case stmt of
-- ;
CmmNop -> semi
......@@ -122,7 +119,7 @@ pprStmt platform stmt = case stmt of
-- ToDo ppr volatile
CmmCall (CmmCallee fn cconv) results args ret ->
sep [ pp_lhs <+> pp_conv
, nest 2 (pprExpr9 platform fn <>
, nest 2 (pprExpr9 fn <>
parens (commafy (map ppr_ar args)))
, case ret of CmmMayReturn -> empty
CmmNeverReturns -> ptext $ sLit (" never returns")
......@@ -140,8 +137,7 @@ pprStmt platform stmt = case stmt of
-- Call a CallishMachOp, like sin or cos that might be implemented as a library call.
CmmCall (CmmPrim op _) results args ret ->
pprStmt platform (CmmCall (CmmCallee (CmmLit lbl) CCallConv)
results args ret)
pprStmt (CmmCall (CmmCallee (CmmLit lbl) CCallConv) results args ret)
where
-- HACK: A CallishMachOp doesn't really correspond to a ForeignLabel, but we
-- use one to get the label printed.
......@@ -151,24 +147,24 @@ pprStmt platform stmt = case stmt of
CmmBranch ident -> genBranch ident
CmmCondBranch expr ident -> genCondBranch expr ident
CmmJump expr live -> genJump platform expr live
CmmReturn -> genReturn platform
CmmSwitch arg ids -> genSwitch platform arg ids
CmmJump expr live -> genJump expr live
CmmReturn -> genReturn
CmmSwitch arg ids -> genSwitch arg ids
-- Just look like a tuple, since it was a tuple before
-- ... is that a good idea? --Isaac Dupree
instance (Outputable a) => Outputable (CmmHinted a) where
ppr (CmmHinted a k) = ppr (a, k)
pprUpdateFrame :: Platform -> UpdateFrame -> SDoc
pprUpdateFrame platform (UpdateFrame expr args) =
pprUpdateFrame :: UpdateFrame -> SDoc
pprUpdateFrame (UpdateFrame expr args) =
hcat [ ptext (sLit "jump")
, space
, if isTrivialCmmExpr expr
then pprExpr platform expr
then pprExpr expr
else case expr of
CmmLoad (CmmReg _) _ -> pprExpr platform expr
_ -> parens (pprExpr platform expr)
CmmLoad (CmmReg _) _ -> pprExpr expr
_ -> parens (pprExpr expr)
, space
, parens ( commafy $ map ppr args ) ]
......@@ -198,15 +194,15 @@ genCondBranch expr ident =
--
-- jump foo(a, b, c);
--
genJump :: Platform -> CmmExpr -> Maybe [GlobalReg] -> SDoc
genJump platform expr live =
genJump :: CmmExpr -> Maybe [GlobalReg] -> SDoc
genJump expr live =
hcat [ ptext (sLit "jump")
, space
, if isTrivialCmmExpr expr
then pprExpr platform expr
then pprExpr expr
else case expr of
CmmLoad (CmmReg _) _ -> pprExpr platform expr
_ -> parens (pprExpr platform expr)
CmmLoad (CmmReg _) _ -> pprExpr expr
_ -> parens (pprExpr expr)
, semi <+> ptext (sLit "// ")
, maybe empty ppr live]
......@@ -215,9 +211,8 @@ genJump platform expr live =
--
-- return (a, b, c);
--
genReturn :: Platform -> SDoc
genReturn _ =
hcat [ ptext (sLit "return") , semi ]
genReturn :: SDoc
genReturn = hcat [ ptext (sLit "return") , semi ]
-- --------------------------------------------------------------------------
-- Tabled jump to local label
......@@ -226,8 +221,8 @@ genReturn _ =
--
-- switch [0 .. n] (expr) { case ... ; }
--
genSwitch :: Platform -> CmmExpr -> [Maybe BlockId] -> SDoc
genSwitch platform expr maybe_ids
genSwitch :: CmmExpr -> [Maybe BlockId] -> SDoc
genSwitch expr maybe_ids
= let pairs = groupBy snds (zip [0 .. ] maybe_ids )
......@@ -235,8 +230,8 @@ genSwitch platform expr maybe_ids
, int (length maybe_ids - 1)
, ptext (sLit "] ")
, if isTrivialCmmExpr expr
then pprExpr platform expr
else parens (pprExpr platform expr)
then pprExpr expr
else parens (pprExpr expr)
, ptext (sLit " {")
])
4 (vcat ( map caseify pairs )) $$ rbrace
......
......@@ -32,13 +32,6 @@
-- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs
--
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details
module PprCmmDecl
( writeCmms, pprCmms, pprCmmGroup, pprSection, pprStatic
)
......@@ -75,13 +68,13 @@ writeCmms dflags handle cmms = printForC dflags handle (pprCmms cmms)
instance (Outputable d, Outputable info, Outputable i)
=> Outputable (GenCmmDecl d info i) where
ppr t = sdocWithPlatform $ \platform -> pprTop platform t
ppr t = pprTop t
instance Outputable CmmStatics where
ppr x = sdocWithPlatform $ \platform -> pprStatics platform x
instance Outputable CmmStatic where
ppr x = sdocWithPlatform $ \platform -> pprStatic platform x
ppr = pprStatic
instance Outputable CmmInfoTable where
ppr = pprInfoTable
......@@ -90,19 +83,19 @@ instance Outputable CmmInfoTable where
-----------------------------------------------------------------------------
pprCmmGroup :: (Outputable d, Outputable info, Outputable g)
=> Platform -> GenCmmGroup d info g -> SDoc
pprCmmGroup platform tops
= vcat $ intersperse blankLine $ map (pprTop platform) tops
=> GenCmmGroup d info g -> SDoc
pprCmmGroup tops
= vcat $ intersperse blankLine $ map pprTop tops
-- --------------------------------------------------------------------------
-- Top level `procedure' blocks.
--
pprTop :: (Outputable d, Outputable info, Outputable i)
=> Platform -> GenCmmDecl d info i -> SDoc
=> GenCmmDecl d info i -> SDoc
pprTop platform (CmmProc info lbl graph)
pprTop (CmmProc info lbl graph)
= vcat [ pprCLabel platform lbl <> lparen <> rparen
= vcat [ ppr lbl <> lparen <> rparen
, nest 8 $ lbrace <+> ppr info $$ rbrace
, nest 4 $ ppr graph
, rbrace ]
......@@ -112,7 +105,7 @@ pprTop platform (CmmProc info lbl graph)
--
-- section "data" { ... }
--
pprTop _ (CmmData section ds) =
pprTop (CmmData section ds) =
(hang (pprSection section <+> lbrace) 4 (ppr ds))
$$ rbrace
......@@ -124,11 +117,11 @@ pprInfoTable CmmNonInfoTable
= empty
pprInfoTable (CmmInfoTable { cit_lbl = lbl, cit_rep = rep
, cit_prof = prof_info
, cit_srt = _srt })
, cit_srt = _srt })
= vcat [ ptext (sLit "label:") <+> ppr lbl
, ptext (sLit "rep:") <> ppr rep
, case prof_info of
NoProfilingInfo -> empty
NoProfilingInfo -> empty
ProfilingInfo ct cd -> vcat [ ptext (sLit "type:") <+> pprWord8String ct
, ptext (sLit "desc: ") <> pprWord8String cd ] ]
......@@ -153,9 +146,9 @@ pprStatics :: Platform -> CmmStatics -> SDoc
pprStatics platform (Statics lbl ds)
= vcat ((pprCLabel platform lbl <> colon) : map ppr ds)
pprStatic :: Platform -> CmmStatic -> SDoc
pprStatic platform s = case s of
CmmStaticLit lit -> nest 4 $ ptext (sLit "const") <+> pprLit platform lit <> semi
pprStatic :: CmmStatic -> SDoc
pprStatic s = case s of
CmmStaticLit lit -> nest 4 $ ptext (sLit "const") <+> pprLit lit <> semi
CmmUninitialised i -> nest 4 $ text "I8" <> brackets (int i)
CmmString s' -> nest 4 $ text "I8[]" <+> text (show s')
......
......@@ -32,13 +32,6 @@
-- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs
--
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details
module PprCmmExpr
( pprExpr, pprLit
, pprExpr9 {-only to import in OldPprCmm. When it dies, remove the export -}
......@@ -46,10 +39,8 @@ module PprCmmExpr
where
import CmmExpr
import CLabel
import Outputable
import Platform
import FastString
import Data.Maybe
......@@ -58,13 +49,13 @@ import Numeric ( fromRat )
-----------------------------------------------------------------------------
instance Outputable CmmExpr where
ppr e = sdocWithPlatform $ \platform -> pprExpr platform e
ppr e = pprExpr e
instance Outputable CmmReg where
ppr e = pprReg e
instance Outputable CmmLit where
ppr l = sdocWithPlatform $ \platform -> pprLit platform l
ppr l = pprLit l
instance Outputable LocalReg where
ppr e = pprLocalReg e
......@@ -79,15 +70,15 @@ instance Outputable GlobalReg where
-- Expressions
--
pprExpr :: Platform -> CmmExpr -> SDoc
pprExpr platform e
pprExpr :: CmmExpr -> SDoc
pprExpr e
= case e of
CmmRegOff reg i ->
pprExpr platform (CmmMachOp (MO_Add rep)
[CmmReg reg, CmmLit (CmmInt (fromIntegral i) rep)])
where rep = typeWidth (cmmRegType reg)
CmmLit lit -> pprLit platform lit
_other -> pprExpr1 platform e
CmmRegOff reg i ->
pprExpr (CmmMachOp (MO_Add rep)
[CmmReg reg, CmmLit (CmmInt (fromIntegral i) rep)])
where rep = typeWidth (cmmRegType reg)
CmmLit lit -> pprLit lit
_other -> pprExpr1 e
-- Here's the precedence table from CmmParse.y:
-- %nonassoc '>=' '>' '<=' '<' '!=' '=='
......@@ -103,10 +94,10 @@ pprExpr platform e
-- a default conservative behaviour.
-- %nonassoc '>=' '>' '<=' '<' '!=' '=='
pprExpr1, pprExpr7, pprExpr8 :: Platform -> CmmExpr -> SDoc
pprExpr1 platform (CmmMachOp op [x,y]) | Just doc <- infixMachOp1 op
= pprExpr7 platform x <+> doc <+> pprExpr7 platform y
pprExpr1 platform e = pprExpr7 platform e
pprExpr1, pprExpr7, pprExpr8 :: CmmExpr -> SDoc
pprExpr1 (CmmMachOp op [x,y]) | Just doc <- infixMachOp1 op
= pprExpr7 x <+> doc <+> pprExpr7 y
pprExpr1 e = pprExpr7 e
infixMachOp1, infixMachOp7, infixMachOp8 :: MachOp -> Maybe SDoc
......@@ -121,55 +112,55 @@ infixMachOp1 (MO_U_Lt _) = Just (char '<')
infixMachOp1 _ = Nothing
-- %left '-' '+'
pprExpr7 platform (CmmMachOp (MO_Add rep1) [x, CmmLit (CmmInt i rep2)]) | i < 0
= pprExpr7 platform (CmmMachOp (MO_Sub rep1) [x, CmmLit (CmmInt (negate i) rep2)])
pprExpr7 platform (CmmMachOp op [x,y]) | Just doc <- infixMachOp7 op
= pprExpr7 platform x <+> doc <+> pprExpr8 platform y
pprExpr7 platform e = pprExpr8 platform e
pprExpr7 (CmmMachOp (MO_Add rep1) [x, CmmLit (CmmInt i rep2)]) | i < 0
= pprExpr7 (CmmMachOp (MO_Sub rep1) [x, CmmLit (CmmInt (negate i) rep2)])
pprExpr7 (CmmMachOp op [x,y]) | Just doc <- infixMachOp7 op
= pprExpr7 x <+> doc <+> pprExpr8 y
pprExpr7 e = pprExpr8 e
infixMachOp7 (MO_Add _) = Just (char '+')
infixMachOp7 (MO_Sub _) = Just (char '-')
infixMachOp7 _ = Nothing
-- %left '/' '*' '%'
pprExpr8 platform (CmmMachOp op [x,y]) | Just doc <- infixMachOp8 op
= pprExpr8 platform x <+> doc <+> pprExpr9 platform y
pprExpr8 platform e = pprExpr9 platform e
pprExpr8 (CmmMachOp op [x,y]) | Just doc <- infixMachOp8 op
= pprExpr8 x <+> doc <+> pprExpr9 y
pprExpr8 e = pprExpr9 e
infixMachOp8 (MO_U_Quot _) = Just (char '/')
infixMachOp8 (MO_Mul _) = Just (char '*')
infixMachOp8 (MO_U_Rem _) = Just (char '%')
infixMachOp8 _ = Nothing
pprExpr9 :: Platform -> CmmExpr -> SDoc
pprExpr9 platform e =
pprExpr9 :: CmmExpr -> SDoc
pprExpr9 e =
case e of
CmmLit lit -> pprLit1 platform lit
CmmLit lit -> pprLit1 lit
CmmLoad expr rep -> ppr rep <> brackets (ppr expr)
CmmReg reg -> ppr reg
CmmRegOff reg off -> parens (ppr reg <+> char '+' <+> int off)
CmmStackSlot a off -> parens (ppr a <+> char '+' <+> int off)
CmmMachOp mop args -> genMachOp platform mop args
CmmMachOp mop args -> genMachOp mop args
genMachOp :: Platform -> MachOp -> [CmmExpr] -> SDoc
genMachOp platform mop args
genMachOp :: MachOp -> [CmmExpr] -> SDoc
genMachOp mop args
| Just doc <- infixMachOp mop = case args of
-- dyadic
[x,y] -> pprExpr9 platform x <+> doc <+> pprExpr9 platform y
[x,y] -> pprExpr9 x <+> doc <+> pprExpr9 y
-- unary
[x] -> doc <> pprExpr9 platform x
[x] -> doc <> pprExpr9 x
_ -> pprTrace "PprCmm.genMachOp: machop with strange number of args"
(pprMachOp mop <+>
parens (hcat $ punctuate comma (map (pprExpr platform) args)))
parens (hcat $ punctuate comma (map pprExpr args)))
empty
| isJust (infixMachOp1 mop)
|| isJust (infixMachOp7 mop)
|| isJust (infixMachOp8 mop) = parens (pprExpr platform (CmmMachOp mop args))
|| isJust (infixMachOp8 mop) = parens (pprExpr (CmmMachOp mop args))
| otherwise = char '%' <> ppr_op <> parens (commafy (map (pprExpr platform) args))
| otherwise = char '%' <> ppr_op <> parens (commafy (map pprExpr args))
where ppr_op = text (map (\c -> if c == ' ' then '_' else c)
(show mop))
-- replace spaces in (show mop) with underscores,
......@@ -180,7 +171,7 @@ genMachOp platform mop args
--
infixMachOp :: MachOp -> Maybe SDoc
infixMachOp mop
= case mop of
= case mop of
MO_And _ -> Just $ char '&'
MO_Or _ -> Just $ char '|'
MO_Xor _ -> Just $ char '^'
......@@ -193,24 +184,24 @@ infixMachOp mop
-- To minimise line noise we adopt the convention that if the literal
-- has the natural machine word size, we do not append the type
--
pprLit :: Platform -> CmmLit -> SDoc
pprLit platform lit = case lit of
pprLit :: CmmLit -> SDoc
pprLit lit = case lit of
CmmInt i rep ->
hcat [ (if i < 0 then parens else id)(integer i)
, ppUnless (rep == wordWidth) $
space <> dcolon <+> ppr rep ]
CmmFloat f rep -> hsep [ double (fromRat f), dcolon, ppr rep ]
CmmLabel clbl -> pprCLabel platform clbl
CmmLabelOff clbl i -> pprCLabel platform clbl <> ppr_offset i
CmmLabelDiffOff clbl1 clbl2 i -> pprCLabel platform clbl1 <> char '-'
<> pprCLabel platform clbl2 <> ppr_offset i
CmmLabel clbl -> ppr clbl
CmmLabelOff clbl i -> ppr clbl <> ppr_offset i
CmmLabelDiffOff clbl1 clbl2 i -> ppr clbl1 <> char '-'
<> ppr clbl2 <> ppr_offset i
CmmBlock id -> ppr id
CmmHighStackMark -> text "<highSp>"
pprLit1 :: Platform -> CmmLit -> SDoc
pprLit1 platform lit@(CmmLabelOff {}) = parens (pprLit platform lit)
pprLit1 platform lit = pprLit platform lit
pprLit1 :: CmmLit -> SDoc
pprLit1 lit@(CmmLabelOff {}) = parens (pprLit lit)
pprLit1 lit = pprLit lit
ppr_offset :: Int -> SDoc
ppr_offset i
......@@ -222,7 +213,7 @@ ppr_offset i
-- Registers, whether local (temps) or global
--
pprReg :: CmmReg -> SDoc
pprReg r
pprReg r
= case r of
CmmLocal local -> pprLocalReg local
CmmGlobal global -> pprGlobalReg global
......@@ -231,17 +222,17 @@ pprReg r
-- We only print the type of the local reg if it isn't wordRep
--
pprLocalReg :: LocalReg -> SDoc
pprLocalReg (LocalReg uniq rep)
pprLocalReg (LocalReg uniq rep)
-- = ppr rep <> char '_' <> ppr uniq
-- Temp Jan08
= char '_' <> ppr uniq <>
(if isWord32 rep -- && not (isGcPtrType rep) -- Temp Jan08 -- sigh
= char '_' <> ppr uniq <>
(if isWord32 rep -- && not (isGcPtrType rep) -- Temp Jan08 -- sigh
then dcolon <> ptr <> ppr rep
else dcolon <> ptr <> ppr rep)
where
ptr = empty
--if isGcPtrType rep
-- then doubleQuotes (text "ptr")
--if isGcPtrType rep
-- then doubleQuotes (text "ptr")
-- else empty
-- Stack areas
......@@ -256,7 +247,7 @@ pprAreaId (Young id) = hcat [ text "young<", ppr id, text ">" ]
-- needs to be kept in syn with CmmExpr.hs.GlobalReg
--
pprGlobalReg :: GlobalReg -> SDoc
pprGlobalReg gr
pprGlobalReg gr
= case gr of
VanillaReg n _ -> char 'R' <> int n
-- Temp Jan08
......
......@@ -3,78 +3,73 @@
-- (c) The University of Glasgow -2006
--
-- Code generation relaed to GpH
-- (a) parallel
-- (b) GranSim
-- (a) parallel
-- (b) GranSim
--
-----------------------------------------------------------------------------
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details
module CgParallel(
staticGranHdr,staticParHdr,
granFetchAndReschedule, granYield,
doGranAllocate
staticGranHdr,staticParHdr,
granFetchAndReschedule, granYield,
doGranAllocate
) where
import CgMonad
import CgCallConv
import DynFlags
import Id
import OldCmm
import StaticFlags
import Outputable
import SMRep
import Control.Monad
staticParHdr :: [CmmLit]
-- Parallel header words in a static closure
staticParHdr = []
--------------------------------------------------------
-- GranSim stuff
-- GranSim stuff
--------------------------------------------------------
staticGranHdr :: [CmmLit]
-- Gransim header words in a static closure
staticGranHdr = []
doGranAllocate :: CmmExpr -> Code
doGranAllocate :: CmmExpr -> Code
-- macro DO_GRAN_ALLOCATE
doGranAllocate _hp
| not opt_GranMacros = nopC
| otherwise = panic "doGranAllocate"
= do dflags <- getDynFlags
when (dopt Opt_GranMacros dflags) $ panic "doGranAllocate"
-------------------------
granFetchAndReschedule :: [(Id,GlobalReg)] -- Live registers
-> Bool -- Node reqd?
-> Code
-> Bool -- Node reqd?
-> Code
-- Emit code for simulating a fetch and then reschedule.
granFetchAndReschedule regs node_reqd
| opt_GranMacros && (node `elem` map snd regs || node_reqd)
= do { fetch
; reschedule liveness node_reqd }
| otherwise
= nopC
= do dflags <- getDynFlags
when (dopt Opt_GranMacros dflags &&
(node `elem` map snd regs || node_reqd)) $
do fetch
reschedule liveness node_reqd
where
liveness = mkRegLiveness regs 0 0
fetch :: FCode ()
fetch = panic "granFetch"
-- Was: absC (CMacroStmt GRAN_FETCH [])
--HWL: generate GRAN_FETCH macro for GrAnSim
-- currently GRAN_FETCH and GRAN_FETCH_AND_RESCHEDULE are miai
-- Was: absC (CMacroStmt GRAN_FETCH [])
--HWL: generate GRAN_FETCH macro for GrAnSim
-- currently GRAN_FETCH and GRAN_FETCH_AND_RESCHEDULE are miai
reschedule :: StgWord -> Bool -> Code
reschedule _liveness _node_reqd = panic "granReschedule"
-- Was: absC (CMacroStmt GRAN_RESCHEDULE [
-- mkIntCLit (I# (word2Int# liveness_mask)),
-- mkIntCLit (if node_reqd then 1 else 0)])
-- Was: absC (CMacroStmt GRAN_RESCHEDULE [
-- mkIntCLit (I# (word2Int# liveness_mask)),
-- mkIntCLit (if node_reqd then 1 else 0)])