Commit fd8d0411 authored by nr@eecs.harvard.edu's avatar nr@eecs.harvard.edu

a good deal of salutory renaming

I've renamed a number of type and data constructors within Cmm so that
the names used in the compiler may more closely reflect the C--
specification 2.1.  I've done a bit of other renaming as well.
Highlights:

  CmmFormal and CmmActual now bear a CmmKind (which for now is a
                                              MachHint as before)
  CmmFormals = [CmmFormal] and CmmActuals = [CmmActual]
  
  suitable changes have been made to both code and nonterminals in the
  Cmm parser (which is as yet untested)

  For reasons I don't understand, parts of the code generator use a
  sequence of 'formal parameters' with no C-- kinds.  For these we now
  have the types
    type CmmFormalWithoutKind   = LocalReg
    type CmmFormalsWithoutKinds = [CmmFormalWithoutKind]

  A great many appearances of (Tau, MachHint) have been simplified to
  the appropriate CmmFormal or CmmActual, though I'm sure there are
  more opportunities.

  Kind and its data constructors are now renamed to
     data GCKind = GCKindPtr | GCKindNonPtr 
  to avoid confusion with the Kind used in the type checker and with CmmKind.

Finally, in a somewhat unrelated bit (and in honor of Simon PJ, who
thought of the name), the Whalley/Davidson 'transaction limit' is now
called 'OptimizationFuel' with the net effect that there are no longer
two unrelated uses of the abbreviation 'tx'.
parent 5f0eea10
......@@ -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
......
......@@ -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
......
......@@ -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)])
......
......@@ -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 = [
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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]
......
......@@ -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
......
......@@ -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)
{-# 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
......@@ -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