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
5892af0e
Commit
5892af0e
authored
Nov 26, 2008
by
dias@eecs.harvard.edu
Browse files
drop some debugging traces and use only one flag for new codegen
parent
df54e4b6
Changes
9
Hide whitespace changes
Inline
Side-by-side
compiler/cmm/CmmCPSZ.hs
View file @
5892af0e
...
...
@@ -47,8 +47,8 @@ protoCmmCPSZ :: HscEnv -- Compilation env including
->
CmmZ
-- Input C-- with Procedures
->
IO
(
TopSRT
,
[
CmmZ
])
-- Output CPS transformed C--
protoCmmCPSZ
hsc_env
(
topSRT
,
rst
)
(
Cmm
tops
)
|
not
(
dopt
Opt_
RunCPSZ
(
hsc_dflags
hsc_env
))
=
return
(
topSRT
,
Cmm
tops
:
rst
)
-- Only if -f
run-cps
|
not
(
dopt
Opt_
TryNewCodeGen
(
hsc_dflags
hsc_env
))
=
return
(
topSRT
,
Cmm
tops
:
rst
)
-- Only if -f
new-codegen
|
otherwise
=
do
let
dflags
=
hsc_dflags
hsc_env
showPass
dflags
"CPSZ"
...
...
compiler/codeGen/CgCallConv.hs
View file @
5892af0e
...
...
@@ -369,7 +369,7 @@ assign_regs args supply
assign_reg
::
CgRep
->
AvailRegs
->
Maybe
(
GlobalReg
,
AvailRegs
)
assign_reg
FloatArg
(
vs
,
f
:
fs
,
ds
,
ls
)
=
Just
(
FloatReg
f
,
(
vs
,
fs
,
ds
,
ls
))
assign_reg
DoubleArg
(
vs
,
fs
,
d
:
ds
,
ls
)
=
Just
(
DoubleReg
d
,
(
vs
,
fs
,
ds
,
ls
))
assign_reg
LongArg
(
vs
,
fs
,
ds
,
l
:
ls
)
=
pprTrace
"longArg"
(
ppr
l
)
$
Just
(
LongReg
l
,
(
vs
,
fs
,
ds
,
ls
))
assign_reg
LongArg
(
vs
,
fs
,
ds
,
l
:
ls
)
=
Just
(
LongReg
l
,
(
vs
,
fs
,
ds
,
ls
))
assign_reg
PtrArg
(
v
:
vs
,
fs
,
ds
,
ls
)
=
Just
(
VanillaReg
v
VGcPtr
,
(
vs
,
fs
,
ds
,
ls
))
assign_reg
NonPtrArg
(
v
:
vs
,
fs
,
ds
,
ls
)
=
Just
(
VanillaReg
v
VNonGcPtr
,
(
vs
,
fs
,
ds
,
ls
))
-- PtrArg and NonPtrArg both go in a vanilla register
...
...
compiler/codeGen/StgCmmBind.hs
View file @
5892af0e
...
...
@@ -87,8 +87,7 @@ cgTopRhsClosure id ccs _ upd_flag srt args body = do
;
forkClosureBody
(
closureCodeBody
True
id
closure_info
ccs
(
nonVoidIds
args
)
(
length
args
)
body
fv_details
)
;
pprTrace
"arity for"
(
ppr
id
<+>
ppr
(
length
args
)
<+>
ppr
args
)
$
returnFC
cg_id_info
}
;
returnFC
cg_id_info
}
------------------------------------------------------------------------
-- Non-top-level bindings
...
...
@@ -154,8 +153,7 @@ cgRhs name (StgRhsCon maybe_cc con args)
=
buildDynCon
name
maybe_cc
con
args
cgRhs
name
(
StgRhsClosure
cc
bi
fvs
upd_flag
srt
args
body
)
=
pprTrace
"cgRhs closure"
(
ppr
name
<+>
ppr
args
)
$
mkRhsClosure
name
cc
bi
(
nonVoidIds
fvs
)
upd_flag
srt
args
body
=
mkRhsClosure
name
cc
bi
(
nonVoidIds
fvs
)
upd_flag
srt
args
body
------------------------------------------------------------------------
-- Non-constructor right hand sides
...
...
@@ -421,7 +419,7 @@ bind_fv (id, off) = do { reg <- rebindToReg id; return (reg, off) }
load_fvs
::
LocalReg
->
LambdaFormInfo
->
[(
LocalReg
,
WordOff
)]
->
FCode
()
load_fvs
node
lf_info
=
mapCs
(
\
(
reg
,
off
)
->
pprTrace
"get tag for"
(
ppr
reg
<+>
ppr
tag
)
$
emit
$
mkTaggedObjectLoad
reg
node
off
tag
)
emit
$
mkTaggedObjectLoad
reg
node
off
tag
)
where
tag
=
lfDynTag
lf_info
-----------------------------------------
...
...
compiler/codeGen/StgCmmClosure.hs
View file @
5892af0e
...
...
@@ -337,8 +337,8 @@ tagForArity arity | isSmallFamily arity = arity
lfDynTag
::
LambdaFormInfo
->
DynTag
-- Return the tag in the low order bits of a variable bound
-- to this LambdaForm
lfDynTag
(
LFCon
con
)
=
pprTrace
"tagForCon"
(
ppr
con
<+>
ppr
(
tagForCon
con
))
$
tagForCon
con
lfDynTag
(
LFReEntrant
_
arity
_
_
)
=
pprTrace
"reentrant"
(
ppr
arity
)
$
tagForArity
arity
lfDynTag
(
LFCon
con
)
=
tagForCon
con
lfDynTag
(
LFReEntrant
_
arity
_
_
)
=
tagForArity
arity
lfDynTag
_other
=
0
...
...
@@ -508,8 +508,7 @@ getCallMethod name caf (LFReEntrant _ arity _ _) n_args
|
n_args
==
0
=
ASSERT
(
arity
/=
0
)
ReturnIt
-- No args at all
|
n_args
<
arity
=
SlowCall
-- Not enough args
|
otherwise
=
pprTrace
"getCallMethod"
(
ppr
name
<+>
ppr
arity
)
$
DirectEntry
(
enterIdLabel
name
caf
)
arity
|
otherwise
=
DirectEntry
(
enterIdLabel
name
caf
)
arity
getCallMethod
_name
_
LFUnLifted
n_args
=
ASSERT
(
n_args
==
0
)
ReturnIt
...
...
compiler/codeGen/StgCmmCon.hs
View file @
5892af0e
...
...
@@ -210,8 +210,7 @@ bindConArgs (DataAlt con) base args
bind_arg
::
(
NonVoid
Id
,
VirtualHpOffset
)
->
FCode
LocalReg
bind_arg
(
arg
,
offset
)
=
do
{
emit
$
mkTaggedObjectLoad
(
idToReg
arg
)
base
offset
tag
;
pprTrace
"bind_arg gets tag"
(
ppr
arg
<+>
ppr
tag
)
$
bindArgToReg
arg
}
;
bindArgToReg
arg
}
bindConArgs
_other_con
_base
args
=
ASSERT
(
null
args
)
return
[]
...
...
compiler/codeGen/StgCmmExpr.hs
View file @
5892af0e
...
...
@@ -396,7 +396,7 @@ cgAltRhss gc_plan bndr alts
cg_alt
(
con
,
bndrs
,
_uses
,
rhs
)
=
getCodeR
$
maybeAltHeapCheck
gc_plan
$
do
{
pprTrace
"binding args for"
(
ppr
bndr
<+>
ppr
con
)
$
bindConArgs
con
base_reg
bndrs
do
{
bindConArgs
con
base_reg
bndrs
;
cgExpr
rhs
;
return
con
}
...
...
compiler/codeGen/StgCmmLayout.hs
View file @
5892af0e
...
...
@@ -472,9 +472,7 @@ emitClosureProcAndInfoTable top_lvl bndr cl_info args body
-- top-level binding, which this binding would incorrectly shadow.
;
node
<-
if
top_lvl
then
return
$
idToReg
(
NonVoid
bndr
)
else
bindToReg
(
NonVoid
bndr
)
lf_info
;
arg_regs
<-
pprTrace
"bindArgsToRegs"
(
ppr
args
)
$
bindArgsToRegs
args
;
arg_regs
<-
bindArgsToRegs
args
;
emitClosureAndInfoTable
cl_info
(
node
:
arg_regs
)
$
body
(
node
,
arg_regs
)
}
...
...
compiler/codeGen/StgCmmPrim.hs
View file @
5892af0e
...
...
@@ -82,7 +82,7 @@ cgOpApp (StgPrimOp primop) args res_ty
|
primOpOutOfLine
primop
=
do
{
cmm_args
<-
getNonVoidArgAmodes
args
;
let
fun
=
CmmLit
(
CmmLabel
(
mkRtsPrimOpLabel
primop
))
;
pprTrace
"cgOpApp"
(
ppr
primop
)
$
emitCall
PrimOp
fun
cmm_args
}
;
emitCall
PrimOp
fun
cmm_args
}
|
ReturnsPrim
VoidRep
<-
result_info
=
do
cgPrimOp
[]
primop
args
...
...
compiler/main/HscMain.lhs
View file @
5892af0e
...
...
@@ -673,7 +673,7 @@ hscGenHardCode cgguts mod_summary
then do cmms <- tryNewCodeGen hsc_env this_mod data_tycons
dir_imps cost_centre_info
stg_binds hpc_info
pprTrace "cmms" (ppr cmms) $
return cmms
return cmms
else {-# SCC "CodeGen" #-}
codeGen dflags this_mod data_tycons
dir_imps cost_centre_info
...
...
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