Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Shayne Fletcher
Glasgow Haskell Compiler
Commits
bb66ce57
Commit
bb66ce57
authored
Aug 20, 2007
by
nr@eecs.harvard.edu
Browse files
put CmmReturnInfo into a CmmCall (and related types)
parent
fdd372f9
Changes
16
Hide whitespace changes
Inline
Side-by-side
compiler/cmm/Cmm.hs
View file @
bb66ce57
...
...
@@ -12,7 +12,7 @@ module Cmm (
CmmInfo
(
..
),
UpdateFrame
(
..
),
CmmInfoTable
(
..
),
ClosureTypeInfo
(
..
),
ProfilingInfo
(
..
),
ClosureTypeTag
,
GenBasicBlock
(
..
),
CmmBasicBlock
,
blockId
,
blockStmts
,
mapBlockStmts
,
ReturnInfo
(
..
),
Cmm
ReturnInfo
(
..
),
CmmStmt
(
..
),
CmmActuals
,
CmmFormal
,
CmmFormals
,
CmmHintFormals
,
CmmSafety
(
..
),
CmmCallTarget
(
..
),
...
...
@@ -141,8 +141,8 @@ data ClosureTypeInfo
[
Maybe
LocalReg
]
-- Forced stack parameters
C_SRT
data
ReturnInfo
=
MayReturn
|
NeverReturns
data
Cmm
ReturnInfo
=
Cmm
MayReturn
|
Cmm
NeverReturns
-- TODO: These types may need refinement
data
ProfilingInfo
=
ProfilingInfo
CmmLit
CmmLit
-- closure_type, closure_desc
...
...
@@ -185,6 +185,7 @@ data CmmStmt
CmmHintFormals
-- zero or more results
CmmActuals
-- zero or more arguments
CmmSafety
-- whether to build a continuation
CmmReturnInfo
|
CmmBranch
BlockId
-- branch to another BB in this fn
...
...
compiler/cmm/CmmBrokenBlock.hs
View file @
bb66ce57
...
...
@@ -143,6 +143,7 @@ data FinalStmt
-- (redundant with ContinuationEntry)
CmmActuals
-- ^ Arguments to call
C_SRT
-- ^ SRT for the continuation's info table
CmmReturnInfo
-- ^ Does the function return?
Bool
-- ^ True <=> GC block so ignore stack size
|
FinalSwitch
-- ^ Same as a 'CmmSwitch'
...
...
@@ -258,7 +259,7 @@ breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry =
-- Detect this special case to remain an inverse of
-- 'cmmBlockFromBrokenBlock'
[
CmmCall
target
results
arguments
(
CmmSafe
srt
),
[
CmmCall
target
results
arguments
(
CmmSafe
srt
)
ret
,
CmmBranch
next_id
]
->
([
cont_info
],
[
block
])
where
...
...
@@ -266,15 +267,15 @@ breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry =
ContFormat
results
srt
(
ident
`
elem
`
gc_block_idents
))
block
=
do_call
current_id
entry
accum_stmts
exits
next_id
target
results
arguments
srt
target
results
arguments
srt
ret
-- Break the block on safe calls (the main job of this function)
(
CmmCall
target
results
arguments
(
CmmSafe
srt
)
:
stmts
)
->
(
CmmCall
target
results
arguments
(
CmmSafe
srt
)
ret
:
stmts
)
->
(
cont_info
:
cont_infos
,
block
:
blocks
)
where
next_id
=
BlockId
$
head
uniques
block
=
do_call
current_id
entry
accum_stmts
exits
next_id
target
results
arguments
srt
target
results
arguments
srt
ret
cont_info
=
(
next_id
,
-- Entry convention for the
-- continuation of the call
...
...
@@ -287,12 +288,12 @@ breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry =
-- Unsafe calls don't need a continuation
-- but they do need to be expanded
(
CmmCall
target
results
arguments
CmmUnsafe
:
stmts
)
->
(
CmmCall
target
results
arguments
CmmUnsafe
ret
:
stmts
)
->
breakBlock'
remaining_uniques
current_id
entry
exits
(
accum_stmts
++
arg_stmts
++
caller_save
++
[
CmmCall
target
results
new_args
CmmUnsafe
]
++
[
CmmCall
target
results
new_args
CmmUnsafe
ret
]
++
caller_load
)
stmts
where
...
...
@@ -309,9 +310,9 @@ breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry =
stmts
do_call
current_id
entry
accum_stmts
exits
next_id
target
results
arguments
srt
=
target
results
arguments
srt
ret
=
BrokenBlock
current_id
entry
accum_stmts
(
next_id
:
exits
)
(
FinalCall
next_id
target
results
arguments
srt
(
FinalCall
next_id
target
results
arguments
srt
ret
(
current_id
`
elem
`
gc_block_idents
))
cond_branch_target
(
CmmCondBranch
_
target
)
=
[
target
]
...
...
@@ -350,7 +351,7 @@ adaptBlockToFormat :: [(BlockId, ContFormat)]
adaptBlockToFormat
formats
unique
block
@
(
BrokenBlock
ident
entry
stmts
targets
exit
@
(
FinalCall
next
target
formals
actuals
srt
is_gc
))
=
actuals
srt
ret
is_gc
))
=
if
format_formals
==
formals
&&
format_srt
==
srt
&&
format_is_gc
==
is_gc
...
...
@@ -367,7 +368,7 @@ adaptBlockToFormat formats unique
revised_targets
=
adaptor_ident
:
delete
next
targets
revised_exit
=
FinalCall
adaptor_ident
-- ^ The only part that changed
target
formals
actuals
srt
is_gc
target
formals
actuals
srt
ret
is_gc
adaptor_block
=
mk_adaptor_block
adaptor_ident
(
ContinuationEntry
(
map
fst
formals
)
srt
is_gc
)
...
...
@@ -401,8 +402,8 @@ cmmBlockFromBrokenBlock (BrokenBlock ident _ stmts _ exit) =
FinalReturn
arguments
->
[
CmmReturn
arguments
]
FinalJump
target
arguments
->
[
CmmJump
target
arguments
]
FinalSwitch
expr
targets
->
[
CmmSwitch
expr
targets
]
FinalCall
branch_target
call_target
results
arguments
srt
_
->
[
CmmCall
call_target
results
arguments
(
CmmSafe
srt
),
FinalCall
branch_target
call_target
results
arguments
srt
ret
_
->
[
CmmCall
call_target
results
arguments
(
CmmSafe
srt
)
ret
,
CmmBranch
branch_target
]
-----------------------------------------------------------------------------
...
...
compiler/cmm/CmmCPS.hs
View file @
bb66ce57
...
...
@@ -355,8 +355,8 @@ continuationMaxStack formats (Continuation _ label _ False blocks) =
argumentsSize
(
cmmExprRep
.
fst
)
args
final_arg_size
(
FinalJump
_
args
)
=
argumentsSize
(
cmmExprRep
.
fst
)
args
final_arg_size
(
FinalCall
next
_
_
args
_
True
)
=
0
final_arg_size
(
FinalCall
next
_
_
args
_
False
)
=
final_arg_size
(
FinalCall
next
_
_
args
_
_
True
)
=
0
final_arg_size
(
FinalCall
next
_
_
args
_
_
False
)
=
-- We have to account for the stack used when we build a frame
-- for the *next* continuation from *this* continuation
argumentsSize
(
cmmExprRep
.
fst
)
args
+
...
...
@@ -369,7 +369,7 @@ continuationMaxStack formats (Continuation _ label _ False blocks) =
stmt_arg_size
(
CmmJump
_
args
)
=
argumentsSize
(
cmmExprRep
.
fst
)
args
stmt_arg_size
(
CmmCall
_
_
_
(
CmmSafe
_
))
=
stmt_arg_size
(
CmmCall
_
_
_
(
CmmSafe
_
)
_
)
=
panic
"Safe call in processFormats"
stmt_arg_size
(
CmmReturn
_
)
=
panic
"CmmReturn in processFormats"
...
...
compiler/cmm/CmmCPSGen.hs
View file @
bb66ce57
...
...
@@ -194,7 +194,7 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
-- A regular Cmm function call
FinalCall
next
(
CmmCallee
target
CmmCallConv
)
results
arguments
_
_
->
results
arguments
_
_
_
->
pack_continuation
curr_format
cont_format
++
tail_call
(
curr_stack
-
cont_stack
)
target
arguments
...
...
@@ -205,7 +205,7 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
-- A safe foreign call
FinalCall
next
(
CmmCallee
target
conv
)
results
arguments
_
_
->
results
arguments
_
_
_
->
target_stmts
++
foreignCall
call_uniques'
(
CmmCallee
new_target
conv
)
results
arguments
...
...
@@ -215,7 +215,7 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
-- A safe prim call
FinalCall
next
(
CmmPrim
target
)
results
arguments
_
_
->
results
arguments
_
_
_
->
foreignCall
call_uniques
(
CmmPrim
target
)
results
arguments
...
...
@@ -229,12 +229,14 @@ foreignCall uniques call results arguments =
[
CmmCall
(
CmmCallee
suspendThread
CCallConv
)
[
(
id
,
PtrHint
)
]
[
(
CmmReg
(
CmmGlobal
BaseReg
),
PtrHint
)
]
CmmUnsafe
,
CmmCall
call
results
new_args
CmmUnsafe
,
CmmUnsafe
CmmMayReturn
,
CmmCall
call
results
new_args
CmmUnsafe
CmmMayReturn
,
CmmCall
(
CmmCallee
resumeThread
CCallConv
)
[
(
new_base
,
PtrHint
)
]
[
(
CmmReg
(
CmmLocal
id
),
PtrHint
)
]
CmmUnsafe
,
CmmUnsafe
CmmMayReturn
,
-- Assign the result to BaseReg: we
-- might now have a different Capability!
CmmAssign
(
CmmGlobal
BaseReg
)
(
CmmReg
(
CmmLocal
new_base
))]
++
...
...
compiler/cmm/CmmLint.hs
View file @
bb66ce57
...
...
@@ -122,7 +122,7 @@ lintCmmStmt (CmmStore l r) = do
lintCmmExpr
l
lintCmmExpr
r
return
()
lintCmmStmt
(
CmmCall
_target
_res
args
_
)
=
mapM_
(
lintCmmExpr
.
fst
)
args
lintCmmStmt
(
CmmCall
_target
_res
args
_
_
)
=
mapM_
(
lintCmmExpr
.
fst
)
args
lintCmmStmt
(
CmmCondBranch
e
_id
)
=
lintCmmExpr
e
>>
checkCond
e
>>
return
()
lintCmmStmt
(
CmmSwitch
e
_branches
)
=
do
erep
<-
lintCmmExpr
e
...
...
compiler/cmm/CmmLive.hs
View file @
bb66ce57
...
...
@@ -170,7 +170,7 @@ cmmStmtLive _ (CmmAssign reg expr) =
(
CmmGlobal
_
)
->
id
cmmStmtLive
_
(
CmmStore
expr1
expr2
)
=
cmmExprLive
expr2
.
cmmExprLive
expr1
cmmStmtLive
_
(
CmmCall
target
results
arguments
_
)
=
cmmStmtLive
_
(
CmmCall
target
results
arguments
_
_
)
=
target_liveness
.
foldr
((
.
)
.
cmmExprLive
)
id
(
map
fst
arguments
)
.
addKilled
(
mkUniqSet
$
cmmHintFormalsToLiveLocals
results
)
where
...
...
compiler/cmm/CmmOpt.hs
View file @
bb66ce57
...
...
@@ -139,7 +139,7 @@ lookForInline u expr (stmt:stmts)
getStmtUses
::
CmmStmt
->
UniqFM
Int
getStmtUses
(
CmmAssign
_
e
)
=
getExprUses
e
getStmtUses
(
CmmStore
e1
e2
)
=
plusUFM_C
(
+
)
(
getExprUses
e1
)
(
getExprUses
e2
)
getStmtUses
(
CmmCall
target
_
es
_
)
getStmtUses
(
CmmCall
target
_
es
_
_
)
=
plusUFM_C
(
+
)
(
uses
target
)
(
getExprsUses
(
map
fst
es
))
where
uses
(
CmmCallee
e
_
)
=
getExprUses
e
uses
_
=
emptyUFM
...
...
@@ -160,8 +160,8 @@ getExprsUses es = foldr (plusUFM_C (+)) emptyUFM (map getExprUses es)
inlineStmt
::
Unique
->
CmmExpr
->
CmmStmt
->
CmmStmt
inlineStmt
u
a
(
CmmAssign
r
e
)
=
CmmAssign
r
(
inlineExpr
u
a
e
)
inlineStmt
u
a
(
CmmStore
e1
e2
)
=
CmmStore
(
inlineExpr
u
a
e1
)
(
inlineExpr
u
a
e2
)
inlineStmt
u
a
(
CmmCall
target
regs
es
srt
)
=
CmmCall
(
infn
target
)
regs
es'
srt
inlineStmt
u
a
(
CmmCall
target
regs
es
srt
ret
)
=
CmmCall
(
infn
target
)
regs
es'
srt
ret
where
infn
(
CmmCallee
fn
cconv
)
=
CmmCallee
fn
cconv
infn
(
CmmPrim
p
)
=
CmmPrim
p
es'
=
[
(
inlineExpr
u
a
e
,
hint
)
|
(
e
,
hint
)
<-
es
]
...
...
compiler/cmm/CmmParse.y
View file @
bb66ce57
...
...
@@ -339,9 +339,9 @@ stmt :: { ExtCode }
| 'if' bool_expr '{' body '}' else
{ ifThenElse $2 $4 $6 }
opt_never_returns :: { ReturnInfo }
: { MayReturn }
| 'never' 'returns' { NeverReturns }
opt_never_returns :: {
Cmm
ReturnInfo }
: {
Cmm
MayReturn }
| 'never' 'returns' {
Cmm
NeverReturns }
bool_expr :: { ExtFCode BoolExpr }
: bool_op { $1 }
...
...
@@ -873,9 +873,9 @@ foreignCall
-> [ExtFCode (CmmExpr,MachHint)]
-> Maybe [GlobalReg]
-> CmmSafety
-> ReturnInfo
->
Cmm
ReturnInfo
-> P ExtCode
foreignCall conv_string results_code expr_code args_code vols safety
_
ret
foreignCall conv_string results_code expr_code args_code vols safety ret
= do convention <- case conv_string of
"C" -> return CCallConv
"C--" -> return CmmCallConv
...
...
@@ -887,14 +887,14 @@ foreignCall conv_string results_code expr_code args_code vols safety _ret
--code (stmtC (CmmCall (CmmCallee expr convention) results args safety))
case convention of
-- Temporary hack so at least some functions are CmmSafe
CmmCallConv -> code (stmtC (CmmCall (CmmCallee expr convention) results args safety))
CmmCallConv -> code (stmtC (CmmCall (CmmCallee expr convention) results args safety
ret
))
_ -> case safety of
CmmUnsafe ->
code (emitForeignCall' PlayRisky results
(CmmCallee expr convention) args vols NoC_SRT)
(CmmCallee expr convention) args vols NoC_SRT
ret
)
CmmSafe srt ->
code (emitForeignCall' (PlaySafe unused) results
(CmmCallee expr convention) args vols NoC_SRT) where
(CmmCallee expr convention) args vols NoC_SRT
ret
) where
unused = panic "not used by emitForeignCall'"
primCall
...
...
@@ -913,10 +913,10 @@ primCall results_code name args_code vols safety
case safety of
CmmUnsafe ->
code (emitForeignCall' PlayRisky results
(CmmPrim p) args vols NoC_SRT)
(CmmPrim p) args vols NoC_SRT
CmmMayReturn
)
CmmSafe srt ->
code (emitForeignCall' (PlaySafe unused) results
(CmmPrim p) args vols NoC_SRT) where
(CmmPrim p) args vols NoC_SRT
CmmMayReturn
) where
unused = panic "not used by emitForeignCall'"
doStore :: MachRep -> ExtFCode CmmExpr -> ExtFCode CmmExpr -> ExtCode
...
...
compiler/cmm/PprC.hs
View file @
bb66ce57
...
...
@@ -199,7 +199,7 @@ pprStmt stmt = case stmt of
where
rep
=
cmmExprRep
src
CmmCall
(
CmmCallee
fn
cconv
)
results
args
safety
->
CmmCall
(
CmmCallee
fn
cconv
)
results
args
safety
_ret
->
-- Controversial: leave this out for now.
-- pprUndef fn $$
...
...
@@ -220,7 +220,7 @@ pprStmt stmt = case stmt of
ptext
SLIT
(
"#undef"
)
<+>
pprCLabel
lbl
pprUndef
_
=
empty
CmmCall
(
CmmPrim
op
)
results
args
safety
->
CmmCall
(
CmmPrim
op
)
results
args
safety
_ret
->
pprCall
ppr_fn
CCallConv
results
args
safety
where
ppr_fn
=
pprCallishMachOp_for_C
op
...
...
@@ -837,7 +837,7 @@ te_Lit _ = return ()
te_Stmt
::
CmmStmt
->
TE
()
te_Stmt
(
CmmAssign
r
e
)
=
te_Reg
r
>>
te_Expr
e
te_Stmt
(
CmmStore
l
r
)
=
te_Expr
l
>>
te_Expr
r
te_Stmt
(
CmmCall
_
rs
es
_
)
=
mapM_
(
te_temp
.
fst
)
rs
>>
te_Stmt
(
CmmCall
_
rs
es
_
_
)
=
mapM_
(
te_temp
.
fst
)
rs
>>
mapM_
(
te_Expr
.
fst
)
es
te_Stmt
(
CmmCondBranch
e
_
)
=
te_Expr
e
te_Stmt
(
CmmSwitch
e
_
)
=
te_Expr
e
...
...
compiler/cmm/PprCmm.hs
View file @
bb66ce57
...
...
@@ -212,7 +212,7 @@ pprStmt stmt = case stmt of
-- call "ccall" foo(x, y)[r1, r2];
-- ToDo ppr volatile
CmmCall
(
CmmCallee
fn
cconv
)
results
args
safety
->
CmmCall
(
CmmCallee
fn
cconv
)
results
args
safety
ret
->
hcat
[
if
null
results
then
empty
else
parens
(
commafy
$
map
ppr
results
)
<>
...
...
@@ -220,14 +220,17 @@ pprStmt stmt = case stmt of
ptext
SLIT
(
"call"
),
space
,
doubleQuotes
(
ppr
cconv
),
space
,
target
fn
,
parens
(
commafy
$
map
ppr
args
),
brackets
(
ppr
safety
),
semi
]
brackets
(
ppr
safety
),
case
ret
of
CmmMayReturn
->
empty
CmmNeverReturns
->
ptext
SLIT
(
" never returns"
),
semi
]
where
target
(
CmmLit
lit
)
=
pprLit
lit
target
fn'
=
parens
(
ppr
fn'
)
CmmCall
(
CmmPrim
op
)
results
args
safety
->
CmmCall
(
CmmPrim
op
)
results
args
safety
ret
->
pprStmt
(
CmmCall
(
CmmCallee
(
CmmLit
lbl
)
CCallConv
)
results
args
safety
)
results
args
safety
ret
)
where
lbl
=
CmmLabel
(
mkForeignLabel
(
mkFastString
(
show
op
))
Nothing
False
)
...
...
compiler/codeGen/CgForeignCall.hs
View file @
bb66ce57
...
...
@@ -73,7 +73,7 @@ emitForeignCall results (CCall (CCallSpec target cconv safety)) args live
=
do
vols
<-
getVolatileRegs
live
srt
<-
getSRTInfo
emitForeignCall'
safety
results
(
CmmCallee
cmm_target
cconv
)
call_args
(
Just
vols
)
srt
(
CmmCallee
cmm_target
cconv
)
call_args
(
Just
vols
)
srt
CmmMayReturn
where
(
call_args
,
cmm_target
)
=
case
target
of
...
...
@@ -104,13 +104,14 @@ emitForeignCall'
->
[(
CmmExpr
,
MachHint
)]
-- arguments
->
Maybe
[
GlobalReg
]
-- live vars, in case we need to save them
->
C_SRT
-- the SRT of the calls continuation
->
CmmReturnInfo
->
Code
emitForeignCall'
safety
results
target
args
vols
srt
emitForeignCall'
safety
results
target
args
vols
srt
ret
|
not
(
playSafe
safety
)
=
do
temp_args
<-
load_args_into_temps
args
let
(
caller_save
,
caller_load
)
=
callerSaveVolatileRegs
vols
stmtsC
caller_save
stmtC
(
CmmCall
target
results
temp_args
CmmUnsafe
)
stmtC
(
CmmCall
target
results
temp_args
CmmUnsafe
ret
)
stmtsC
caller_load
|
otherwise
=
do
...
...
@@ -131,12 +132,12 @@ emitForeignCall' safety results target args vols srt
stmtC
(
CmmCall
(
CmmCallee
suspendThread
CCallConv
)
[
(
id
,
PtrHint
)
]
[
(
CmmReg
(
CmmGlobal
BaseReg
),
PtrHint
)
]
CmmUnsafe
)
stmtC
(
CmmCall
temp_target
results
temp_args
CmmUnsafe
)
CmmUnsafe
ret
)
stmtC
(
CmmCall
temp_target
results
temp_args
CmmUnsafe
ret
)
stmtC
(
CmmCall
(
CmmCallee
resumeThread
CCallConv
)
[
(
new_base
,
PtrHint
)
]
[
(
CmmReg
(
CmmLocal
id
),
PtrHint
)
]
CmmUnsafe
)
CmmUnsafe
ret
)
-- Assign the result to BaseReg: we
-- might now have a different Capability!
stmtC
(
CmmAssign
(
CmmGlobal
BaseReg
)
(
CmmReg
(
CmmLocal
new_base
)))
...
...
compiler/codeGen/CgHpc.hs
View file @
bb66ce57
...
...
@@ -76,6 +76,7 @@ initHpc this_mod (HpcInfo tickCount hashNo)
]
(
Just
[]
)
NoC_SRT
-- No SRT b/c we PlayRisky
CmmMayReturn
}
where
mod_alloc
=
mkFastString
"hs_hpc_module"
...
...
compiler/codeGen/CgPrimOp.hs
View file @
bb66ce57
...
...
@@ -121,6 +121,7 @@ emitPrimOp [res] ParOp [arg] live
[(
CmmReg
(
CmmGlobal
BaseReg
),
PtrHint
),
(
arg
,
PtrHint
)]
(
Just
vols
)
NoC_SRT
-- No SRT b/c we do PlayRisky
CmmMayReturn
where
newspark
=
CmmLit
(
CmmLabel
(
mkRtsCodeLabel
SLIT
(
"newSpark"
)))
...
...
@@ -138,6 +139,7 @@ emitPrimOp [] WriteMutVarOp [mutv,var] live
[(
CmmReg
(
CmmGlobal
BaseReg
),
PtrHint
),
(
mutv
,
PtrHint
)]
(
Just
vols
)
NoC_SRT
-- No SRT b/c we do PlayRisky
CmmMayReturn
-- #define sizzeofByteArrayzh(r,a) \
-- r = (((StgArrWords *)(a))->words * sizeof(W_))
...
...
@@ -344,6 +346,7 @@ emitPrimOp [res] op args live
[(
a
,
NoHint
)
|
a
<-
args
]
-- ToDo: hints?
(
Just
vols
)
NoC_SRT
-- No SRT b/c we do PlayRisky
CmmMayReturn
|
Just
mop
<-
translateOp
op
=
let
stmt
=
CmmAssign
(
CmmLocal
res
)
(
CmmMachOp
mop
args
)
in
...
...
compiler/codeGen/CgUtils.hs
View file @
bb66ce57
...
...
@@ -354,7 +354,7 @@ emitRtsCall' res fun args vols safe = do
then
getSRTInfo
>>=
(
return
.
CmmSafe
)
else
return
CmmUnsafe
stmtsC
caller_save
stmtC
(
CmmCall
target
res
args
safety
)
stmtC
(
CmmCall
target
res
args
safety
CmmMayReturn
)
stmtsC
caller_load
where
(
caller_save
,
caller_load
)
=
callerSaveVolatileRegs
vols
...
...
compiler/nativeGen/AsmCodeGen.lhs
View file @
bb66ce57
...
...
@@ -517,7 +517,7 @@ cmmStmtConFold stmt
-> do addr' <- cmmExprConFold JumpReference addr
return $ CmmJump addr' regs
CmmCall target regs args srt
CmmCall target regs args srt
returns
-> do target' <- case target of
CmmCallee e conv -> do
e' <- cmmExprConFold CallReference e
...
...
@@ -526,7 +526,7 @@ cmmStmtConFold stmt
args' <- mapM (\(arg, hint) -> do
arg' <- cmmExprConFold DataReference arg
return (arg', hint)) args
return $ CmmCall target' regs args' srt
return $ CmmCall target' regs args' srt
returns
CmmCondBranch test dest
-> do test' <- cmmExprConFold DataReference test
...
...
compiler/nativeGen/MachCodeGen.hs
View file @
bb66ce57
...
...
@@ -121,7 +121,7 @@ stmtToInstrs stmt = case stmt of
|
otherwise
->
assignMem_IntCode
kind
addr
src
where
kind
=
cmmExprRep
src
CmmCall
target
result_regs
args
_
CmmCall
target
result_regs
args
_
_
->
genCCall
target
result_regs
args
CmmBranch
id
->
genBranch
id
...
...
@@ -3206,13 +3206,13 @@ outOfLineFloatOp mop res args
if
localRegRep
res
==
F64
then
stmtToInstrs
(
CmmCall
target
[(
res
,
FloatHint
)]
args
CmmUnsafe
)
stmtToInstrs
(
CmmCall
target
[(
res
,
FloatHint
)]
args
CmmUnsafe
CmmMayReturn
)
else
do
uq
<-
getUniqueNat
let
tmp
=
LocalReg
uq
F64
KindNonPtr
-- in
code1
<-
stmtToInstrs
(
CmmCall
target
[(
tmp
,
FloatHint
)]
args
CmmUnsafe
)
code1
<-
stmtToInstrs
(
CmmCall
target
[(
tmp
,
FloatHint
)]
args
CmmUnsafe
CmmMayReturn
)
code2
<-
stmtToInstrs
(
CmmAssign
(
CmmLocal
res
)
(
CmmReg
(
CmmLocal
tmp
)))
return
(
code1
`
appOL
`
code2
)
where
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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