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
7937a921
Commit
7937a921
authored
Jun 13, 2012
by
Ian Lynagh
Browse files
Remove some unnecessary platform arguments
parent
03f78f06
Changes
9
Hide whitespace changes
Inline
Side-by-side
compiler/cmm/CLabel.hs
View file @
7937a921
...
...
@@ -252,8 +252,8 @@ data ForeignLabelSource
-- We can't make a Show instance for CLabel because lots of its components don't have instances.
-- The regular Outputable instance only shows the label name, and not its other info.
--
pprDebugCLabel
::
Platform
->
CLabel
->
SDoc
pprDebugCLabel
_
lbl
pprDebugCLabel
::
CLabel
->
SDoc
pprDebugCLabel
lbl
=
case
lbl
of
IdLabel
{}
->
ppr
lbl
<>
(
parens
$
text
"IdLabel"
)
CmmLabel
pkg
_name
_info
...
...
@@ -533,38 +533,38 @@ mkPlainModuleInitLabel mod = PlainModuleInitLabel mod
-- -----------------------------------------------------------------------------
-- Convert between different kinds of label
toClosureLbl
::
Platform
->
CLabel
->
CLabel
toClosureLbl
_
(
IdLabel
n
c
_
)
=
IdLabel
n
c
Closure
toClosureLbl
platform
l
=
pprPanic
"toClosureLbl"
(
ppr
CLabel
platform
l
)
toSlowEntryLbl
::
Platform
->
CLabel
->
CLabel
toSlowEntryLbl
_
(
IdLabel
n
c
_
)
=
IdLabel
n
c
Slow
toSlowEntryLbl
platform
l
=
pprPanic
"toSlowEntryLbl"
(
ppr
CLabel
platform
l
)
toRednCountsLbl
::
Platform
->
CLabel
->
CLabel
toRednCountsLbl
_
(
IdLabel
n
c
_
)
=
IdLabel
n
c
RednCounts
toRednCountsLbl
platform
l
=
pprPanic
"toRednCountsLbl"
(
ppr
CLabel
platform
l
)
toEntryLbl
::
Platform
->
CLabel
->
CLabel
toEntryLbl
_
(
IdLabel
n
c
LocalInfoTable
)
=
IdLabel
n
c
LocalEntry
toEntryLbl
_
(
IdLabel
n
c
ConInfoTable
)
=
IdLabel
n
c
ConEntry
toEntryLbl
_
(
IdLabel
n
c
StaticInfoTable
)
=
IdLabel
n
c
StaticConEntry
toEntryLbl
_
(
IdLabel
n
c
_
)
=
IdLabel
n
c
Entry
toEntryLbl
_
(
CaseLabel
n
CaseReturnInfo
)
=
CaseLabel
n
CaseReturnPt
toEntryLbl
_
(
CmmLabel
m
str
CmmInfo
)
=
CmmLabel
m
str
CmmEntry
toEntryLbl
_
(
CmmLabel
m
str
CmmRetInfo
)
=
CmmLabel
m
str
CmmRet
toEntryLbl
platform
l
=
pprPanic
"toEntryLbl"
(
ppr
CLabel
platform
l
)
toInfoLbl
::
Platform
->
CLabel
->
CLabel
toInfoLbl
_
(
IdLabel
n
c
Entry
)
=
IdLabel
n
c
InfoTable
toInfoLbl
_
(
IdLabel
n
c
LocalEntry
)
=
IdLabel
n
c
LocalInfoTable
toInfoLbl
_
(
IdLabel
n
c
ConEntry
)
=
IdLabel
n
c
ConInfoTable
toInfoLbl
_
(
IdLabel
n
c
StaticConEntry
)
=
IdLabel
n
c
StaticInfoTable
toInfoLbl
_
(
IdLabel
n
c
_
)
=
IdLabel
n
c
InfoTable
toInfoLbl
_
(
CaseLabel
n
CaseReturnPt
)
=
CaseLabel
n
CaseReturnInfo
toInfoLbl
_
(
CmmLabel
m
str
CmmEntry
)
=
CmmLabel
m
str
CmmInfo
toInfoLbl
_
(
CmmLabel
m
str
CmmRet
)
=
CmmLabel
m
str
CmmRetInfo
toInfoLbl
platform
l
=
pprPanic
"CLabel.toInfoLbl"
(
ppr
CLabel
platform
l
)
toClosureLbl
::
CLabel
->
CLabel
toClosureLbl
(
IdLabel
n
c
_
)
=
IdLabel
n
c
Closure
toClosureLbl
l
=
pprPanic
"toClosureLbl"
(
ppr
l
)
toSlowEntryLbl
::
CLabel
->
CLabel
toSlowEntryLbl
(
IdLabel
n
c
_
)
=
IdLabel
n
c
Slow
toSlowEntryLbl
l
=
pprPanic
"toSlowEntryLbl"
(
ppr
l
)
toRednCountsLbl
::
CLabel
->
CLabel
toRednCountsLbl
(
IdLabel
n
c
_
)
=
IdLabel
n
c
RednCounts
toRednCountsLbl
l
=
pprPanic
"toRednCountsLbl"
(
ppr
l
)
toEntryLbl
::
CLabel
->
CLabel
toEntryLbl
(
IdLabel
n
c
LocalInfoTable
)
=
IdLabel
n
c
LocalEntry
toEntryLbl
(
IdLabel
n
c
ConInfoTable
)
=
IdLabel
n
c
ConEntry
toEntryLbl
(
IdLabel
n
c
StaticInfoTable
)
=
IdLabel
n
c
StaticConEntry
toEntryLbl
(
IdLabel
n
c
_
)
=
IdLabel
n
c
Entry
toEntryLbl
(
CaseLabel
n
CaseReturnInfo
)
=
CaseLabel
n
CaseReturnPt
toEntryLbl
(
CmmLabel
m
str
CmmInfo
)
=
CmmLabel
m
str
CmmEntry
toEntryLbl
(
CmmLabel
m
str
CmmRetInfo
)
=
CmmLabel
m
str
CmmRet
toEntryLbl
l
=
pprPanic
"toEntryLbl"
(
ppr
l
)
toInfoLbl
::
CLabel
->
CLabel
toInfoLbl
(
IdLabel
n
c
Entry
)
=
IdLabel
n
c
InfoTable
toInfoLbl
(
IdLabel
n
c
LocalEntry
)
=
IdLabel
n
c
LocalInfoTable
toInfoLbl
(
IdLabel
n
c
ConEntry
)
=
IdLabel
n
c
ConInfoTable
toInfoLbl
(
IdLabel
n
c
StaticConEntry
)
=
IdLabel
n
c
StaticInfoTable
toInfoLbl
(
IdLabel
n
c
_
)
=
IdLabel
n
c
InfoTable
toInfoLbl
(
CaseLabel
n
CaseReturnPt
)
=
CaseLabel
n
CaseReturnInfo
toInfoLbl
(
CmmLabel
m
str
CmmEntry
)
=
CmmLabel
m
str
CmmInfo
toInfoLbl
(
CmmLabel
m
str
CmmRet
)
=
CmmLabel
m
str
CmmRetInfo
toInfoLbl
l
=
pprPanic
"CLabel.toInfoLbl"
(
ppr
l
)
-- -----------------------------------------------------------------------------
-- Does a CLabel refer to a CAF?
...
...
@@ -1105,35 +1105,35 @@ pprDynamicLinkerAsmLabel platform dllInfo lbl
=
if
platformOS
platform
==
OSDarwin
then
if
platformArch
platform
==
ArchX86_64
then
case
dllInfo
of
CodeStub
->
char
'L'
<>
ppr
CLabel
platform
lbl
<>
text
"$stub"
SymbolPtr
->
char
'L'
<>
ppr
CLabel
platform
lbl
<>
text
"$non_lazy_ptr"
GotSymbolPtr
->
ppr
CLabel
platform
lbl
<>
text
"@GOTPCREL"
GotSymbolOffset
->
ppr
CLabel
platform
lbl
CodeStub
->
char
'L'
<>
ppr
lbl
<>
text
"$stub"
SymbolPtr
->
char
'L'
<>
ppr
lbl
<>
text
"$non_lazy_ptr"
GotSymbolPtr
->
ppr
lbl
<>
text
"@GOTPCREL"
GotSymbolOffset
->
ppr
lbl
else
case
dllInfo
of
CodeStub
->
char
'L'
<>
ppr
CLabel
platform
lbl
<>
text
"$stub"
SymbolPtr
->
char
'L'
<>
ppr
CLabel
platform
lbl
<>
text
"$non_lazy_ptr"
CodeStub
->
char
'L'
<>
ppr
lbl
<>
text
"$stub"
SymbolPtr
->
char
'L'
<>
ppr
lbl
<>
text
"$non_lazy_ptr"
_
->
panic
"pprDynamicLinkerAsmLabel"
else
if
osElfTarget
(
platformOS
platform
)
then
if
platformArch
platform
==
ArchPPC
then
case
dllInfo
of
CodeStub
->
ppr
CLabel
platform
lbl
<>
text
"@plt"
SymbolPtr
->
text
".LC_"
<>
ppr
CLabel
platform
lbl
CodeStub
->
ppr
lbl
<>
text
"@plt"
SymbolPtr
->
text
".LC_"
<>
ppr
lbl
_
->
panic
"pprDynamicLinkerAsmLabel"
else
if
platformArch
platform
==
ArchX86_64
then
case
dllInfo
of
CodeStub
->
ppr
CLabel
platform
lbl
<>
text
"@plt"
GotSymbolPtr
->
ppr
CLabel
platform
lbl
<>
text
"@gotpcrel"
GotSymbolOffset
->
ppr
CLabel
platform
lbl
SymbolPtr
->
text
".LC_"
<>
ppr
CLabel
platform
lbl
CodeStub
->
ppr
lbl
<>
text
"@plt"
GotSymbolPtr
->
ppr
lbl
<>
text
"@gotpcrel"
GotSymbolOffset
->
ppr
lbl
SymbolPtr
->
text
".LC_"
<>
ppr
lbl
else
case
dllInfo
of
CodeStub
->
ppr
CLabel
platform
lbl
<>
text
"@plt"
SymbolPtr
->
text
".LC_"
<>
ppr
CLabel
platform
lbl
GotSymbolPtr
->
ppr
CLabel
platform
lbl
<>
text
"@got"
GotSymbolOffset
->
ppr
CLabel
platform
lbl
<>
text
"@gotoff"
CodeStub
->
ppr
lbl
<>
text
"@plt"
SymbolPtr
->
text
".LC_"
<>
ppr
lbl
GotSymbolPtr
->
ppr
lbl
<>
text
"@got"
GotSymbolOffset
->
ppr
lbl
<>
text
"@gotoff"
else
if
platformOS
platform
==
OSMinGW32
then
case
dllInfo
of
SymbolPtr
->
text
"__imp_"
<>
ppr
CLabel
platform
lbl
SymbolPtr
->
text
"__imp_"
<>
ppr
lbl
_
->
panic
"pprDynamicLinkerAsmLabel"
else
panic
"pprDynamicLinkerAsmLabel"
compiler/cmm/CmmBuildInfoTables.hs
View file @
7937a921
...
...
@@ -51,7 +51,6 @@ import Control.Monad
import
Name
import
OptimizationFuel
import
Outputable
import
Platform
import
SMRep
import
UniqSupply
...
...
@@ -201,8 +200,8 @@ cafLattice = DataflowLattice "live cafs" Map.empty add
where
add
_
(
OldFact
old
)
(
NewFact
new
)
=
case
old
`
Map
.
union
`
new
of
new'
->
(
changeIf
$
Map
.
size
new'
>
Map
.
size
old
,
new'
)
cafTransfers
::
Platform
->
BwdTransfer
CmmNode
CAFSet
cafTransfers
platform
=
mkBTransfer3
first
middle
last
cafTransfers
::
BwdTransfer
CmmNode
CAFSet
cafTransfers
=
mkBTransfer3
first
middle
last
where
first
_
live
=
live
middle
m
live
=
foldExpDeep
addCaf
m
live
last
l
live
=
foldExpDeep
addCaf
l
(
joinOutFacts
cafLattice
l
live
)
...
...
@@ -211,12 +210,11 @@ cafTransfers platform = mkBTransfer3 first middle last
CmmLit
(
CmmLabelOff
c
_
)
->
add
c
set
CmmLit
(
CmmLabelDiffOff
c1
c2
_
)
->
add
c1
$
add
c2
set
_
->
set
add
l
s
=
if
hasCAF
l
then
Map
.
insert
(
toClosureLbl
platform
l
)
()
s
add
l
s
=
if
hasCAF
l
then
Map
.
insert
(
toClosureLbl
l
)
()
s
else
s
cafAnal
::
Platform
->
CmmGraph
->
FuelUniqSM
CAFEnv
cafAnal
platform
g
=
liftM
snd
$
dataflowPassBwd
g
[]
$
analBwd
cafLattice
(
cafTransfers
platform
)
cafAnal
::
CmmGraph
->
FuelUniqSM
CAFEnv
cafAnal
g
=
liftM
snd
$
dataflowPassBwd
g
[]
$
analBwd
cafLattice
cafTransfers
-----------------------------------------------------------------------
-- Building the SRTs
...
...
@@ -348,13 +346,13 @@ to_SRT top_srt off len bmp
-- keep its CAFs live.)
-- Any procedure referring to a non-static CAF c must keep live
-- any CAF that is reachable from c.
localCAFInfo
::
Platform
->
CAFEnv
->
CmmDecl
->
Maybe
(
CLabel
,
CAFSet
)
localCAFInfo
_
_
(
CmmData
_
_
)
=
Nothing
localCAFInfo
platform
cafEnv
(
CmmProc
top_info
top_l
(
CmmGraph
{
g_entry
=
entry
}))
=
localCAFInfo
::
CAFEnv
->
CmmDecl
->
Maybe
(
CLabel
,
CAFSet
)
localCAFInfo
_
(
CmmData
_
_
)
=
Nothing
localCAFInfo
cafEnv
(
CmmProc
top_info
top_l
(
CmmGraph
{
g_entry
=
entry
}))
=
case
info_tbl
top_info
of
CmmInfoTable
{
cit_rep
=
rep
}
|
not
(
isStaticRep
rep
)
->
Just
(
toClosureLbl
platform
top_l
,
->
Just
(
toClosureLbl
top_l
,
expectJust
"maybeBindCAFs"
$
mapLookup
entry
cafEnv
)
_
->
Nothing
...
...
compiler/cmm/CmmInfo.hs
View file @
7937a921
...
...
@@ -168,7 +168,7 @@ mkInfoTableContents platform
,
srt_lit
,
liveness_lit
,
slow_entry
]
;
return
(
Nothing
,
Nothing
,
extra_bits
,
liveness_data
)
}
where
slow_entry
=
CmmLabel
(
toSlowEntryLbl
platform
info_lbl
)
slow_entry
=
CmmLabel
(
toSlowEntryLbl
info_lbl
)
srt_lit
=
case
srt_label
of
[]
->
mkIntCLit
0
(
lit
:
_rest
)
->
ASSERT
(
null
_rest
)
lit
...
...
compiler/cmm/CmmPipeline.hs
View file @
7937a921
...
...
@@ -149,8 +149,8 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
mapM_
(
dump
Opt_D_dump_cmmz_split
"Post splitting"
)
gs
------------- More CAFs and foreign calls ------------
cafEnv
<-
run
$
cafAnal
platform
g
let
localCAFs
=
catMaybes
$
map
(
localCAFInfo
platform
cafEnv
)
gs
cafEnv
<-
run
$
cafAnal
g
let
localCAFs
=
catMaybes
$
map
(
localCAFInfo
cafEnv
)
gs
mbpprTrace
"localCAFs"
(
ppr
localCAFs
)
$
return
()
gs
<-
run
$
mapM
(
lowerSafeForeignCalls
areaMap
)
gs
...
...
compiler/codeGen/StgCmmBind.hs
View file @
7937a921
...
...
@@ -411,9 +411,7 @@ closureCodeBody top_lvl bndr cl_info _cc args arity body fv_details
do
{
-- Allocate the global ticky counter,
-- and establish the ticky-counter
-- label for this block
;
dflags
<-
getDynFlags
;
let
platform
=
targetPlatform
dflags
ticky_ctr_lbl
=
closureRednCountsLabel
platform
cl_info
let
ticky_ctr_lbl
=
closureRednCountsLabel
cl_info
;
emitTickyCounter
cl_info
(
map
stripNV
args
)
;
setTickyCtrLabel
ticky_ctr_lbl
$
do
...
...
@@ -470,10 +468,8 @@ mkSlowEntryCode :: ClosureInfo -> [LocalReg] -> FCode ()
mkSlowEntryCode
_
[]
=
panic
"entering a closure with no arguments?"
mkSlowEntryCode
cl_info
arg_regs
-- function closure is already in `Node'
|
Just
(
_
,
ArgGen
_
)
<-
closureFunInfo
cl_info
=
do
dflags
<-
getDynFlags
let
platform
=
targetPlatform
dflags
slow_lbl
=
closureSlowEntryLabel
platform
cl_info
fast_lbl
=
closureLocalEntryLabel
platform
cl_info
=
do
let
slow_lbl
=
closureSlowEntryLabel
cl_info
fast_lbl
=
closureLocalEntryLabel
cl_info
-- mkDirectJump does not clobber `Node' containing function closure
jump
=
mkDirectJump
(
mkLblExpr
fast_lbl
)
(
map
(
CmmReg
.
CmmLocal
)
arg_regs
)
...
...
compiler/codeGen/StgCmmClosure.hs
View file @
7937a921
...
...
@@ -87,7 +87,6 @@ import TcType
import
TyCon
import
BasicTypes
import
Outputable
import
Platform
import
Constants
import
DynFlags
import
Util
...
...
@@ -773,19 +772,19 @@ isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
-- Label generation
--------------------------------------
staticClosureLabel
::
Platform
->
ClosureInfo
->
CLabel
staticClosureLabel
platform
=
toClosureLbl
platform
.
closureInfoLabel
staticClosureLabel
::
ClosureInfo
->
CLabel
staticClosureLabel
=
toClosureLbl
.
closureInfoLabel
closureRednCountsLabel
::
Platform
->
ClosureInfo
->
CLabel
closureRednCountsLabel
platform
=
toRednCountsLbl
platform
.
closureInfoLabel
closureRednCountsLabel
::
ClosureInfo
->
CLabel
closureRednCountsLabel
=
toRednCountsLbl
.
closureInfoLabel
closureSlowEntryLabel
::
Platform
->
ClosureInfo
->
CLabel
closureSlowEntryLabel
platform
=
toSlowEntryLbl
platform
.
closureInfoLabel
closureSlowEntryLabel
::
ClosureInfo
->
CLabel
closureSlowEntryLabel
=
toSlowEntryLbl
.
closureInfoLabel
closureLocalEntryLabel
::
Platform
->
ClosureInfo
->
CLabel
closureLocalEntryLabel
platform
|
tablesNextToCode
=
toInfoLbl
platform
.
closureInfoLabel
|
otherwise
=
toEntryLbl
platform
.
closureInfoLabel
closureLocalEntryLabel
::
ClosureInfo
->
CLabel
closureLocalEntryLabel
|
tablesNextToCode
=
toInfoLbl
.
closureInfoLabel
|
otherwise
=
toEntryLbl
.
closureInfoLabel
mkClosureInfoTableLabel
::
Id
->
LambdaFormInfo
->
CLabel
mkClosureInfoTableLabel
id
lf_info
...
...
compiler/codeGen/StgCmmHeap.hs
View file @
7937a921
...
...
@@ -43,7 +43,6 @@ import IdInfo( CafInfo(..), mayHaveCafRefs )
import
Module
import
FastString
(
mkFastString
,
fsLit
)
import
Constants
import
DynFlags
import
Util
-----------------------------------------------------------
...
...
@@ -329,11 +328,7 @@ entryHeapCheck :: ClosureInfo
->
FCode
()
entryHeapCheck
cl_info
offset
nodeSet
arity
args
code
=
do
dflags
<-
getDynFlags
let
platform
=
targetPlatform
dflags
is_thunk
=
arity
==
0
=
do
let
is_thunk
=
arity
==
0
is_fastf
=
case
closureFunInfo
cl_info
of
Just
(
_
,
ArgGen
_
)
->
False
_otherwise
->
True
...
...
@@ -342,7 +337,7 @@ entryHeapCheck cl_info offset nodeSet arity args code
setN
=
case
nodeSet
of
Just
n
->
mkAssign
nodeReg
(
CmmReg
$
CmmLocal
n
)
Nothing
->
mkAssign
nodeReg
$
CmmLit
(
CmmLabel
$
staticClosureLabel
platform
cl_info
)
CmmLit
(
CmmLabel
$
staticClosureLabel
cl_info
)
{- Thunks: Set R1 = node, jump GCEnter1
Function (fast): Set R1 = node, jump GCFun
...
...
compiler/codeGen/StgCmmLayout.hs
View file @
7937a921
...
...
@@ -51,7 +51,6 @@ import Id
import
Name
import
TyCon
(
PrimRep
(
..
)
)
import
BasicTypes
(
RepArity
)
import
DynFlags
import
StaticFlags
import
Constants
...
...
@@ -405,9 +404,8 @@ emitClosureProcAndInfoTable top_lvl bndr lf_info info_tbl args body
emitClosureAndInfoTable
::
CmmInfoTable
->
Convention
->
[
LocalReg
]
->
FCode
()
->
FCode
()
emitClosureAndInfoTable
info_tbl
conv
args
body
=
do
{
dflags
<-
getDynFlags
;
blks
<-
getCode
body
;
let
entry_lbl
=
toEntryLbl
(
targetPlatform
dflags
)
(
cit_lbl
info_tbl
)
=
do
{
blks
<-
getCode
body
;
let
entry_lbl
=
toEntryLbl
(
cit_lbl
info_tbl
)
;
emitProcWithConvention
conv
info_tbl
entry_lbl
args
blks
}
...
...
compiler/codeGen/StgCmmTicky.hs
View file @
7937a921
...
...
@@ -97,8 +97,7 @@ emitTickyCounter cl_info args
=
ifTicky
$
do
{
dflags
<-
getDynFlags
;
mod_name
<-
getModuleName
;
let
platform
=
targetPlatform
dflags
ticky_ctr_label
=
closureRednCountsLabel
platform
cl_info
;
let
ticky_ctr_label
=
closureRednCountsLabel
cl_info
arg_descr
=
map
(
showTypeCategory
.
idType
)
args
fun_descr
mod_name
=
ppr_for_ticky_name
dflags
mod_name
(
closureName
cl_info
)
;
fun_descr_lit
<-
newStringCLit
(
fun_descr
mod_name
)
...
...
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