Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
1cb4a07c
Commit
1cb4a07c
authored
Dec 22, 2011
by
dterei
Browse files
Remove unused argument field on CmmJump
parent
9ee9e518
Changes
19
Hide whitespace changes
Inline
Side-by-side
compiler/cmm/CmmCvt.hs
View file @
1cb4a07c
...
...
@@ -105,7 +105,7 @@ ofZgraph g = Old.ListGraph $ mapMaybe convert_block $ postorderDfs g
,
Just
expr'
<-
maybeInvertCmmExpr
expr
->
Old
.
CmmCondBranch
expr'
fid
:
tail_of
tid
|
otherwise
->
[
Old
.
CmmCondBranch
expr
tid
,
Old
.
CmmBranch
fid
]
CmmSwitch
arg
ids
->
[
Old
.
CmmSwitch
arg
ids
]
CmmCall
e
_
_
_
_
->
[
Old
.
CmmJump
e
[]
]
CmmCall
e
_
_
_
_
->
[
Old
.
CmmJump
e
]
CmmForeignCall
{}
->
panic
"ofZgraph: CmmForeignCall"
tail_of
bid
=
case
foldBlockNodesB3
(
first
,
middle
,
last
)
block
()
of
Old
.
BasicBlock
_
stmts
->
stmts
...
...
compiler/cmm/CmmLint.hs
View file @
1cb4a07c
...
...
@@ -143,7 +143,7 @@ lintCmmStmt platform labels = lint
then
return
()
else
cmmLintErr
(
text
"switch scrutinee is not a word: "
<>
pprPlatform
platform
e
<>
text
" :: "
<>
ppr
erep
)
lint
(
CmmJump
e
args
)
=
lintCmmExpr
platform
e
>>
mapM_
(
lintCmmExpr
platform
.
hintlessCmm
)
args
lint
(
CmmJump
e
)
=
lintCmmExpr
platform
e
>>
return
()
lint
(
CmmReturn
ress
)
=
mapM_
(
lintCmmExpr
platform
.
hintlessCmm
)
ress
lint
(
CmmBranch
id
)
=
checkTarget
id
checkTarget
id
=
if
setMember
id
labels
then
return
()
...
...
compiler/cmm/CmmOpt.hs
View file @
1cb4a07c
...
...
@@ -65,7 +65,7 @@ cmmEliminateDeadBlocks blocks@(BasicBlock base_id _:_) =
stmt
m
(
CmmBranch
b
)
=
b
:
m
stmt
m
(
CmmCondBranch
e
b
)
=
b
:
(
expr
m
e
)
stmt
m
(
CmmSwitch
e
bs
)
=
catMaybes
bs
++
expr
m
e
stmt
m
(
CmmJump
e
as
)
=
expr
(
actuals
m
as
)
e
stmt
m
(
CmmJump
e
)
=
expr
m
e
stmt
m
(
CmmReturn
as
)
=
actuals
m
as
actuals
m
as
=
foldl'
(
\
m
h
->
expr
m
(
hintlessCmm
h
))
m
as
-- We have to do a deep fold into CmmExpr because
...
...
@@ -273,7 +273,7 @@ inlineStmt u a (CmmCall target regs es ret)
es'
=
[
(
CmmHinted
(
inlineExpr
u
a
e
)
hint
)
|
(
CmmHinted
e
hint
)
<-
es
]
inlineStmt
u
a
(
CmmCondBranch
e
d
)
=
CmmCondBranch
(
inlineExpr
u
a
e
)
d
inlineStmt
u
a
(
CmmSwitch
e
d
)
=
CmmSwitch
(
inlineExpr
u
a
e
)
d
inlineStmt
u
a
(
CmmJump
e
d
)
=
CmmJump
(
inlineExpr
u
a
e
)
d
inlineStmt
u
a
(
CmmJump
e
)
=
CmmJump
(
inlineExpr
u
a
e
)
inlineStmt
_
_
other_stmt
=
other_stmt
inlineExpr
::
Unique
->
CmmExpr
->
CmmExpr
->
CmmExpr
...
...
@@ -669,7 +669,7 @@ cmmLoopifyForC (CmmProc (Just info@(Statics info_lbl _)) entry_lbl
where
blocks'
=
[
BasicBlock
id
(
map
do_stmt
stmts
)
|
BasicBlock
id
stmts
<-
blocks
]
do_stmt
(
CmmJump
(
CmmLit
(
CmmLabel
lbl
))
_
)
|
lbl
==
jump_lbl
do_stmt
(
CmmJump
(
CmmLit
(
CmmLabel
lbl
)))
|
lbl
==
jump_lbl
=
CmmBranch
top_id
do_stmt
stmt
=
stmt
...
...
compiler/cmm/CmmParse.y
View file @
1cb4a07c
...
...
@@ -411,8 +411,8 @@ stmt :: { ExtCode }
{ do as <- sequence $5; doSwitch $2 $3 as $6 }
| 'goto' NAME ';'
{ do l <- lookupLabel $2; stmtEC (CmmBranch l) }
| 'jump' expr
maybe_actuals
';'
{ do e
1
<- $2;
e2 <- sequence $3;
stmtEC (CmmJump e
1 e2
) }
| 'jump' expr ';'
{ do e <- $2; stmtEC (CmmJump e) }
| 'return' maybe_actuals ';'
{ do e <- sequence $2; stmtEC (CmmReturn e) }
| 'if' bool_expr 'goto' NAME
...
...
@@ -945,7 +945,7 @@ emitRetUT args = do
-- or regs that we assign to, so better use
-- simultaneous assignments here (#3546)
when (sp /= 0) $ stmtC (CmmAssign spReg (cmmRegOffW spReg (-sp)))
stmtC
(
CmmJump (entryCode (CmmLoad (cmmRegOffW spReg sp) bWord))
[])
stmtC
$
CmmJump (entryCode (CmmLoad (cmmRegOffW spReg sp) bWord))
-- TODO (when using CPS): emitStmt (CmmReturn (map snd args))
-- -----------------------------------------------------------------------------
...
...
compiler/cmm/OldCmm.hs
View file @
1cb4a07c
...
...
@@ -169,7 +169,6 @@ data CmmStmt -- Old-style
-- Undefined outside range, and when there's a Nothing
|
CmmJump
CmmExpr
-- Jump to another C-- function,
[
HintedCmmActual
]
-- with these parameters. (parameters never used)
|
CmmReturn
-- Return from a native C-- function,
[
HintedCmmActual
]
-- with these return values. (parameters never used)
...
...
@@ -195,7 +194,7 @@ instance UserOfLocalRegs CmmStmt where
stmt
(
CmmBranch
_
)
=
id
stmt
(
CmmCondBranch
e
_
)
=
gen
e
stmt
(
CmmSwitch
e
_
)
=
gen
e
stmt
(
CmmJump
e
es
)
=
gen
e
.
gen
es
stmt
(
CmmJump
e
)
=
gen
e
stmt
(
CmmReturn
es
)
=
gen
es
gen
::
UserOfLocalRegs
a
=>
a
->
b
->
b
...
...
compiler/cmm/OldPprCmm.hs
View file @
1cb4a07c
...
...
@@ -153,7 +153,7 @@ pprStmt platform stmt = case stmt of
CmmBranch
ident
->
genBranch
ident
CmmCondBranch
expr
ident
->
genCondBranch
platform
expr
ident
CmmJump
expr
params
->
genJump
platform
expr
params
CmmJump
expr
->
genJump
platform
expr
CmmReturn
params
->
genReturn
platform
params
CmmSwitch
arg
ids
->
genSwitch
platform
arg
ids
...
...
@@ -203,8 +203,8 @@ genCondBranch platform expr ident =
--
-- jump foo(a, b, c);
--
genJump
::
Platform
->
CmmExpr
->
[
CmmHinted
CmmExpr
]
->
SDoc
genJump
platform
expr
args
=
genJump
::
Platform
->
CmmExpr
->
SDoc
genJump
platform
expr
=
hcat
[
ptext
(
sLit
"jump"
)
,
space
,
if
isTrivialCmmExpr
expr
...
...
@@ -212,8 +212,6 @@ genJump platform expr args =
else
case
expr
of
CmmLoad
(
CmmReg
_
)
_
->
pprExpr
platform
expr
_
->
parens
(
pprExpr
platform
expr
)
,
space
,
parens
(
commafy
$
map
(
pprPlatform
platform
)
args
)
,
semi
]
...
...
compiler/cmm/PprC.hs
View file @
1cb4a07c
...
...
@@ -248,7 +248,7 @@ pprStmt platform stmt = case stmt of
CmmBranch
ident
->
pprBranch
ident
CmmCondBranch
expr
ident
->
pprCondBranch
platform
expr
ident
CmmJump
lbl
_params
->
mkJMP_
(
pprExpr
platform
lbl
)
<>
semi
CmmJump
lbl
->
mkJMP_
(
pprExpr
platform
lbl
)
<>
semi
CmmSwitch
arg
ids
->
pprSwitch
platform
arg
ids
pprCFunType
::
SDoc
->
CCallConv
->
[
HintedCmmFormal
]
->
[
HintedCmmActual
]
->
SDoc
...
...
@@ -930,7 +930,7 @@ te_Stmt (CmmCall _ rs es _) = mapM_ (te_temp.hintlessCmm) rs >>
mapM_
(
te_Expr
.
hintlessCmm
)
es
te_Stmt
(
CmmCondBranch
e
_
)
=
te_Expr
e
te_Stmt
(
CmmSwitch
e
_
)
=
te_Expr
e
te_Stmt
(
CmmJump
e
_
)
=
te_Expr
e
te_Stmt
(
CmmJump
e
)
=
te_Expr
e
te_Stmt
_
=
return
()
te_Expr
::
CmmExpr
->
TE
()
...
...
compiler/codeGen/CgClosure.lhs
View file @
1cb4a07c
...
...
@@ -374,7 +374,7 @@ mkSlowEntryCode cl_info reg_args
stk_adj_pop = CmmAssign spReg (cmmRegOffW spReg final_stk_offset)
stk_adj_push = CmmAssign spReg (cmmRegOffW spReg (- final_stk_offset))
jump_to_entry = CmmJump (mkLblExpr (entryLabelFromCI cl_info))
[]
jump_to_entry = CmmJump (mkLblExpr (entryLabelFromCI cl_info))
\end{code}
...
...
@@ -590,7 +590,7 @@ link_caf cl_info _is_upd = do
-- assuming lots of things, like the stack pointer hasn't
-- moved since we entered the CAF.
let target = entryCode (closureInfoPtr (CmmReg nodeReg)) in
stmtC (CmmJump target
[]
)
stmtC (CmmJump target)
; returnFC hp_rel }
where
...
...
compiler/codeGen/CgCon.lhs
View file @
1cb4a07c
...
...
@@ -352,8 +352,8 @@ cgReturnDataCon con amodes
}
where
enter_it = stmtsC [ CmmAssign nodeReg (cmmUntag (CmmReg nodeReg)),
CmmJump (entryCode (closureInfoPtr (CmmReg nodeReg)))
[]
]
jump_to lbl = stmtC (CmmJump (CmmLit lbl)
[]
)
CmmJump (entryCode (closureInfoPtr (CmmReg nodeReg)))]
jump_to lbl = stmtC (CmmJump (CmmLit lbl))
build_it_then return_code
= do { -- BUILD THE OBJECT IN THE HEAP
-- The first "con" says that the name bound to this
...
...
compiler/codeGen/CgHeapery.lhs
View file @
1cb4a07c
...
...
@@ -464,7 +464,7 @@ do_checks' stk_expr hp_expr stk_nonzero hp_nonzero reg_save_code rts_lbl
-- the appropriate RTS stub.
; exit_blk_id <- forkLabelledCode $ do {
; emitStmts reg_save_code
; stmtC (CmmJump rts_lbl
[]
) }
; stmtC (CmmJump rts_lbl) }
-- In the case of a heap-check failure, we must also set
-- HpAlloc. NB. HpAlloc is *only* set if Hp has been
...
...
compiler/codeGen/CgInfoTbls.hs
View file @
1cb4a07c
...
...
@@ -253,7 +253,7 @@ emitAlgReturnTarget name branches mb_deflt fam_sz
emitReturnInstr
::
Code
emitReturnInstr
=
do
{
info_amode
<-
getSequelAmode
;
stmtC
(
CmmJump
(
entryCode
info_amode
)
[]
)
}
;
stmtC
(
CmmJump
(
entryCode
info_amode
))
}
-----------------------------------------------------------------------------
--
...
...
compiler/codeGen/CgMonad.lhs
View file @
1cb4a07c
...
...
@@ -249,7 +249,7 @@ flattenCgStmts id stmts =
where (block,blocks) = flatten ss
isJump :: CmmStmt -> Bool
isJump (CmmJump _
_
) = True
isJump (CmmJump _
) = True
isJump (CmmBranch _ ) = True
isJump (CmmSwitch _ _) = True
isJump (CmmReturn _ ) = True
...
...
compiler/codeGen/CgTailCall.lhs
View file @
1cb4a07c
...
...
@@ -123,7 +123,7 @@ performTailCall fun_info arg_amodes pending_assts
EnterIt -> do
{ emitSimultaneously (node_asst `plusStmts` pending_assts)
; let target = entryCode (closureInfoPtr (CmmReg nodeReg))
enterClosure = stmtC (CmmJump target
[]
)
enterClosure = stmtC (CmmJump target)
-- If this is a scrutinee
-- let's check if the closure is a constructor
-- so we can directly jump to the alternatives switch
...
...
@@ -203,7 +203,7 @@ performTailCall fun_info arg_amodes pending_assts
-- No, enter the closure.
; enterClosure
; labelC is_constr
; stmtC (CmmJump (entryCode $ CmmLit (CmmLabel lbl))
[]
)
; stmtC (CmmJump (entryCode $ CmmLit (CmmLabel lbl)))
}
{-
-- This is a scrutinee for a case expression
...
...
@@ -218,7 +218,7 @@ performTailCall fun_info arg_amodes pending_assts
; stmtC (CmmCondBranch (cond1 tag) no_cons)
; stmtC (CmmCondBranch (cond2 tag) no_cons)
-- Yes, jump to switch statement
; stmtC (CmmJump (CmmLit (CmmLabel lbl))
[]
)
; stmtC (CmmJump (CmmLit (CmmLabel lbl)))
; labelC no_cons
-- No, enter the closure.
; enterClosure
...
...
@@ -438,9 +438,9 @@ pushReturnAddress _ = nopC
-- -----------------------------------------------------------------------------
-- Misc.
jumpToLbl :: CLabel -> Code
-- Passes no argument to the destination procedure
jumpToLbl lbl = stmtC (CmmJump (CmmLit (CmmLabel lbl)) [{- No args -}])
jumpToLbl :: CLabel -> Code
jumpToLbl lbl = stmtC (CmmJump (CmmLit (CmmLabel lbl)))
assignToRegs :: [(CmmExpr, GlobalReg)] -> CmmStmts
assignToRegs reg_args
...
...
compiler/codeGen/CgUtils.hs
View file @
1cb4a07c
...
...
@@ -1020,7 +1020,7 @@ fixStgRegStmt stmt
CmmSwitch
expr
ids
->
CmmSwitch
(
fixStgRegExpr
expr
)
ids
CmmJump
addr
regs
->
CmmJump
(
fixStgRegExpr
addr
)
regs
CmmJump
addr
->
CmmJump
(
fixStgRegExpr
addr
)
-- CmmNop, CmmComment, CmmBranch, CmmReturn
_other
->
stmt
...
...
compiler/llvmGen/LlvmCodeGen/CodeGen.hs
View file @
1cb4a07c
...
...
@@ -127,7 +127,7 @@ stmtToInstrs env stmt = case stmt of
->
genCall
env
target
res
args
ret
-- Tail call
CmmJump
arg
_
->
genJump
env
arg
CmmJump
arg
->
genJump
env
arg
-- CPS, only tail calls, no return's
-- Actually, there are a few return statements that occur because of hand
...
...
compiler/nativeGen/AsmCodeGen.lhs
View file @
1cb4a07c
...
...
@@ -878,9 +878,9 @@ cmmStmtConFold stmt
src' <- cmmExprConFold DataReference src
return $ CmmStore addr' src'
CmmJump addr
regs
CmmJump addr
-> do addr' <- cmmExprConFold JumpReference addr
return $ CmmJump addr'
regs
return $ CmmJump addr'
CmmCall target regs args returns
-> do target' <- case target of
...
...
compiler/nativeGen/PPC/CodeGen.hs
View file @
1cb4a07c
...
...
@@ -141,7 +141,7 @@ stmtToInstrs stmt = do
CmmBranch
id
->
genBranch
id
CmmCondBranch
arg
id
->
genCondJump
id
arg
CmmSwitch
arg
ids
->
genSwitch
arg
ids
CmmJump
arg
_
->
genJump
arg
CmmJump
arg
->
genJump
arg
CmmReturn
_
->
panic
"stmtToInstrs: return statement should have been cps'd away"
...
...
compiler/nativeGen/SPARC/CodeGen.hs
View file @
1cb4a07c
...
...
@@ -141,7 +141,7 @@ stmtToInstrs stmt = case stmt of
CmmBranch
id
->
genBranch
id
CmmCondBranch
arg
id
->
genCondJump
id
arg
CmmSwitch
arg
ids
->
genSwitch
arg
ids
CmmJump
arg
_
->
genJump
arg
CmmJump
arg
->
genJump
arg
CmmReturn
_
->
panic
"stmtToInstrs: return statement should have been cps'd away"
...
...
compiler/nativeGen/X86/CodeGen.hs
View file @
1cb4a07c
...
...
@@ -166,7 +166,7 @@ stmtToInstrs stmt = do
CmmBranch
id
->
genBranch
id
CmmCondBranch
arg
id
->
genCondJump
id
arg
CmmSwitch
arg
ids
->
genSwitch
arg
ids
CmmJump
arg
_
->
genJump
arg
CmmJump
arg
->
genJump
arg
CmmReturn
_
->
panic
"stmtToInstrs: return statement should have been cps'd away"
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment