summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/cmm/Cmm.hs37
-rw-r--r--compiler/cmm/CmmBrokenBlock.hs12
-rw-r--r--compiler/cmm/CmmCPS.hs8
-rw-r--r--compiler/cmm/CmmCPSGen.hs12
-rw-r--r--compiler/cmm/CmmExpr.hs8
-rw-r--r--compiler/cmm/CmmInfo.hs6
-rw-r--r--compiler/cmm/CmmLive.hs8
-rw-r--r--compiler/cmm/CmmParse.y110
-rw-r--r--compiler/cmm/CmmProcPointZ.hs4
-rw-r--r--compiler/cmm/CmmSpillReload.hs41
-rw-r--r--compiler/cmm/CmmUtils.hs2
-rw-r--r--compiler/cmm/DFMonad.hs16
-rw-r--r--compiler/cmm/PprC.hs4
-rw-r--r--compiler/cmm/PprCmm.hs4
-rw-r--r--compiler/cmm/ZipCfgCmm.hs20
-rw-r--r--compiler/cmm/ZipDataflow.hs311
-rw-r--r--compiler/codeGen/CgBindery.lhs4
-rw-r--r--compiler/codeGen/CgForeignCall.hs8
-rw-r--r--compiler/codeGen/CgInfoTbls.hs12
-rw-r--r--compiler/codeGen/CgMonad.lhs2
-rw-r--r--compiler/codeGen/CgPrimOp.hs4
-rw-r--r--compiler/codeGen/CgUtils.hs6
-rw-r--r--compiler/nativeGen/MachCodeGen.hs6
-rw-r--r--compiler/nativeGen/RegAllocLinear.hs2
-rw-r--r--compiler/nativeGen/RegLiveness.hs6
25 files changed, 336 insertions, 317 deletions
diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index 24542e1020..db5accd3c0 100644
--- a/compiler/cmm/Cmm.hs
+++ b/compiler/cmm/Cmm.hs
@@ -20,26 +20,17 @@ module Cmm (
CmmInfoTable(..), ClosureTypeInfo(..), ProfilingInfo(..), ClosureTypeTag,
GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts, mapBlockStmts,
CmmReturnInfo(..),
- CmmStmt(..), CmmActuals, CmmFormal, CmmFormals, CmmHintFormals,
+ CmmStmt(..), CmmActual, CmmActuals, CmmFormal, CmmFormals, CmmKind,
+ CmmFormalsWithoutKinds, CmmFormalWithoutKind,
CmmSafety(..),
CmmCallTarget(..),
CmmStatic(..), Section(..),
- CmmExpr(..), cmmExprRep, maybeInvertCmmExpr,
- CmmReg(..), cmmRegRep,
- CmmLit(..), cmmLitRep,
- LocalReg(..), localRegRep, localRegGCFollow, Kind(..),
+ module CmmExpr,
BlockId(..), freshBlockId,
BlockEnv, emptyBlockEnv, lookupBlockEnv, extendBlockEnv, mkBlockEnv,
BlockSet, emptyBlockSet, elemBlockSet, extendBlockSet,
- GlobalReg(..), globalRegRep,
-
- node, nodeReg, spReg, hpReg, spLimReg
) where
--- ^ In order not to do violence to the import structure of the rest
--- of the compiler, module Cmm re-exports a number of identifiers
--- defined in 'CmmExpr'
-
#include "HsVersions.h"
import CmmExpr
@@ -90,7 +81,8 @@ data GenCmmTop d h g
= CmmProc -- A procedure
h -- Extra header such as the info table
CLabel -- Used to generate both info & entry labels
- CmmFormals -- Argument locals live on entry (C-- procedure params)
+ CmmFormalsWithoutKinds -- Argument locals live on entry (C-- procedure params)
+ -- XXX Odd that there are no kinds, but there you are ---NR
g -- Control-flow graph for the procedure's code
| CmmData -- Static data
@@ -229,7 +221,7 @@ data CmmStmt
| CmmCall -- A call (forign, native or primitive), with
CmmCallTarget
- CmmHintFormals -- zero or more results
+ CmmFormals -- zero or more results
CmmActuals -- zero or more arguments
CmmSafety -- whether to build a continuation
CmmReturnInfo
@@ -250,15 +242,18 @@ data CmmStmt
| CmmReturn -- Return from a native C-- function,
CmmActuals -- with these return values.
-type CmmActual = CmmExpr
-type CmmActuals = [(CmmActual,MachHint)]
-type CmmFormal = LocalReg
-type CmmHintFormals = [(CmmFormal,MachHint)]
-type CmmFormals = [CmmFormal]
+type CmmKind = MachHint
+type CmmActual = (CmmExpr, CmmKind)
+type CmmFormal = (LocalReg,CmmKind)
+type CmmActuals = [CmmActual]
+type CmmFormals = [CmmFormal]
+type CmmFormalWithoutKind = LocalReg
+type CmmFormalsWithoutKinds = [CmmFormalWithoutKind]
+
data CmmSafety = CmmUnsafe | CmmSafe C_SRT
--- | enable us to fold used registers over 'CmmActuals' and 'CmmHintFormals'
-instance UserOfLocalRegs a => UserOfLocalRegs (a, MachHint) where
+-- | enable us to fold used registers over 'CmmActuals' and 'CmmFormals'
+instance UserOfLocalRegs a => UserOfLocalRegs (a, CmmKind) where
foldRegsUsed f set (a, _) = foldRegsUsed f set a
instance UserOfLocalRegs CmmStmt where
diff --git a/compiler/cmm/CmmBrokenBlock.hs b/compiler/cmm/CmmBrokenBlock.hs
index bb898bb920..98a6c3b391 100644
--- a/compiler/cmm/CmmBrokenBlock.hs
+++ b/compiler/cmm/CmmBrokenBlock.hs
@@ -71,11 +71,11 @@ data BlockEntryInfo
= FunctionEntry -- ^ Block is the beginning of a function
CmmInfo -- ^ Function header info
CLabel -- ^ The function name
- CmmFormals -- ^ Aguments to function
+ CmmFormalsWithoutKinds -- ^ Aguments to function
-- Only the formal parameters are live
| ContinuationEntry -- ^ Return point of a function call
- CmmFormals -- ^ return values (argument to continuation)
+ CmmFormalsWithoutKinds -- ^ return values (argument to continuation)
C_SRT -- ^ SRT for the continuation's info table
Bool -- ^ True <=> GC block so ignore stack size
-- Live variables, other than
@@ -122,7 +122,7 @@ f2(x, y) { // ProcPointEntry
-}
data ContFormat = ContFormat
- CmmHintFormals -- ^ return values (argument to continuation)
+ CmmFormals -- ^ return values (argument to continuation)
C_SRT -- ^ SRT for the continuation's info table
Bool -- ^ True <=> GC block so ignore stack size
deriving (Eq)
@@ -146,7 +146,7 @@ data FinalStmt
BlockId -- ^ Target of the 'CmmGoto'
-- (must be a 'ContinuationEntry')
CmmCallTarget -- ^ The function to call
- CmmHintFormals -- ^ Results from call
+ CmmFormals -- ^ Results from call
-- (redundant with ContinuationEntry)
CmmActuals -- ^ Arguments to call
C_SRT -- ^ SRT for the continuation's info table
@@ -190,7 +190,7 @@ breakProc ::
-- to create names of the new blocks with
-> CmmInfo -- ^ Info table for the procedure
-> CLabel -- ^ Name of the procedure
- -> CmmFormals -- ^ Parameters of the procedure
+ -> CmmFormalsWithoutKinds -- ^ Parameters of the procedure
-> [CmmBasicBlock] -- ^ Blocks of the procecure
-- (First block is the entry block)
-> [BrokenBlock]
@@ -382,7 +382,7 @@ adaptBlockToFormat formats unique
next format_formals
adaptor_ident = BlockId unique
- mk_adaptor_block :: BlockId -> BlockEntryInfo -> BlockId -> CmmHintFormals -> BrokenBlock
+ mk_adaptor_block :: BlockId -> BlockEntryInfo -> BlockId -> CmmFormals -> BrokenBlock
mk_adaptor_block ident entry next formals =
BrokenBlock ident entry [] [next] exit
where
diff --git a/compiler/cmm/CmmCPS.hs b/compiler/cmm/CmmCPS.hs
index 0f1e94ac97..25f30a8951 100644
--- a/compiler/cmm/CmmCPS.hs
+++ b/compiler/cmm/CmmCPS.hs
@@ -117,7 +117,7 @@ cpsProc uniqSupply (CmmProc info ident params (ListGraph blocks)) = cps_procs
block_uniques = uniques
proc_uniques = map (map (map uniqsFromSupply . listSplitUniqSupply) . listSplitUniqSupply) $ listSplitUniqSupply uniqSupply2
- stack_use = CmmLocal (LocalReg stack_use_unique (cmmRegRep spReg) KindPtr)
+ stack_use = CmmLocal (LocalReg stack_use_unique (cmmRegRep spReg) GCKindPtr)
stack_check_block_id = BlockId stack_check_block_unique
stack_check_block = make_stack_check stack_check_block_id info stack_use (blockId $ head blocks)
@@ -170,7 +170,7 @@ cpsProc uniqSupply (CmmProc info ident params (ListGraph blocks)) = cps_procs
-- This is an association list instead of a UniqFM because
-- CLabel's don't have a 'Uniqueable' instance.
formats :: [(CLabel, -- key
- (CmmFormals, -- arguments
+ (CmmFormalsWithoutKinds, -- arguments
Maybe CLabel, -- label in top slot
[Maybe LocalReg]))] -- slots
formats = selectContinuationFormat live continuations
@@ -276,7 +276,7 @@ gatherBlocksIntoContinuation live proc_points blocks start =
selectContinuationFormat :: BlockEnv CmmLive
-> [Continuation (Either C_SRT CmmInfo)]
- -> [(CLabel, (CmmFormals, Maybe CLabel, [Maybe LocalReg]))]
+ -> [(CLabel, (CmmFormalsWithoutKinds, Maybe CLabel, [Maybe LocalReg]))]
selectContinuationFormat live continuations =
map (\c -> (continuationLabel c, selectContinuationFormat' c)) continuations
where
@@ -300,7 +300,7 @@ selectContinuationFormat live continuations =
unknown_block = panic "unknown BlockId in selectContinuationFormat"
-processFormats :: [(CLabel, (CmmFormals, Maybe CLabel, [Maybe LocalReg]))]
+processFormats :: [(CLabel, (CmmFormalsWithoutKinds, Maybe CLabel, [Maybe LocalReg]))]
-> Maybe UpdateFrame
-> [Continuation (Either C_SRT CmmInfo)]
-> (WordOff, WordOff, [(CLabel, ContinuationFormat)])
diff --git a/compiler/cmm/CmmCPSGen.hs b/compiler/cmm/CmmCPSGen.hs
index 1edeb5bf22..94d4b7bdfb 100644
--- a/compiler/cmm/CmmCPSGen.hs
+++ b/compiler/cmm/CmmCPSGen.hs
@@ -57,7 +57,7 @@ data Continuation info =
info -- Left <=> Continuation created by the CPS
-- Right <=> Function or Proc point
CLabel -- Used to generate both info & entry labels
- CmmFormals -- Argument locals live on entry (C-- procedure params)
+ CmmFormalsWithoutKinds -- Argument locals live on entry (C-- procedure params)
Bool -- ^ True <=> GC block so ignore stack size
[BrokenBlock] -- Code, may be empty. The first block is
-- the entry point. The order is otherwise initially
@@ -70,7 +70,7 @@ data Continuation info =
data ContinuationFormat
= ContinuationFormat {
- continuation_formals :: CmmFormals,
+ continuation_formals :: CmmFormalsWithoutKinds,
continuation_label :: Maybe CLabel, -- The label occupying the top slot
continuation_frame_size :: WordOff, -- Total frame size in words (not including arguments)
continuation_stack :: [Maybe LocalReg] -- local reg offsets from stack top
@@ -230,7 +230,7 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
formal_to_actual reg = (CmmReg (CmmLocal reg), NoHint)
-foreignCall :: [Unique] -> CmmCallTarget -> CmmHintFormals -> CmmActuals -> [CmmStmt]
+foreignCall :: [Unique] -> CmmCallTarget -> CmmFormals -> CmmActuals -> [CmmStmt]
foreignCall uniques call results arguments =
arg_stmts ++
saveThreadState ++
@@ -257,8 +257,8 @@ foreignCall uniques call results arguments =
loadArgsIntoTemps argument_uniques arguments
(caller_save, caller_load) =
callerSaveVolatileRegs (Just [{-only system regs-}])
- new_base = LocalReg base_unique (cmmRegRep (CmmGlobal BaseReg)) KindNonPtr
- id = LocalReg id_unique wordRep KindNonPtr
+ new_base = LocalReg base_unique (cmmRegRep (CmmGlobal BaseReg)) GCKindNonPtr
+ id = LocalReg id_unique wordRep GCKindNonPtr
tso_unique : base_unique : id_unique : argument_uniques = uniques
-- -----------------------------------------------------------------------------
@@ -299,7 +299,7 @@ loadThreadState tso_unique =
then [CmmStore curCCSAddr
(CmmLoad (cmmOffset (CmmReg (CmmLocal tso)) tso_CCCS) wordRep)]
else []
- where tso = LocalReg tso_unique wordRep KindNonPtr -- TODO FIXME NOW
+ where tso = LocalReg tso_unique wordRep GCKindNonPtr -- TODO FIXME NOW
openNursery = [
diff --git a/compiler/cmm/CmmExpr.hs b/compiler/cmm/CmmExpr.hs
index 78ff79a20b..efa7fe32e7 100644
--- a/compiler/cmm/CmmExpr.hs
+++ b/compiler/cmm/CmmExpr.hs
@@ -4,7 +4,7 @@ module CmmExpr
( CmmExpr(..), cmmExprRep, maybeInvertCmmExpr
, CmmReg(..), cmmRegRep
, CmmLit(..), cmmLitRep
- , LocalReg(..), localRegRep, localRegGCFollow, Kind(..)
+ , LocalReg(..), localRegRep, localRegGCFollow, GCKind(..)
, GlobalReg(..), globalRegRep, spReg, hpReg, spLimReg, nodeReg, node
, UserOfLocalRegs, foldRegsUsed
, RegSet, emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet
@@ -79,13 +79,13 @@ maybeInvertCmmExpr _ = Nothing
-----------------------------------------------------------------------------
-- | Whether a 'LocalReg' is a GC followable pointer
-data Kind = KindPtr | KindNonPtr deriving (Eq)
+data GCKind = GCKindPtr | GCKindNonPtr deriving (Eq)
data LocalReg
= LocalReg
!Unique -- ^ Identifier
MachRep -- ^ Type
- Kind -- ^ Should the GC follow as a pointer
+ GCKind -- ^ Should the GC follow as a pointer
-- | Sets of local registers
@@ -152,7 +152,7 @@ localRegRep :: LocalReg -> MachRep
localRegRep (LocalReg _ rep _) = rep
-localRegGCFollow :: LocalReg -> Kind
+localRegGCFollow :: LocalReg -> GCKind
localRegGCFollow (LocalReg _ _ p) = p
cmmLitRep :: CmmLit -> MachRep
diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index 3524377ac5..49a77e29fd 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -150,7 +150,7 @@ mkInfoTableAndCode :: CLabel
-> [CmmLit]
-> [CmmLit]
-> CLabel
- -> CmmFormals
+ -> CmmFormalsWithoutKinds
-> ListGraph CmmStmt
-> [RawCmmTop]
mkInfoTableAndCode info_lbl std_info extra_bits entry_lbl args blocks
@@ -222,8 +222,8 @@ mkLiveness uniq live =
is_non_ptr Nothing = True
is_non_ptr (Just reg) =
case localRegGCFollow reg of
- KindNonPtr -> True
- KindPtr -> False
+ GCKindNonPtr -> True
+ GCKindPtr -> False
bits :: [Bool]
bits = mkBits live
diff --git a/compiler/cmm/CmmLive.hs b/compiler/cmm/CmmLive.hs
index b60730ba5c..4450192824 100644
--- a/compiler/cmm/CmmLive.hs
+++ b/compiler/cmm/CmmLive.hs
@@ -9,7 +9,7 @@ module CmmLive (
CmmLive,
BlockEntryLiveness,
cmmLiveness,
- cmmHintFormalsToLiveLocals,
+ cmmFormalsToLiveLocals,
) where
#include "HsVersions.h"
@@ -163,8 +163,8 @@ addKilled new_killed live = live `minusUniqSet` new_killed
--------------------------------
-- Liveness of a CmmStmt
--------------------------------
-cmmHintFormalsToLiveLocals :: CmmHintFormals -> [LocalReg]
-cmmHintFormalsToLiveLocals formals = map fst formals
+cmmFormalsToLiveLocals :: CmmFormals -> [LocalReg]
+cmmFormalsToLiveLocals formals = map fst formals
cmmStmtLive :: BlockEntryLiveness -> CmmStmt -> CmmLivenessTransformer
cmmStmtLive _ (CmmNop) = id
@@ -180,7 +180,7 @@ cmmStmtLive _ (CmmStore expr1 expr2) =
cmmStmtLive _ (CmmCall target results arguments _ _) =
target_liveness .
foldr ((.) . cmmExprLive) id (map fst arguments) .
- addKilled (mkUniqSet $ cmmHintFormalsToLiveLocals results) where
+ addKilled (mkUniqSet $ cmmFormalsToLiveLocals results) where
target_liveness =
case target of
(CmmCallee target _) -> cmmExprLive target
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index 4c2fffa5ea..191705559d 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -209,7 +209,7 @@ lits :: { [ExtFCode CmmExpr] }
cmmproc :: { ExtCode }
-- TODO: add real SRT/info tables to parsed Cmm
- : info maybe_formals maybe_gc_block maybe_frame '{' body '}'
+ : info maybe_formals_without_kinds maybe_gc_block maybe_frame '{' body '}'
{ do ((entry_ret_label, info, live, formals, gc_block, frame), stmts) <-
getCgStmtsEC' $ loopDecls $ do {
(entry_ret_label, info, live) <- $1;
@@ -221,12 +221,12 @@ cmmproc :: { ExtCode }
blks <- code (cgStmtsToBlocks stmts)
code (emitInfoTableAndCode entry_ret_label (CmmInfo gc_block frame info) formals blks) }
- | info maybe_formals ';'
+ | info maybe_formals_without_kinds ';'
{ do (entry_ret_label, info, live) <- $1;
formals <- sequence $2;
code (emitInfoTableAndCode entry_ret_label (CmmInfo Nothing Nothing info) formals []) }
- | NAME maybe_formals maybe_gc_block maybe_frame '{' body '}'
+ | NAME maybe_formals_without_kinds maybe_gc_block maybe_frame '{' body '}'
{ do ((formals, gc_block, frame), stmts) <-
getCgStmtsEC' $ loopDecls $ do {
formals <- sequence $2;
@@ -298,7 +298,7 @@ info :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
(ContInfo [] NoC_SRT),
[]) }
- | 'INFO_TABLE_RET' '(' NAME ',' INT ',' formals0 ')'
+ | 'INFO_TABLE_RET' '(' NAME ',' INT ',' formals_without_kinds0 ')'
-- closure type, live regs
{ do live <- sequence (map (liftM Just) $7)
return (mkRtsRetLabelFS $3,
@@ -313,7 +313,7 @@ body :: { ExtCode }
decl :: { ExtCode }
: type names ';' { mapM_ (newLocal defaultKind $1) $2 }
- | STRING type names ';' {% do k <- parseKind $1;
+ | STRING type names ';' {% do k <- parseGCKind $1;
return $ mapM_ (newLocal k $2) $3 }
| 'import' names ';' { mapM_ newImport $2 }
@@ -340,9 +340,9 @@ stmt :: { ExtCode }
-- we tweak the syntax to avoid the conflict. The later
-- option is taken here because the other way would require
-- multiple levels of expanding and get unwieldy.
- | maybe_results 'foreign' STRING expr '(' hint_exprs0 ')' safety vols opt_never_returns ';'
+ | maybe_results 'foreign' STRING expr '(' cmm_kind_exprs0 ')' safety vols opt_never_returns ';'
{% foreignCall $3 $1 $4 $6 $9 $8 $10 }
- | maybe_results 'prim' '%' NAME '(' hint_exprs0 ')' safety vols ';'
+ | maybe_results 'prim' '%' NAME '(' cmm_kind_exprs0 ')' safety vols ';'
{% primCall $1 $4 $6 $9 $8 }
-- stmt-level macros, stealing syntax from ordinary C-- function calls.
-- Perhaps we ought to use the %%-form?
@@ -456,21 +456,21 @@ maybe_ty :: { MachRep }
: {- empty -} { wordRep }
| '::' type { $2 }
-maybe_actuals :: { [ExtFCode (CmmExpr, MachHint)] }
+maybe_actuals :: { [ExtFCode CmmActual] }
: {- empty -} { [] }
- | '(' hint_exprs0 ')' { $2 }
+ | '(' cmm_kind_exprs0 ')' { $2 }
-hint_exprs0 :: { [ExtFCode (CmmExpr, MachHint)] }
+cmm_kind_exprs0 :: { [ExtFCode CmmActual] }
: {- empty -} { [] }
- | hint_exprs { $1 }
+ | cmm_kind_exprs { $1 }
-hint_exprs :: { [ExtFCode (CmmExpr, MachHint)] }
- : hint_expr { [$1] }
- | hint_expr ',' hint_exprs { $1 : $3 }
+cmm_kind_exprs :: { [ExtFCode CmmActual] }
+ : cmm_kind_expr { [$1] }
+ | cmm_kind_expr ',' cmm_kind_exprs { $1 : $3 }
-hint_expr :: { ExtFCode (CmmExpr, MachHint) }
- : expr { do e <- $1; return (e, inferHint e) }
- | expr STRING {% do h <- parseHint $2;
+cmm_kind_expr :: { ExtFCode CmmActual }
+ : expr { do e <- $1; return (e, inferCmmKind e) }
+ | expr STRING {% do h <- parseCmmKind $2;
return $ do
e <- $1; return (e,h) }
@@ -486,18 +486,18 @@ reg :: { ExtFCode CmmExpr }
: NAME { lookupName $1 }
| GLOBALREG { return (CmmReg (CmmGlobal $1)) }
-maybe_results :: { [ExtFCode (CmmFormal, MachHint)] }
+maybe_results :: { [ExtFCode CmmFormal] }
: {- empty -} { [] }
- | '(' hint_lregs ')' '=' { $2 }
+ | '(' cmm_formals ')' '=' { $2 }
-hint_lregs :: { [ExtFCode (CmmFormal, MachHint)] }
- : hint_lreg { [$1] }
- | hint_lreg ',' { [$1] }
- | hint_lreg ',' hint_lregs { $1 : $3 }
+cmm_formals :: { [ExtFCode CmmFormal] }
+ : cmm_formal { [$1] }
+ | cmm_formal ',' { [$1] }
+ | cmm_formal ',' cmm_formals { $1 : $3 }
-hint_lreg :: { ExtFCode (CmmFormal, MachHint) }
- : local_lreg { do e <- $1; return (e, inferHint (CmmReg (CmmLocal e))) }
- | STRING local_lreg {% do h <- parseHint $1;
+cmm_formal :: { ExtFCode CmmFormal }
+ : local_lreg { do e <- $1; return (e, inferCmmKind (CmmReg (CmmLocal e))) }
+ | STRING local_lreg {% do h <- parseCmmKind $1;
return $ do
e <- $2; return (e,h) }
@@ -516,22 +516,22 @@ lreg :: { ExtFCode CmmReg }
other -> pprPanic "CmmParse:" (ftext $1 <> text " not a register") }
| GLOBALREG { return (CmmGlobal $1) }
-maybe_formals :: { [ExtFCode LocalReg] }
+maybe_formals_without_kinds :: { [ExtFCode LocalReg] }
: {- empty -} { [] }
- | '(' formals0 ')' { $2 }
+ | '(' formals_without_kinds0 ')' { $2 }
-formals0 :: { [ExtFCode LocalReg] }
+formals_without_kinds0 :: { [ExtFCode LocalReg] }
: {- empty -} { [] }
- | formals { $1 }
+ | formals_without_kinds { $1 }
-formals :: { [ExtFCode LocalReg] }
- : formal ',' { [$1] }
- | formal { [$1] }
- | formal ',' formals { $1 : $3 }
+formals_without_kinds :: { [ExtFCode LocalReg] }
+ : formal_without_kind ',' { [$1] }
+ | formal_without_kind { [$1] }
+ | formal_without_kind ',' formals_without_kinds { $1 : $3 }
-formal :: { ExtFCode LocalReg }
+formal_without_kind :: { ExtFCode LocalReg }
: type NAME { newLocal defaultKind $1 $2 }
- | STRING type NAME {% do k <- parseKind $1;
+ | STRING type NAME {% do k <- parseGCKind $1;
return $ newLocal k $2 $3 }
maybe_frame :: { ExtFCode (Maybe UpdateFrame) }
@@ -682,24 +682,24 @@ parseSafety "safe" = return (CmmSafe NoC_SRT)
parseSafety "unsafe" = return CmmUnsafe
parseSafety str = fail ("unrecognised safety: " ++ str)
-parseHint :: String -> P MachHint
-parseHint "ptr" = return PtrHint
-parseHint "signed" = return SignedHint
-parseHint "float" = return FloatHint
-parseHint str = fail ("unrecognised hint: " ++ str)
+parseCmmKind :: String -> P CmmKind
+parseCmmKind "ptr" = return PtrHint
+parseCmmKind "signed" = return SignedHint
+parseCmmKind "float" = return FloatHint
+parseCmmKind str = fail ("unrecognised hint: " ++ str)
-parseKind :: String -> P Kind
-parseKind "ptr" = return KindPtr
-parseKind str = fail ("unrecognized kin: " ++ str)
+parseGCKind :: String -> P GCKind
+parseGCKind "ptr" = return GCKindPtr
+parseGCKind str = fail ("unrecognized kin: " ++ str)
-defaultKind :: Kind
-defaultKind = KindNonPtr
+defaultKind :: GCKind
+defaultKind = GCKindNonPtr
-- labels are always pointers, so we might as well infer the hint
-inferHint :: CmmExpr -> MachHint
-inferHint (CmmLit (CmmLabel _)) = PtrHint
-inferHint (CmmReg (CmmGlobal g)) | isPtrGlobalReg g = PtrHint
-inferHint _ = NoHint
+inferCmmKind :: CmmExpr -> CmmKind
+inferCmmKind (CmmLit (CmmLabel _)) = PtrHint
+inferCmmKind (CmmReg (CmmGlobal g)) | isPtrGlobalReg g = PtrHint
+inferCmmKind _ = NoHint
isPtrGlobalReg Sp = True
isPtrGlobalReg SpLim = True
@@ -812,7 +812,7 @@ addVarDecl var expr = EC $ \e s -> return ((var, Var expr):s, ())
addLabel :: FastString -> BlockId -> ExtCode
addLabel name block_id = EC $ \e s -> return ((name, Label block_id):s, ())
-newLocal :: Kind -> MachRep -> FastString -> ExtFCode LocalReg
+newLocal :: GCKind -> MachRep -> FastString -> ExtFCode LocalReg
newLocal kind ty name = do
u <- code newUnique
let reg = LocalReg u ty kind
@@ -888,9 +888,9 @@ staticClosure cl_label info payload
foreignCall
:: String
- -> [ExtFCode (CmmFormal,MachHint)]
+ -> [ExtFCode CmmFormal]
-> ExtFCode CmmExpr
- -> [ExtFCode (CmmExpr,MachHint)]
+ -> [ExtFCode CmmActual]
-> Maybe [GlobalReg]
-> CmmSafety
-> CmmReturnInfo
@@ -919,9 +919,9 @@ foreignCall conv_string results_code expr_code args_code vols safety ret
unused = panic "not used by emitForeignCall'"
primCall
- :: [ExtFCode (CmmFormal,MachHint)]
+ :: [ExtFCode CmmFormal]
-> FastString
- -> [ExtFCode (CmmExpr,MachHint)]
+ -> [ExtFCode CmmActual]
-> Maybe [GlobalReg]
-> CmmSafety
-> P ExtCode
diff --git a/compiler/cmm/CmmProcPointZ.hs b/compiler/cmm/CmmProcPointZ.hs
index 279c730d46..ed4f54e17a 100644
--- a/compiler/cmm/CmmProcPointZ.hs
+++ b/compiler/cmm/CmmProcPointZ.hs
@@ -204,14 +204,14 @@ algorithm would be just as good, so that's what we do.
-}
-data Protocol = Protocol Convention CmmHintFormals
+data Protocol = Protocol Convention CmmFormals
deriving Eq
-- | Function 'optimize_calls' chooses protocols only for those proc
-- points that are relevant to the optimization explained above.
-- The others are assigned by 'add_unassigned', which is not yet clever.
-addProcPointProtocols :: ProcPointSet -> CmmFormals -> CmmGraph -> CmmGraph
+addProcPointProtocols :: ProcPointSet -> CmmFormalsWithoutKinds -> CmmGraph -> CmmGraph
addProcPointProtocols procPoints formals g =
snd $ add_unassigned procPoints $ optimize_calls g
where optimize_calls g = -- see Note [Separate Adams optimization]
diff --git a/compiler/cmm/CmmSpillReload.hs b/compiler/cmm/CmmSpillReload.hs
index bef608036b..3142e8e62d 100644
--- a/compiler/cmm/CmmSpillReload.hs
+++ b/compiler/cmm/CmmSpillReload.hs
@@ -107,15 +107,7 @@ middleDualLiveness live m@(Reload regs) =
where live' = DualLive { on_stack = on_stack live `plusRegSet` regs
, in_regs = in_regs live `minusRegSet` regs }
-middleDualLiveness live (NotSpillOrReload m) = middle m live
- where middle (MidNop) = id
- middle (MidComment {}) = id
- middle (MidAssign (CmmLocal reg') expr) = changeRegs (gen expr . kill reg')
- middle (MidAssign (CmmGlobal _) expr) = changeRegs (gen expr)
- middle (MidStore addr rval) = changeRegs (gen addr . gen rval)
- middle (MidUnsafeCall _ ress args) = changeRegs (gen args . kill ress)
- middle (CopyIn _ formals _) = changeRegs (kill formals)
- middle (CopyOut _ formals) = changeRegs (gen formals)
+middleDualLiveness live (NotSpillOrReload m) = changeRegs (middleLiveness m) live
lastDualLiveness :: (BlockId -> DualLive) -> Last -> DualLive
lastDualLiveness env l = last l
@@ -196,6 +188,37 @@ show_regs :: String -> RegSet -> Middle
show_regs s regs = MidComment $ mkFastString $ showSDoc $ ppr_regs s regs
+----------------------------------------------------------------
+--- sinking reloads
+
+{-
+
+-- The idea is to compute at each point the set of registers such that
+-- on every path to the point, the register is defined by a Reload
+-- instruction. Then, if a use appears at such a point, we can safely
+-- insert a Reload right before the use. Finally, we can eliminate
+-- the early reloads along with other dead assignments.
+
+data AvailRegs = UniverseMinus RegSet
+ | AvailRegs RegSet
+
+availRegsLattice :: DataflowLattice AvailRegs
+availRegsLattice =
+ DataflowLattice "register gotten from reloads" empty add False
+ where empty = DualLive emptyRegSet emptyRegSet
+ -- | compute in the Tx monad to track whether anything has changed
+ add new old = do stack <- add1 (on_stack new) (on_stack old)
+ regs <- add1 (in_regs new) (in_regs old)
+ return $ DualLive stack regs
+ add1 = fact_add_to liveLattice
+
+
+
+
+-}
+
+
+
---------------------
-- prettyprinting
diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs
index bccb2d7dc7..975ce7caa2 100644
--- a/compiler/cmm/CmmUtils.hs
+++ b/compiler/cmm/CmmUtils.hs
@@ -209,4 +209,4 @@ maybeAssignTemp :: [Unique] -> CmmExpr -> ([Unique], [CmmStmt], CmmExpr)
maybeAssignTemp uniques e
| hasNoGlobalRegs e = (uniques, [], e)
| otherwise = (tail uniques, [CmmAssign local e], CmmReg local)
- where local = CmmLocal (LocalReg (head uniques) (cmmExprRep e) KindNonPtr)
+ where local = CmmLocal (LocalReg (head uniques) (cmmExprRep e) GCKindNonPtr)
diff --git a/compiler/cmm/DFMonad.hs b/compiler/cmm/DFMonad.hs
index 789b4010b0..fc2fd45cd2 100644
--- a/compiler/cmm/DFMonad.hs
+++ b/compiler/cmm/DFMonad.hs
@@ -1,6 +1,6 @@
{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
module DFMonad
- ( Txlimit
+ ( OptimizationFuel
, DFTx, runDFTx, lastTxPass, txDecrement, txRemaining, txExhausted
, DataflowLattice(..)
@@ -72,7 +72,7 @@ data DFAState f = DFAState { df_facts :: BlockEnv f
, df_facts_change :: ChangeFlag
}
-data DFTxState = DFTxState { df_txlimit :: Txlimit, df_lastpass :: String }
+data DFTxState = DFTxState { df_txlimit :: OptimizationFuel, df_lastpass :: String }
data DFState f = DFState { df_uniqs :: UniqSupply
, df_rewritten :: ChangeFlag
@@ -96,7 +96,7 @@ liftTx (DFTx f) = DFM f'
where f' _ s = let (a, txs) = f (df_txstate s)
in (a, s {df_txstate = txs})
-newtype Txlimit = Txlimit Int
+newtype OptimizationFuel = OptimizationFuel Int
deriving (Ord, Eq, Num, Show, Bounded)
initDFAState :: DFAState f
@@ -108,7 +108,7 @@ runDFA lattice (DFA f) = fst $ f lattice initDFAState
-- XXX DFTx really needs to be in IO, so we can dump programs in
-- intermediate states of optimization ---NR
-runDFTx :: Txlimit -> DFTx a -> a --- should only be called once per program!
+runDFTx :: OptimizationFuel -> DFTx a -> a --- should only be called once per program!
runDFTx lim (DFTx f) = fst $ f $ DFTxState lim "<none>"
lastTxPass :: DFTx String
@@ -125,11 +125,11 @@ txExhausted :: DFTx Bool
txExhausted = DFTx f
where f s = (df_txlimit s <= 0, s)
-txRemaining :: DFTx Txlimit
+txRemaining :: DFTx OptimizationFuel
txRemaining = DFTx f
where f s = (df_txlimit s, s)
-txDecrement :: String -> Txlimit -> Txlimit -> DFTx ()
+txDecrement :: String -> OptimizationFuel -> OptimizationFuel -> DFTx ()
txDecrement optimizer old new = DFTx f
where f s = ((), s { df_txlimit = lim s, df_lastpass = optimizer })
lim s = if old == df_txlimit s then new
@@ -283,5 +283,5 @@ f4sep [] = fsep []
f4sep (d:ds) = fsep (d : map (nest 4) ds)
-_I_am_abstract :: Int -> Txlimit
-_I_am_abstract = Txlimit -- prevents a warning about Txlimit being unused
+_I_am_abstract :: Int -> OptimizationFuel
+_I_am_abstract = OptimizationFuel -- prevents warning: OptimizationFuel unused
diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index c7a49dadce..071c77da5d 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -237,7 +237,7 @@ pprStmt stmt = case stmt of
CmmJump lbl _params -> mkJMP_(pprExpr lbl) <> semi
CmmSwitch arg ids -> pprSwitch arg ids
-pprCFunType :: CCallConv -> CmmHintFormals -> CmmActuals -> SDoc
+pprCFunType :: CCallConv -> CmmFormals -> CmmActuals -> SDoc
pprCFunType cconv ress args
= hcat [
res_type ress,
@@ -727,7 +727,7 @@ pprLocalReg (LocalReg uniq _ _) = char '_' <> ppr uniq
-- -----------------------------------------------------------------------------
-- Foreign Calls
-pprCall :: SDoc -> CCallConv -> CmmHintFormals -> CmmActuals -> CmmSafety
+pprCall :: SDoc -> CCallConv -> CmmFormals -> CmmActuals -> CmmSafety
-> SDoc
pprCall ppr_fn cconv results args _
diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs
index c31c4de6e2..4dc4887fc6 100644
--- a/compiler/cmm/PprCmm.hs
+++ b/compiler/cmm/PprCmm.hs
@@ -512,10 +512,10 @@ pprReg r
pprLocalReg :: LocalReg -> SDoc
pprLocalReg (LocalReg uniq rep follow)
= hcat [ char '_', ppr uniq, ty ] where
- ty = if rep == wordRep && follow == KindNonPtr
+ ty = if rep == wordRep && follow == GCKindNonPtr
then empty
else dcolon <> ptr <> ppr rep
- ptr = if follow == KindNonPtr
+ ptr = if follow == GCKindNonPtr
then empty
else doubleQuotes (text "ptr")
diff --git a/compiler/cmm/ZipCfgCmm.hs b/compiler/cmm/ZipCfgCmm.hs
index 367d95229e..d496626287 100644
--- a/compiler/cmm/ZipCfgCmm.hs
+++ b/compiler/cmm/ZipCfgCmm.hs
@@ -12,7 +12,7 @@ where
import CmmExpr
import Cmm ( GenCmm(..), GenCmmTop(..), CmmStatic, CmmInfo
- , CmmCallTarget(..), CmmActuals, CmmFormals, CmmHintFormals
+ , CmmCallTarget(..), CmmActuals, CmmFormalsWithoutKinds, CmmFormals
, CmmStmt(CmmJump, CmmSwitch, CmmReturn) -- imported in order to call ppr
)
import PprCmm()
@@ -37,8 +37,8 @@ type CmmTopZ = GenCmmTop CmmStatic CmmInfo CmmGraph
mkNop :: CmmAGraph
mkAssign :: CmmReg -> CmmExpr -> CmmAGraph
mkStore :: CmmExpr -> CmmExpr -> CmmAGraph
-mkCall :: CmmCallTarget -> CmmHintFormals -> CmmActuals -> C_SRT -> CmmAGraph
-mkUnsafeCall :: CmmCallTarget -> CmmHintFormals -> CmmActuals -> CmmAGraph
+mkCall :: CmmCallTarget -> CmmFormals -> CmmActuals -> C_SRT -> CmmAGraph
+mkUnsafeCall :: CmmCallTarget -> CmmFormals -> CmmActuals -> CmmAGraph
mkFinalCall :: CmmCallTarget -> CmmActuals -> CmmAGraph -- never returns
mkJump :: CmmExpr -> CmmActuals -> CmmAGraph
mkCbranch :: CmmExpr -> BlockId -> BlockId -> CmmAGraph
@@ -57,11 +57,11 @@ mkCmmWhileDo :: CmmExpr -> CmmAGraph -> CmmAGraph
mkCmmIfThenElse e = mkIfThenElse (mkCbranch e)
mkCmmWhileDo e = mkWhileDo (mkCbranch e)
-mkCopyIn :: Convention -> CmmHintFormals -> C_SRT -> CmmAGraph
-mkCopyOut :: Convention -> CmmHintFormals -> CmmAGraph
+mkCopyIn :: Convention -> CmmFormals -> C_SRT -> CmmAGraph
+mkCopyOut :: Convention -> CmmFormals -> CmmAGraph
-- ^ XXX: Simon or Simon thinks maybe the hints are being abused and
- -- we should have CmmFormals here, but for now it is CmmHintFormals
+ -- we should have CmmFormalsWithoutKinds here, but for now it is CmmFormals
-- for consistency with the rest of the back end ---NR
mkComment fs = mkMiddle (MidComment fs)
@@ -77,15 +77,15 @@ data Middle
| MidUnsafeCall -- An "unsafe" foreign call;
CmmCallTarget -- just a fat machine instructoin
- CmmHintFormals -- zero or more results
+ CmmFormals -- zero or more results
CmmActuals -- zero or more arguments
| CopyIn -- Move parameters or results from conventional locations to registers
-- Note [CopyIn invariant]
Convention
- CmmHintFormals
+ CmmFormals
C_SRT -- Static things kept alive by this block
- | CopyOut Convention CmmHintFormals
+ | CopyOut Convention CmmFormals
data Last
= LastReturn CmmActuals -- Return from a function,
@@ -94,7 +94,7 @@ data Last
| LastJump CmmExpr CmmActuals
-- Tail call to another procedure
- | LastBranch BlockId CmmFormals
+ | LastBranch BlockId CmmFormalsWithoutKinds
-- To another block in the same procedure
-- The parameters are unused at present.
diff --git a/compiler/cmm/ZipDataflow.hs b/compiler/cmm/ZipDataflow.hs
index 290faa20bd..8a8315ff24 100644
--- a/compiler/cmm/ZipDataflow.hs
+++ b/compiler/cmm/ZipDataflow.hs
@@ -72,7 +72,7 @@ For example, [['i]] might be equal to a fact, or it might be a tuple
of which one element is a fact.
\item
Type parameter [['o]] is an output, or possibly a function from
-[[txlimit]] to an output
+[[fuel]] to an output
\end{itemize}
Backward analyses compute [[in]] facts (facts on inedges).
<<exported types for backward analyses>>=
@@ -97,7 +97,7 @@ type BAnalysis m l a = BComputation m l a a
type BTransformation m l a = BComputation m l a (Maybe (UniqSM (Graph m l)))
type BFunctionalTransformation m l a = BComputation m l a (Maybe (Graph m l))
-type BPass m l a = BComputation m l a (Txlimit -> DFM a (Answer m l a))
+type BPass m l a = BComputation m l a (OptimizationFuel -> DFM a (Answer m l a))
type BUnlimitedPass m l a = BComputation m l a ( DFM a (Answer m l a))
{-
@@ -132,8 +132,8 @@ type FAnalysis m l a = FComputation m l a a (LastOutFacts a)
type FTransformation m l a = FComputation m l a (Maybe (UniqSM (Graph m l)))
(Maybe (UniqSM (Graph m l)))
type FPass m l a = FComputation m l a
- (Txlimit -> DFM a (Answer m l a))
- (Txlimit -> DFM a (Answer m l (LastOutFacts a)))
+ (OptimizationFuel -> DFM a (Answer m l a))
+ (OptimizationFuel -> DFM a (Answer m l (LastOutFacts a)))
type FUnlimitedPass m l a = FComputation m l a
(DFM a (Answer m l a))
@@ -338,10 +338,10 @@ fold_edge_facts_with_nodes_b fl fm ff comp graph env z =
-- To do this, we need a locally modified computation that allows an
-- ``exit fact'' to flow into the exit node.
-comp_with_exit_b :: BComputation m l i (Txlimit -> DFM f (Answer m l o)) -> o ->
- BComputation m l i (Txlimit -> DFM f (Answer m l o))
+comp_with_exit_b :: BComputation m l i (OptimizationFuel -> DFM f (Answer m l o)) -> o ->
+ BComputation m l i (OptimizationFuel -> DFM f (Answer m l o))
comp_with_exit_b comp exit_fact =
- comp { bc_exit_in = \_txlim -> return $ Dataflow $ exit_fact }
+ comp { bc_exit_in = \_fuel -> return $ Dataflow $ exit_fact }
-- | Given this function, we can now solve a graph simply by doing a
-- backward analysis on the modified computation. Note we have to be
@@ -353,50 +353,50 @@ comp_with_exit_b comp exit_fact =
solve_graph_b ::
forall m l a . (DebugNodes m l, Outputable a) =>
- BPass m l a -> Txlimit -> G.LGraph m l -> a -> DFM a (Txlimit, a)
-solve_graph_b comp txlim graph exit_fact =
- general_backward (comp_with_exit_b comp exit_fact) txlim graph
+ BPass m l a -> OptimizationFuel -> G.LGraph m l -> a -> DFM a (OptimizationFuel, a)
+solve_graph_b comp fuel graph exit_fact =
+ general_backward (comp_with_exit_b comp exit_fact) fuel graph
where
- general_backward :: BPass m l a -> Txlimit -> G.LGraph m l -> DFM a (Txlimit, a)
- general_backward comp txlim graph =
- let set_block_fact :: Txlimit -> G.Block m l -> DFM a Txlimit
- set_block_fact txlim b =
- do { (txlim, block_in) <-
+ general_backward :: BPass m l a -> OptimizationFuel -> G.LGraph m l -> DFM a (OptimizationFuel, a)
+ general_backward comp fuel graph =
+ let set_block_fact :: OptimizationFuel -> G.Block m l -> DFM a OptimizationFuel
+ set_block_fact fuel b =
+ do { (fuel, block_in) <-
let (h, l) = G.goto_end (G.unzip b) in
- factsEnv >>= \env -> last_in comp env l txlim >>= \x ->
+ factsEnv >>= \env -> last_in comp env l fuel >>= \x ->
case x of
- Dataflow a -> head_in txlim h a
+ Dataflow a -> head_in fuel h a
Rewrite g ->
do { bot <- botFact
; g <- lgraphOfGraph g
- ; (txlim, a) <- subAnalysis' $
- solve_graph_b comp (txlim-1) g bot
- ; head_in txlim h a }
+ ; (fuel, a) <- subAnalysis' $
+ solve_graph_b comp (fuel-1) g bot
+ ; head_in fuel h a }
; my_trace "result of" (text (bc_name comp) <+>
text "on" <+> ppr (G.blockId b) <+> text "is" <+> ppr block_in) $
setFact (G.blockId b) block_in
- ; return txlim
+ ; return fuel
}
- head_in txlim (G.ZHead h m) out =
- bc_middle_in comp out m txlim >>= \x -> case x of
- Dataflow a -> head_in txlim h a
+ head_in fuel (G.ZHead h m) out =
+ bc_middle_in comp out m fuel >>= \x -> case x of
+ Dataflow a -> head_in fuel h a
Rewrite g ->
do { g <- lgraphOfGraph g
- ; (txlim, a) <- subAnalysis' $ solve_graph_b comp (txlim-1) g out
+ ; (fuel, a) <- subAnalysis' $ solve_graph_b comp (fuel-1) g out
; my_trace "Rewrote middle node" (f4sep [ppr m, text "to", ppr g]) $
- head_in txlim h a }
- head_in txlim (G.ZFirst id) out =
- bc_first_in comp out id txlim >>= \x -> case x of
- Dataflow a -> return (txlim, a)
+ head_in fuel h a }
+ head_in fuel (G.ZFirst id) out =
+ bc_first_in comp out id fuel >>= \x -> case x of
+ Dataflow a -> return (fuel, a)
Rewrite g -> do { g <- lgraphOfGraph g
- ; subAnalysis' $ solve_graph_b comp (txlim-1) g out }
+ ; subAnalysis' $ solve_graph_b comp (fuel-1) g out }
- in do { txlim <-
- run "backward" (bc_name comp) (return ()) set_block_fact txlim blocks
+ in do { fuel <-
+ run "backward" (bc_name comp) (return ()) set_block_fact fuel blocks
; a <- getFact (G.gr_entry graph)
; facts <- allFacts
; my_trace "Solution to graph after pass 1 is" (pprFacts graph facts a) $
- return (txlim, a) }
+ return (fuel, a) }
blocks = reverse (G.postorder_dfs graph)
pprFacts g env a = (ppr a <+> text "with") $$ vcat (pprLgraph g : map pprFact (ufmToList env))
@@ -424,76 +424,76 @@ The tail is in final form; the head is still to be rewritten.
solve_and_rewrite_b ::
forall m l a. (DebugNodes m l, Outputable a) =>
- BPass m l a -> Txlimit -> LGraph m l -> a -> DFM a (Txlimit, a, LGraph m l)
+ BPass m l a -> OptimizationFuel -> LGraph m l -> a -> DFM a (OptimizationFuel, a, LGraph m l)
-solve_and_rewrite_b comp txlim graph exit_fact =
- do { (_, a) <- solve_graph_b comp txlim graph exit_fact -- pass 1
+solve_and_rewrite_b comp fuel graph exit_fact =
+ do { (_, a) <- solve_graph_b comp fuel graph exit_fact -- pass 1
; facts <- allFacts
- ; (txlim, g) <- -- pass 2
+ ; (fuel, g) <- -- pass 2
my_trace "Solution to graph after pass 1 is" (pprFacts graph facts) $
- backward_rewrite (comp_with_exit_b comp exit_fact) txlim graph
+ backward_rewrite (comp_with_exit_b comp exit_fact) fuel graph
; facts <- allFacts
; my_trace "Rewritten graph after pass 2 is" (pprFacts g facts) $
- return (txlim, a, g) }
+ return (fuel, a, g) }
where
pprFacts g env = vcat (pprLgraph g : map pprFact (ufmToList env))
pprFact (id, a) = hang (ppr id <> colon) 4 (ppr a)
eid = G.gr_entry graph
- backward_rewrite comp txlim graph =
- rewrite_blocks comp txlim emptyBlockEnv $ reverse (G.postorder_dfs graph)
+ backward_rewrite comp fuel graph =
+ rewrite_blocks comp fuel emptyBlockEnv $ reverse (G.postorder_dfs graph)
rewrite_blocks ::
- BPass m l a -> Txlimit ->
- BlockEnv (Block m l) -> [Block m l] -> DFM a (Txlimit,G.LGraph m l)
- rewrite_blocks _comp txlim rewritten [] = return (txlim, G.LGraph eid rewritten)
- rewrite_blocks comp txlim rewritten (b:bs) =
- let rewrite_next_block txlim =
+ BPass m l a -> OptimizationFuel ->
+ BlockEnv (Block m l) -> [Block m l] -> DFM a (OptimizationFuel,G.LGraph m l)
+ rewrite_blocks _comp fuel rewritten [] = return (fuel, G.LGraph eid rewritten)
+ rewrite_blocks comp fuel rewritten (b:bs) =
+ let rewrite_next_block fuel =
let (h, l) = G.goto_end (G.unzip b) in
- factsEnv >>= \env -> last_in comp env l txlim >>= \x -> case x of
- Dataflow a -> propagate txlim h a (G.ZLast l) rewritten
+ factsEnv >>= \env -> last_in comp env l fuel >>= \x -> case x of
+ Dataflow a -> propagate fuel h a (G.ZLast l) rewritten
Rewrite g -> -- see Note [Rewriting labelled LGraphs]
do { bot <- botFact
; g <- lgraphOfGraph g
- ; (txlim, a, g') <- solve_and_rewrite_b comp (txlim-1) g bot
+ ; (fuel, a, g') <- solve_and_rewrite_b comp (fuel-1) g bot
; let G.Graph t new_blocks = G.remove_entry_label g'
; markGraphRewritten
; let rewritten' = plusUFM new_blocks rewritten
; -- continue at entry of g
- propagate txlim h a t rewritten'
+ propagate fuel h a t rewritten'
}
- propagate :: Txlimit -> G.ZHead m -> a -> G.ZTail m l ->
- BlockEnv (Block m l) -> DFM a (Txlimit, G.LGraph m l)
- propagate txlim (G.ZHead h m) out tail rewritten =
- bc_middle_in comp out m txlim >>= \x -> case x of
- Dataflow a -> propagate txlim h a (G.ZTail m tail) rewritten
+ propagate :: OptimizationFuel -> G.ZHead m -> a -> G.ZTail m l ->
+ BlockEnv (Block m l) -> DFM a (OptimizationFuel, G.LGraph m l)
+ propagate fuel (G.ZHead h m) out tail rewritten =
+ bc_middle_in comp out m fuel >>= \x -> case x of
+ Dataflow a -> propagate fuel h a (G.ZTail m tail) rewritten
Rewrite g ->
do { g <- lgraphOfGraph g
- ; (txlim, a, g') <- solve_and_rewrite_b comp (txlim-1) g out
+ ; (fuel, a, g') <- solve_and_rewrite_b comp (fuel-1) g out
; markGraphRewritten
; let (t, g'') = G.splice_tail g' tail
; let rewritten' = plusUFM (G.gr_blocks g'') rewritten
; my_trace "Rewrote middle node" (f4sep [ppr m, text "to", ppr g]) $
- propagate txlim h a t rewritten' }
- propagate txlim h@(G.ZFirst id) out tail rewritten =
- bc_first_in comp out id txlim >>= \x -> case x of
+ propagate fuel h a t rewritten' }
+ propagate fuel h@(G.ZFirst id) out tail rewritten =
+ bc_first_in comp out id fuel >>= \x -> case x of
Dataflow a ->
let b = G.Block id tail in
do { checkFactMatch id a
- ; rewrite_blocks comp txlim (extendBlockEnv rewritten id b) bs }
+ ; rewrite_blocks comp fuel (extendBlockEnv rewritten id b) bs }
Rewrite fg ->
do { g <- lgraphOfGraph fg
- ; (txlim, a, g') <- solve_and_rewrite_b comp (txlim-1) g out
+ ; (fuel, a, g') <- solve_and_rewrite_b comp (fuel-1) g out
; markGraphRewritten
; let (t, g'') = G.splice_tail g' tail
; let rewritten' = plusUFM (G.gr_blocks g'') rewritten
; my_trace "Rewrote label " (f4sep [ppr id, text "to", ppr g]) $
- propagate txlim h a t rewritten' }
- in rewrite_next_block txlim
+ propagate fuel h a t rewritten' }
+ in rewrite_next_block fuel
b_rewrite comp g =
- do { txlim <- liftTx txRemaining
+ do { fuel <- liftTx txRemaining
; bot <- botFact
- ; (txlim', _, gc) <- solve_and_rewrite_b comp txlim g bot
- ; liftTx $ txDecrement (bc_name comp) txlim txlim'
+ ; (fuel', _, gc) <- solve_and_rewrite_b comp fuel g bot
+ ; liftTx $ txDecrement (bc_name comp) fuel fuel'
; return gc
}
@@ -507,15 +507,15 @@ let debug s (f, comp) =
let pr = Printf.eprintf in
let fact dir node a = pr "%s %s for %s = %s\n" f.fact_name dir node (s a) in
let rewr node g = pr "%s rewrites %s to <not-shown>\n" comp.name node in
- let wrap f nodestring node txlim =
- let answer = f node txlim in
+ let wrap f nodestring node fuel =
+ let answer = f node fuel in
let () = match answer with
| Dataflow a -> fact "in " (nodestring node) a
| Rewrite g -> rewr (nodestring node) g in
answer in
- let wrapout f nodestring out node txlim =
+ let wrapout f nodestring out node fuel =
fact "out" (nodestring node) out;
- wrap (f out) nodestring node txlim in
+ wrap (f out) nodestring node fuel in
let last_in = wrap comp.last_in (RS.rtl << G.last_instr) in
let middle_in = wrapout comp.middle_in (RS.rtl << G.mid_instr) in
let first_in =
@@ -528,39 +528,39 @@ anal_b comp = comp { bc_last_in = wrap2 $ bc_last_in comp
, bc_exit_in = wrap0 $ bc_exit_in comp
, bc_middle_in = wrap2 $ bc_middle_in comp
, bc_first_in = wrap2 $ bc_first_in comp }
- where wrap2 f out node _txlim = return $ Dataflow (f out node)
- wrap0 fact _txlim = return $ Dataflow fact
+ where wrap2 f out node _fuel = return $ Dataflow (f out node)
+ wrap0 fact _fuel = return $ Dataflow fact
ignore_transactions_b comp =
comp { bc_last_in = wrap2 $ bc_last_in comp
, bc_exit_in = wrap0 $ bc_exit_in comp
, bc_middle_in = wrap2 $ bc_middle_in comp
, bc_first_in = wrap2 $ bc_first_in comp }
- where wrap2 f out node _txlim = f out node
- wrap0 fact _txlim = fact
+ where wrap2 f out node _fuel = f out node
+ wrap0 fact _fuel = fact
-answer' :: (b -> DFM f (Graph m l)) -> Txlimit -> Maybe b -> a -> DFM f (Answer m l a)
-answer' lift txlim r a =
- case r of Just gc | txlim > 0 -> do { g <- lift gc; return $ Rewrite g }
+answer' :: (b -> DFM f (Graph m l)) -> OptimizationFuel -> Maybe b -> a -> DFM f (Answer m l a)
+answer' lift fuel r a =
+ case r of Just gc | fuel > 0 -> do { g <- lift gc; return $ Rewrite g }
_ -> return $ Dataflow a
unlimited_answer'
- :: (b -> DFM f (Graph m l)) -> Txlimit -> Maybe b -> a -> DFM f (Answer m l a)
-unlimited_answer' lift _txlim r a =
+ :: (b -> DFM f (Graph m l)) -> OptimizationFuel -> Maybe b -> a -> DFM f (Answer m l a)
+unlimited_answer' lift _fuel r a =
case r of Just gc -> do { g <- lift gc; return $ Rewrite g }
_ -> return $ Dataflow a
-combine_a_t_with :: (Txlimit -> Maybe b -> a -> DFM a (Answer m l a)) ->
+combine_a_t_with :: (OptimizationFuel -> Maybe b -> a -> DFM a (Answer m l a)) ->
BAnalysis m l a -> BComputation m l a (Maybe b) ->
BPass m l a
combine_a_t_with answer anal tx =
- let last_in env l txlim =
- answer txlim (bc_last_in tx env l) (bc_last_in anal env l)
- exit_in txlim = answer txlim (bc_exit_in tx) (bc_exit_in anal)
- middle_in out m txlim =
- answer txlim (bc_middle_in tx out m) (bc_middle_in anal out m)
- first_in out f txlim =
- answer txlim (bc_first_in tx out f) (bc_first_in anal out f)
+ let last_in env l fuel =
+ answer fuel (bc_last_in tx env l) (bc_last_in anal env l)
+ exit_in fuel = answer fuel (bc_exit_in tx) (bc_exit_in anal)
+ middle_in out m fuel =
+ answer fuel (bc_middle_in tx out m) (bc_middle_in anal out m)
+ first_in out f fuel =
+ answer fuel (bc_first_in tx out f) (bc_first_in anal out f)
in BComp { bc_name = concat [bc_name anal, " and ", bc_name tx]
, bc_last_in = last_in, bc_middle_in = middle_in
, bc_first_in = first_in, bc_exit_in = exit_in }
@@ -607,25 +607,24 @@ last_outs comp i (G.LastOther l) = fc_last_outs comp i l
comp_with_exit_f :: FPass m l a -> BlockId -> FPass m l a
comp_with_exit_f comp exit_fact_id = comp { fc_exit_outs = exit_outs }
- where exit_outs in' _txlimit =
- return $ Dataflow $ LastOutFacts [(exit_fact_id, in')]
+ where exit_outs in' _fuel = return $ Dataflow $ LastOutFacts [(exit_fact_id, in')]
-- | Given [[comp_with_exit_f]], we can now solve a graph simply by doing a
-- forward analysis on the modified computation.
solve_graph_f ::
forall m l a . (DebugNodes m l, Outputable a) =>
- FPass m l a -> Txlimit -> G.LGraph m l -> a ->
- DFM a (Txlimit, a, LastOutFacts a)
-solve_graph_f comp txlim g in_fact =
+ FPass m l a -> OptimizationFuel -> G.LGraph m l -> a ->
+ DFM a (OptimizationFuel, a, LastOutFacts a)
+solve_graph_f comp fuel g in_fact =
do { exit_fact_id <- freshBlockId "proxy for exit node"
- ; txlim <- general_forward (comp_with_exit_f comp exit_fact_id) txlim in_fact g
+ ; fuel <- general_forward (comp_with_exit_f comp exit_fact_id) fuel in_fact g
; a <- getFact exit_fact_id
; outs <- lastOutFacts
; forgetFact exit_fact_id -- close space leak
- ; return (txlim, a, LastOutFacts outs) }
+ ; return (fuel, a, LastOutFacts outs) }
where
- general_forward :: FPass m l a -> Txlimit -> a -> G.LGraph m l -> DFM a Txlimit
- general_forward comp txlim entry_fact graph =
+ general_forward :: FPass m l a -> OptimizationFuel -> a -> G.LGraph m l -> DFM a OptimizationFuel
+ general_forward comp fuel entry_fact graph =
let blocks = G.postorder_dfs g
is_local id = isJust $ lookupBlockEnv (G.gr_blocks g) id
set_or_save :: LastOutFacts a -> DFM a ()
@@ -634,37 +633,37 @@ solve_graph_f comp txlim g in_fact =
if is_local id then setFact id a else addLastOutFact (id, a)
set_entry = setFact (G.gr_entry graph) entry_fact
- set_successor_facts txlim b =
- let set_tail_facts txlim in' (G.ZTail m t) =
+ set_successor_facts fuel b =
+ let set_tail_facts fuel in' (G.ZTail m t) =
my_trace "Solving middle node" (ppr m) $
- fc_middle_out comp in' m txlim >>= \ x -> case x of
- Dataflow a -> set_tail_facts txlim a t
+ fc_middle_out comp in' m fuel >>= \ x -> case x of
+ Dataflow a -> set_tail_facts fuel a t
Rewrite g ->
do g <- lgraphOfGraph g
- (txlim, out, last_outs) <- subAnalysis' $
- solve_graph_f comp (txlim-1) g in'
+ (fuel, out, last_outs) <- subAnalysis' $
+ solve_graph_f comp (fuel-1) g in'
set_or_save last_outs
- set_tail_facts txlim out t
- set_tail_facts txlim in' (G.ZLast l) =
- last_outs comp in' l txlim >>= \x -> case x of
- Dataflow outs -> do { set_or_save outs; return txlim }
+ set_tail_facts fuel out t
+ set_tail_facts fuel in' (G.ZLast l) =
+ last_outs comp in' l fuel >>= \x -> case x of
+ Dataflow outs -> do { set_or_save outs; return fuel }
Rewrite g ->
do g <- lgraphOfGraph g
- (txlim, _, last_outs) <- subAnalysis' $
- solve_graph_f comp (txlim-1) g in'
+ (fuel, _, last_outs) <- subAnalysis' $
+ solve_graph_f comp (fuel-1) g in'
set_or_save last_outs
- return txlim
+ return fuel
G.Block id t = b
in do idfact <- getFact id
- infact <- fc_first_out comp idfact id txlim
- case infact of Dataflow a -> set_tail_facts txlim a t
+ infact <- fc_first_out comp idfact id fuel
+ case infact of Dataflow a -> set_tail_facts fuel a t
Rewrite g ->
do g <- lgraphOfGraph g
- (txlim, out, last_outs) <- subAnalysis' $
- solve_graph_f comp (txlim-1) g idfact
+ (fuel, out, last_outs) <- subAnalysis' $
+ solve_graph_f comp (fuel-1) g idfact
set_or_save last_outs
- set_tail_facts txlim out t
- in run "forward" (fc_name comp) set_entry set_successor_facts txlim blocks
+ set_tail_facts fuel out t
+ in run "forward" (fc_name comp) set_entry set_successor_facts fuel blocks
@@ -679,20 +678,20 @@ The tail is in final form; the head is still to be rewritten.
-}
solve_and_rewrite_f ::
forall m l a . (DebugNodes m l, Outputable a) =>
- FPass m l a -> Txlimit -> LGraph m l -> a -> DFM a (Txlimit, a, LGraph m l)
-solve_and_rewrite_f comp txlim graph in_fact =
- do solve_graph_f comp txlim graph in_fact -- pass 1
+ FPass m l a -> OptimizationFuel -> LGraph m l -> a -> DFM a (OptimizationFuel, a, LGraph m l)
+solve_and_rewrite_f comp fuel graph in_fact =
+ do solve_graph_f comp fuel graph in_fact -- pass 1
exit_id <- freshBlockId "proxy for exit node"
- (txlim, g) <- forward_rewrite (comp_with_exit_f comp exit_id) txlim graph in_fact
+ (fuel, g) <- forward_rewrite (comp_with_exit_f comp exit_id) fuel graph in_fact
exit_fact <- getFact exit_id
- return (txlim, exit_fact, g)
+ return (fuel, exit_fact, g)
forward_rewrite ::
forall m l a . (DebugNodes m l, Outputable a) =>
- FPass m l a -> Txlimit -> G.LGraph m l -> a -> DFM a (Txlimit, G.LGraph m l)
-forward_rewrite comp txlim graph entry_fact =
+ FPass m l a -> OptimizationFuel -> G.LGraph m l -> a -> DFM a (OptimizationFuel, G.LGraph m l)
+forward_rewrite comp fuel graph entry_fact =
do setFact eid entry_fact
- rewrite_blocks txlim emptyBlockEnv (G.postorder_dfs graph)
+ rewrite_blocks fuel emptyBlockEnv (G.postorder_dfs graph)
where
eid = G.gr_entry graph
is_local id = isJust $ lookupBlockEnv (G.gr_blocks graph) id
@@ -703,51 +702,51 @@ forward_rewrite comp txlim graph entry_fact =
else panic "set fact outside graph during rewriting pass?!"
rewrite_blocks ::
- Txlimit -> BlockEnv (Block m l) -> [Block m l] -> DFM a (Txlimit, LGraph m l)
- rewrite_blocks txlim rewritten [] = return (txlim, G.LGraph eid rewritten)
- rewrite_blocks txlim rewritten (G.Block id t : bs) =
+ OptimizationFuel -> BlockEnv (Block m l) -> [Block m l] -> DFM a (OptimizationFuel, LGraph m l)
+ rewrite_blocks fuel rewritten [] = return (fuel, G.LGraph eid rewritten)
+ rewrite_blocks fuel rewritten (G.Block id t : bs) =
do id_fact <- getFact id
- first_out <- fc_first_out comp id_fact id txlim
+ first_out <- fc_first_out comp id_fact id fuel
case first_out of
- Dataflow a -> propagate txlim (G.ZFirst id) a t rewritten bs
+ Dataflow a -> propagate fuel (G.ZFirst id) a t rewritten bs
Rewrite fg -> do { markGraphRewritten
- ; rewrite_blocks (txlim-1) rewritten
+ ; rewrite_blocks (fuel-1) rewritten
(G.postorder_dfs (labelGraph id fg) ++ bs) }
- propagate :: Txlimit -> G.ZHead m -> a -> G.ZTail m l -> BlockEnv (G.Block m l) ->
- [G.Block m l] -> DFM a (Txlimit, G.LGraph m l)
- propagate txlim h in' (G.ZTail m t) rewritten bs =
+ propagate :: OptimizationFuel -> G.ZHead m -> a -> G.ZTail m l -> BlockEnv (G.Block m l) ->
+ [G.Block m l] -> DFM a (OptimizationFuel, G.LGraph m l)
+ propagate fuel h in' (G.ZTail m t) rewritten bs =
my_trace "Rewriting middle node" (ppr m) $
- do fc_middle_out comp in' m txlim >>= \x -> case x of
- Dataflow a -> propagate txlim (G.ZHead h m) a t rewritten bs
+ do fc_middle_out comp in' m fuel >>= \x -> case x of
+ Dataflow a -> propagate fuel (G.ZHead h m) a t rewritten bs
Rewrite g ->
my_trace "Rewriting middle node...\n" empty $
do g <- lgraphOfGraph g
- (txlim, a, g) <- solve_and_rewrite_f comp (txlim-1) g in'
+ (fuel, a, g) <- solve_and_rewrite_f comp (fuel-1) g in'
markGraphRewritten
my_trace "Rewrite of middle node completed\n" empty $
let (g', h') = G.splice_head h g in
- propagate txlim h' a t (plusUFM (G.gr_blocks g') rewritten) bs
- propagate txlim h in' (G.ZLast l) rewritten bs =
- do last_outs comp in' l txlim >>= \x -> case x of
+ propagate fuel h' a t (plusUFM (G.gr_blocks g') rewritten) bs
+ propagate fuel h in' (G.ZLast l) rewritten bs =
+ do last_outs comp in' l fuel >>= \x -> case x of
Dataflow outs ->
do set_or_save outs
let b = G.zip (G.ZBlock h (G.ZLast l))
- rewrite_blocks txlim (G.insertBlock b rewritten) bs
+ rewrite_blocks fuel (G.insertBlock b rewritten) bs
Rewrite g ->
-- could test here that [[exits g = exits (G.Entry, G.ZLast l)]]
{- if Debug.on "rewrite-last" then
Printf.eprintf "ZLast node %s rewritten to:\n"
(RS.rtl (G.last_instr l)); -}
do g <- lgraphOfGraph g
- (txlim, _, g) <- solve_and_rewrite_f comp (txlim-1) g in'
+ (fuel, _, g) <- solve_and_rewrite_f comp (fuel-1) g in'
markGraphRewritten
let g' = G.splice_head_only h g
- rewrite_blocks txlim (plusUFM (G.gr_blocks g') rewritten) bs
+ rewrite_blocks fuel (plusUFM (G.gr_blocks g') rewritten) bs
f_rewrite comp entry_fact g =
- do { txlim <- liftTx txRemaining
- ; (txlim', _, gc) <- solve_and_rewrite_f comp txlim g entry_fact
- ; liftTx $ txDecrement (fc_name comp) txlim txlim'
+ do { fuel <- liftTx txRemaining
+ ; (fuel', _, gc) <- solve_and_rewrite_f comp fuel g entry_fact
+ ; liftTx $ txDecrement (fc_name comp) fuel fuel'
; return gc
}
@@ -761,9 +760,9 @@ let debug s (f, comp) =
let setter dir node run_sets set =
run_sets (fun u a -> pr "%s %s for %s = %s\n" f.fact_name dir node (s a); set u a) in
let rewr node g = pr "%s rewrites %s to <not-shown>\n" comp.name node in
- let wrap f nodestring wrap_answer in' node txlim =
+ let wrap f nodestring wrap_answer in' node fuel =
fact "in " (nodestring node) in';
- wrap_answer (nodestring node) (f in' node txlim)
+ wrap_answer (nodestring node) (f in' node fuel)
and wrap_fact n answer =
let () = match answer with
| Dataflow a -> fact "out" n a
@@ -783,20 +782,20 @@ anal_f comp = comp { fc_first_out = wrap2 $ fc_first_out comp
, fc_last_outs = wrap2 $ fc_last_outs comp
, fc_exit_outs = wrap1 $ fc_exit_outs comp
}
- where wrap2 f out node _txlim = return $ Dataflow (f out node)
- wrap1 f fact _txlim = return $ Dataflow (f fact)
+ where wrap2 f out node _fuel = return $ Dataflow (f out node)
+ wrap1 f fact _fuel = return $ Dataflow (f fact)
a_t_f anal tx =
let answer = answer' liftUSM
- first_out in' id txlim =
- answer txlim (fc_first_out tx in' id) (fc_first_out anal in' id)
- middle_out in' m txlim =
- answer txlim (fc_middle_out tx in' m) (fc_middle_out anal in' m)
- last_outs in' l txlim =
- answer txlim (fc_last_outs tx in' l) (fc_last_outs anal in' l)
- exit_outs in' txlim = undefined
- answer txlim (fc_exit_outs tx in') (fc_exit_outs anal in')
+ first_out in' id fuel =
+ answer fuel (fc_first_out tx in' id) (fc_first_out anal in' id)
+ middle_out in' m fuel =
+ answer fuel (fc_middle_out tx in' m) (fc_middle_out anal in' m)
+ last_outs in' l fuel =
+ answer fuel (fc_last_outs tx in' l) (fc_last_outs anal in' l)
+ exit_outs in' fuel = undefined
+ answer fuel (fc_exit_outs tx in') (fc_exit_outs anal in')
in FComp { fc_name = concat [fc_name anal, " and ", fc_name tx]
, fc_last_outs = last_outs, fc_middle_out = middle_out
, fc_first_out = first_out, fc_exit_outs = exit_outs }
diff --git a/compiler/codeGen/CgBindery.lhs b/compiler/codeGen/CgBindery.lhs
index 34c4315ca1..d9ddddb8bd 100644
--- a/compiler/codeGen/CgBindery.lhs
+++ b/compiler/codeGen/CgBindery.lhs
@@ -450,8 +450,8 @@ bindNewToTemp id
uniq = getUnique id
temp_reg = LocalReg uniq (argMachRep (idCgRep id)) kind
kind = if isFollowableArg (idCgRep id)
- then KindPtr
- else KindNonPtr
+ then GCKindPtr
+ else GCKindNonPtr
lf_info = mkLFArgument id -- Always used of things we
-- know nothing about
diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs
index 3f83cf79ea..77f6044151 100644
--- a/compiler/codeGen/CgForeignCall.hs
+++ b/compiler/codeGen/CgForeignCall.hs
@@ -50,7 +50,7 @@ import Control.Monad
-- Code generation for Foreign Calls
cgForeignCall
- :: CmmHintFormals -- where to put the results
+ :: CmmFormals -- where to put the results
-> ForeignCall -- the op
-> [StgArg] -- arguments
-> StgLiveVars -- live vars, in case we need to save them
@@ -70,7 +70,7 @@ cgForeignCall results fcall stg_args live
emitForeignCall
- :: CmmHintFormals -- where to put the results
+ :: CmmFormals -- where to put the results
-> ForeignCall -- the op
-> [(CmmExpr,MachHint)] -- arguments
-> StgLiveVars -- live vars, in case we need to save them
@@ -106,7 +106,7 @@ emitForeignCall _ (DNCall _) _ _
-- alternative entry point, used by CmmParse
emitForeignCall'
:: Safety
- -> CmmHintFormals -- where to put the results
+ -> CmmFormals -- where to put the results
-> CmmCallTarget -- the op
-> [(CmmExpr,MachHint)] -- arguments
-> Maybe [GlobalReg] -- live vars, in case we need to save them
@@ -122,7 +122,7 @@ emitForeignCall' safety results target args vols srt ret
stmtsC caller_load
| otherwise = do
- -- Both 'id' and 'new_base' are KindNonPtr because they're
+ -- Both 'id' and 'new_base' are GCKindNonPtr because they're
-- RTS only objects and are not subject to garbage collection
id <- newNonPtrTemp wordRep
new_base <- newNonPtrTemp (cmmRegRep (CmmGlobal BaseReg))
diff --git a/compiler/codeGen/CgInfoTbls.hs b/compiler/codeGen/CgInfoTbls.hs
index 3dfd73cb53..39fbe1edb9 100644
--- a/compiler/codeGen/CgInfoTbls.hs
+++ b/compiler/codeGen/CgInfoTbls.hs
@@ -64,7 +64,7 @@ import Outputable
-- representation as a list of 'CmmAddr' is handled later
-- in the pipeline by 'cmmToRawCmm'.
-emitClosureCodeAndInfoTable :: ClosureInfo -> CmmFormals -> CgStmts -> Code
+emitClosureCodeAndInfoTable :: ClosureInfo -> CmmFormalsWithoutKinds -> CgStmts -> Code
emitClosureCodeAndInfoTable cl_info args body
= do { blks <- cgStmtsToBlocks body
; info <- mkCmmInfo cl_info
@@ -239,8 +239,8 @@ stack_layout ((off, bind):binds) sizeW | off == sizeW - 1 =
unique = getUnique (cgIdInfoId bind)
machRep = argMachRep (cgIdInfoArgRep bind)
kind = if isFollowableArg (cgIdInfoArgRep bind)
- then KindPtr
- else KindNonPtr
+ then GCKindPtr
+ else GCKindNonPtr
stack_layout binds@((off, _):_) sizeW | otherwise =
Nothing : (stack_layout binds (sizeW - 1))
@@ -266,8 +266,8 @@ stack_layout offsets sizeW = result
unique = getUnique (cgIdInfoId x)
machRep = argMachrep (cgIdInfoArgRep bind)
kind = if isFollowableArg (cgIdInfoArgRep bind)
- then KindPtr
- else KindNonPtr
+ then GCKindPtr
+ else GCKindNonPtr
-}
emitAlgReturnTarget
@@ -427,7 +427,7 @@ funInfoTable info_ptr
emitInfoTableAndCode
:: CLabel -- Label of entry or ret
-> CmmInfo -- ...the info table
- -> CmmFormals -- ...args
+ -> CmmFormalsWithoutKinds -- ...args
-> [CmmBasicBlock] -- ...and body
-> Code
diff --git a/compiler/codeGen/CgMonad.lhs b/compiler/codeGen/CgMonad.lhs
index 7b2ee7dcab..55110c1977 100644
--- a/compiler/codeGen/CgMonad.lhs
+++ b/compiler/codeGen/CgMonad.lhs
@@ -745,7 +745,7 @@ emitData sect lits
where
data_block = CmmData sect lits
-emitProc :: CmmInfo -> CLabel -> CmmFormals -> [CmmBasicBlock] -> Code
+emitProc :: CmmInfo -> CLabel -> CmmFormalsWithoutKinds -> [CmmBasicBlock] -> Code
emitProc info lbl args blocks
= do { let proc_block = CmmProc info lbl args (ListGraph blocks)
; state <- getState
diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs
index 4f9f2a808a..766ad49d87 100644
--- a/compiler/codeGen/CgPrimOp.hs
+++ b/compiler/codeGen/CgPrimOp.hs
@@ -39,7 +39,7 @@ import Outputable
-- ---------------------------------------------------------------------------
-- Code generation for PrimOps
-cgPrimOp :: CmmFormals -- where to put the results
+cgPrimOp :: CmmFormalsWithoutKinds -- where to put the results
-> PrimOp -- the op
-> [StgArg] -- arguments
-> StgLiveVars -- live vars, in case we need to save them
@@ -51,7 +51,7 @@ cgPrimOp results op args live
emitPrimOp results op non_void_args live
-emitPrimOp :: CmmFormals -- where to put the results
+emitPrimOp :: CmmFormalsWithoutKinds -- where to put the results
-> PrimOp -- the op
-> [CmmExpr] -- arguments
-> StgLiveVars -- live vars, in case we need to save them
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index 5446e45425..7101a4d5b2 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -350,7 +350,7 @@ emitRtsCallWithResult res hint fun args safe
-- Make a call to an RTS C procedure
emitRtsCall'
- :: CmmHintFormals
+ :: CmmFormals
-> LitString
-> [(CmmExpr,MachHint)]
-> Maybe [GlobalReg]
@@ -623,10 +623,10 @@ assignPtrTemp e
; return (CmmReg (CmmLocal reg)) }
newNonPtrTemp :: MachRep -> FCode LocalReg
-newNonPtrTemp rep = do { uniq <- newUnique; return (LocalReg uniq rep KindNonPtr) }
+newNonPtrTemp rep = do { uniq <- newUnique; return (LocalReg uniq rep GCKindNonPtr) }
newPtrTemp :: MachRep -> FCode LocalReg
-newPtrTemp rep = do { uniq <- newUnique; return (LocalReg uniq rep KindPtr) }
+newPtrTemp rep = do { uniq <- newUnique; return (LocalReg uniq rep GCKindPtr) }
-------------------------------------------------------------------------
diff --git a/compiler/nativeGen/MachCodeGen.hs b/compiler/nativeGen/MachCodeGen.hs
index 2d53ffb58f..65300a76cd 100644
--- a/compiler/nativeGen/MachCodeGen.hs
+++ b/compiler/nativeGen/MachCodeGen.hs
@@ -2969,7 +2969,7 @@ genCondJump id bool = do
genCCall
:: CmmCallTarget -- function to call
- -> CmmHintFormals -- where to put the result
+ -> CmmFormals -- where to put the result
-> CmmActuals -- arguments (of mixed type)
-> NatM InstrBlock
@@ -3203,7 +3203,7 @@ genCCall target dest_regs args = do
#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-outOfLineFloatOp :: CallishMachOp -> CmmFormal -> CmmActuals
+outOfLineFloatOp :: CallishMachOp -> CmmFormalWithoutKind -> CmmActuals
-> NatM InstrBlock
outOfLineFloatOp mop res args
= do
@@ -3217,7 +3217,7 @@ outOfLineFloatOp mop res args
else do
uq <- getUniqueNat
let
- tmp = LocalReg uq F64 KindNonPtr
+ tmp = LocalReg uq F64 GCKindNonPtr
-- in
code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args CmmUnsafe CmmMayReturn)
code2 <- stmtToInstrs (CmmAssign (CmmLocal res) (CmmReg (CmmLocal tmp)))
diff --git a/compiler/nativeGen/RegAllocLinear.hs b/compiler/nativeGen/RegAllocLinear.hs
index a9d8fc00cf..968b3998bf 100644
--- a/compiler/nativeGen/RegAllocLinear.hs
+++ b/compiler/nativeGen/RegAllocLinear.hs
@@ -92,7 +92,7 @@ import MachRegs
import MachInstrs
import RegAllocInfo
import RegLiveness
-import Cmm
+import Cmm hiding (RegSet)
import Digraph
import Unique ( Uniquable(getUnique), Unique )
diff --git a/compiler/nativeGen/RegLiveness.hs b/compiler/nativeGen/RegLiveness.hs
index 5b867f3eff..98aefb0952 100644
--- a/compiler/nativeGen/RegLiveness.hs
+++ b/compiler/nativeGen/RegLiveness.hs
@@ -5,7 +5,7 @@
-- (c) The University of Glasgow 2004
--
-----------------------------------------------------------------------------
-{-# OPTIONS -fno-warn-missing-signatures #-}
+{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
module RegLiveness (
RegSet,
@@ -36,7 +36,7 @@ import MachRegs
import MachInstrs
import PprMach
import RegAllocInfo
-import Cmm
+import Cmm hiding (RegSet)
import Digraph
import Outputable
@@ -154,6 +154,7 @@ mapBlockTopM f (CmmProc header label params (ListGraph comps))
= do comps' <- mapM (mapBlockCompM f) comps
return $ CmmProc header label params (ListGraph comps')
+mapBlockCompM :: Monad m => (a -> m a') -> (GenBasicBlock a) -> m (GenBasicBlock a')
mapBlockCompM f (BasicBlock i blocks)
= do blocks' <- mapM f blocks
return $ BasicBlock i blocks'
@@ -588,6 +589,7 @@ livenessBack liveregs blockmap acc (instr : instrs)
in livenessBack liveregs' blockmap (instr' : acc) instrs
-- don't bother tagging comments or deltas with liveness
+liveness1 :: RegSet -> BlockMap RegSet -> Instr -> (RegSet, LiveInstr)
liveness1 liveregs _ (instr@COMMENT{})
= (liveregs, Instr instr Nothing)
View Lorry Controller Status