Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
09e6aba8
Commit
09e6aba8
authored
Jun 21, 2010
by
dterei
Browse files
Reduce the number of passes over the cmm in llvm BE
parent
4bb4a1cf
Changes
4
Hide whitespace changes
Inline
Side-by-side
compiler/llvmGen/LlvmCodeGen.hs
View file @
09e6aba8
...
...
@@ -35,80 +35,54 @@ import System.IO
llvmCodeGen
::
DynFlags
->
Handle
->
UniqSupply
->
[
RawCmm
]
->
IO
()
llvmCodeGen
dflags
h
us
cmms
=
do
let
cmm
=
concat
$
map
(
\
(
Cmm
top
)
->
top
)
cmms
bufh
<-
newBufHandle
h
Prt
.
bufLeftRender
bufh
$
pprLlvmHeader
env
<-
cmmDataLlvmGens
dflags
bufh
cmm
cmmProcLlvmGens
dflags
bufh
us
env
cmm
1
[]
env
'
<-
cmmDataLlvmGens
dflags
bufh
env
cdata
[]
cmmProcLlvmGens
dflags
bufh
us
env
'
cmm
1
[]
bFlush
bufh
return
()
where
cmm
=
concat
$
map
(
\
(
Cmm
top
)
->
top
)
cmms
(
cdata
,
env
)
=
foldr
split
(
[]
,
initLlvmEnv
)
cmm
split
(
CmmData
_
d'
)
(
d
,
e
)
=
(
d'
:
d
,
e
)
split
(
CmmProc
i
l
_
_
)
(
d
,
e
)
=
let
lbl
=
strCLabel_llvm
$
if
not
(
null
i
)
then
entryLblToInfoLbl
l
else
l
env'
=
funInsert
lbl
llvmFunTy
e
in
(
d
,
env'
)
-- -----------------------------------------------------------------------------
-- | Do llvm code generation on all these cmms data sections.
--
cmmDataLlvmGens
::
DynFlags
->
BufHandle
->
[
RawCmmTop
]
->
IO
(
LlvmEnv
)
cmmDataLlvmGens
_
_
[]
=
return
(
initLlvmEnv
)
cmmDataLlvmGens
dflags
h
cmm
=
let
exData
(
CmmData
s
d
)
=
[(
s
,
d
)]
exData
_
=
[]
exProclbl
(
CmmProc
i
l
_
_
)
|
not
(
null
i
)
=
[
strCLabel_llvm
$
entryLblToInfoLbl
l
]
exProclbl
(
CmmProc
_
l
_
_
)
|
otherwise
=
[
strCLabel_llvm
l
]
exProclbl
_
=
[]
cproc
=
concat
$
map
exProclbl
cmm
cdata
=
concat
$
map
exData
cmm
env
=
foldl
(
\
e
l
->
funInsert
l
llvmFunTy
e
)
initLlvmEnv
cproc
in
cmmDataLlvmGens'
dflags
h
env
cdata
[]
cmmDataLlvmGens'
::
DynFlags
->
BufHandle
->
LlvmEnv
->
[(
Section
,
[
CmmStatic
])]
->
[
LlvmUnresData
]
->
IO
(
LlvmEnv
)
cmmDataLlvmGens'
dflags
h
env
[]
lmdata
=
do
let
(
env'
,
lmdata'
)
=
resolveLlvmDatas
dflags
env
lmdata
[]
let
lmdoc
=
Prt
.
vcat
$
map
(
pprLlvmData
dflags
)
lmdata'
cmmDataLlvmGens
::
DynFlags
->
BufHandle
->
LlvmEnv
->
[[
CmmStatic
]]
->
[
LlvmUnresData
]
->
IO
(
LlvmEnv
)
cmmDataLlvmGens
dflags
h
env
[]
lmdata
=
let
(
env'
,
lmdata'
)
=
resolveLlvmDatas
env
lmdata
[]
lmdoc
=
Prt
.
vcat
$
map
pprLlvmData
lmdata'
in
do
dumpIfSet_dyn
dflags
Opt_D_dump_llvm
"LLVM Code"
$
docToSDoc
lmdoc
Prt
.
bufLeftRender
h
lmdoc
return
env'
cmmDataLlvmGens'
dflags
h
env
(
cmm
:
cmms
)
lmdata
=
do
let
lmdata'
@
(
l
,
ty
,
_
)
=
genLlvmData
dflags
cmm
let
env'
=
funInsert
(
strCLabel_llvm
l
)
ty
env
cmmDataLlvmGens'
dflags
h
env'
cmms
(
lmdata
++
[
lmdata'
])
cmmDataLlvmGens
dflags
h
env
(
cmm
:
cmms
)
lmdata
=
let
lmdata'
@
(
l
,
ty
,
_
)
=
genLlvmData
cmm
env'
=
funInsert
(
strCLabel_llvm
l
)
ty
env
in
cmmDataLlvmGens
dflags
h
env'
cmms
(
lmdata
++
[
lmdata'
])
-- -----------------------------------------------------------------------------
-- | Do llvm code generation on all these cmms procs.
--
cmmProcLlvmGens
::
DynFlags
->
BufHandle
->
UniqSupply
->
LlvmEnv
->
[
RawCmmTop
]
cmmProcLlvmGens
::
DynFlags
->
BufHandle
->
UniqSupply
->
LlvmEnv
->
[
RawCmmTop
]
->
Int
-- ^ count, used for generating unique subsections
->
[
LlvmVar
]
-- ^ info tables that need to be marked as 'used'
->
IO
()
...
...
@@ -116,34 +90,28 @@ cmmProcLlvmGens
cmmProcLlvmGens
_
_
_
_
[]
_
[]
=
return
()
cmmProcLlvmGens
dflags
h
_
_
[]
_
ivars
=
do
let
cast
x
=
LM
Bitc
(
LMStaticPointer
(
pVarLift
x
)
)
i8Ptr
let
t
y
=
(
LMArray
(
length
ivars
)
i8Ptr
)
let
usedArray
=
LM
StaticArray
(
map
cast
ivars
)
ty
let
lmUsed
=
(
LMGlobalVar
(
fsLit
"llvm.used"
)
ty
Appending
(
Just
$
fsLit
"llvm.metadata"
)
Nothing
,
Just
usedArray
)
Prt
.
bufLeftRender
h
$
pprLlvmData
dflags
([
lmUsed
],
[]
)
cmmProcLlvmGens
_
h
_
_
[]
_
ivars
=
let
cast
x
=
LMBitc
(
LMStaticPointer
(
pVarLift
x
))
i8Ptr
ty
=
(
LM
Array
(
length
ivars
)
i8Ptr
)
usedArra
y
=
LM
Static
Array
(
map
cast
ivars
)
ty
lmUsed
=
(
LM
GlobalVar
(
fsLit
"llvm.used"
)
ty
Appending
(
Just
$
fsLit
"llvm.metadata"
)
Nothing
,
Just
usedArray
)
in
do
Prt
.
bufLeftRender
h
$
pprLlvmData
([
lmUsed
],
[]
)
cmmProcLlvmGens
dflags
h
us
env
(
cmm
:
cmms
)
count
ivars
=
do
(
us'
,
env'
,
llvm
)
<-
cmmLlvmGen
dflags
us
(
clearVars
env
)
cmm
(
us'
,
env'
,
llvm
)
<-
cmmLlvmGen
dflags
us
(
clearVars
env
)
cmm
let
(
docs
,
ivar
)
=
mapAndUnzip
(
pprLlvmCmmTop
dflags
env'
count
)
llvm
Prt
.
bufLeftRender
h
$
Prt
.
vcat
docs
let
(
docs
,
ivar
)
=
mapAndUnzip
(
pprLlvmCmmTop
env'
count
)
llvm
Prt
.
bufLeftRender
h
$
Prt
.
vcat
docs
cmmProcLlvmGens
dflags
h
us'
env'
cmms
(
count
+
2
)
(
concat
ivar
++
ivars
)
cmmProcLlvmGens
dflags
h
us'
env'
cmms
(
count
+
2
)
(
concat
ivar
++
ivars
)
-- | Complete llvm code generation phase for a single top-level chunk of Cmm.
cmmLlvmGen
::
DynFlags
->
UniqSupply
->
LlvmEnv
->
RawCmmTop
-- ^ the cmm to generate code for
->
IO
(
UniqSupply
,
LlvmEnv
,
[
LlvmCmmTop
]
)
-- llvm code
cmmLlvmGen
::
DynFlags
->
UniqSupply
->
LlvmEnv
->
RawCmmTop
->
IO
(
UniqSupply
,
LlvmEnv
,
[
LlvmCmmTop
]
)
cmmLlvmGen
dflags
us
env
cmm
=
do
...
...
@@ -154,10 +122,10 @@ cmmLlvmGen dflags us env cmm
(
pprCmm
$
Cmm
[
fixed_cmm
])
-- generate llvm code from cmm
let
((
env'
,
llvmBC
),
usGen
)
=
initUs
us
$
genLlvmCode
dflags
env
fixed_cmm
let
((
env'
,
llvmBC
),
usGen
)
=
initUs
us
$
genLlvmCode
env
fixed_cmm
dumpIfSet_dyn
dflags
Opt_D_dump_llvm
"LLVM Code"
(
vcat
$
map
(
docToSDoc
.
fst
.
pprLlvmCmmTop
dflags
env'
0
)
llvmBC
)
(
vcat
$
map
(
docToSDoc
.
fst
.
pprLlvmCmmTop
env'
0
)
llvmBC
)
return
(
usGen
,
env'
,
llvmBC
)
...
...
@@ -165,18 +133,9 @@ cmmLlvmGen dflags us env cmm
-- -----------------------------------------------------------------------------
-- | Instruction selection
--
genLlvmCode
::
DynFlags
->
LlvmEnv
->
RawCmmTop
->
UniqSM
(
LlvmEnv
,
[
LlvmCmmTop
])
genLlvmCode
_
env
(
CmmData
_
_
)
=
return
(
env
,
[]
)
genLlvmCode
_
env
(
CmmProc
_
_
_
(
ListGraph
[]
))
=
return
(
env
,
[]
)
genLlvmCode
_
env
cp
@
(
CmmProc
_
_
_
_
)
=
genLlvmProc
env
cp
genLlvmCode
::
LlvmEnv
->
RawCmmTop
->
UniqSM
(
LlvmEnv
,
[
LlvmCmmTop
])
genLlvmCode
env
(
CmmData
_
_
)
=
return
(
env
,
[]
)
genLlvmCode
env
(
CmmProc
_
_
_
(
ListGraph
[]
))
=
return
(
env
,
[]
)
genLlvmCode
env
cp
@
(
CmmProc
_
_
_
_
)
=
genLlvmProc
env
cp
compiler/llvmGen/LlvmCodeGen/CodeGen.hs
View file @
09e6aba8
...
...
@@ -275,7 +275,7 @@ genCall env target res args ret = do
CmmPrim
mop
->
do
let
name
=
cmmPrimOpFunctions
mop
let
lbl
=
mkForeignLabel
name
Nothing
ForeignLabelInExternalPackage
IsFunction
ForeignLabelInExternalPackage
IsFunction
getFunPtr
$
CmmCallee
(
CmmLit
(
CmmLabel
lbl
))
CCallConv
(
env2
,
fptr
,
stmts2
,
top2
)
<-
getFunPtr
target
...
...
@@ -335,7 +335,8 @@ arg_vars env (CmmHinted e AddrHint:rest) (vars, stmts, tops)
++
show
a
++
")"
(
v2
,
s1
)
<-
doExpr
i8Ptr
$
Cast
op
v1
i8Ptr
arg_vars
env'
rest
(
vars
++
[
v2
],
stmts
`
appOL
`
stmts'
`
snocOL
`
s1
,
tops
++
top'
)
arg_vars
env'
rest
(
vars
++
[
v2
],
stmts
`
appOL
`
stmts'
`
snocOL
`
s1
,
tops
++
top'
)
arg_vars
env
(
CmmHinted
e
_
:
rest
)
(
vars
,
stmts
,
tops
)
=
do
(
env'
,
v1
,
stmts'
,
top'
)
<-
exprToVar
env
e
...
...
compiler/llvmGen/LlvmCodeGen/Data.hs
View file @
09e6aba8
...
...
@@ -15,7 +15,6 @@ import BlockId
import
CLabel
import
Cmm
import
DynFlags
import
FastString
import
qualified
Outputable
...
...
@@ -38,8 +37,8 @@ structStr = fsLit "_struct"
-- complete this completely though as we need to pass all CmmStatic
-- sections before all references can be resolved. This last step is
-- done by 'resolveLlvmData'.
genLlvmData
::
DynFlags
->
(
Section
,
[
CmmStatic
]
)
->
LlvmUnresData
genLlvmData
_
(
_
,
(
CmmDataLabel
lbl
)
:
xs
)
=
genLlvmData
::
[
CmmStatic
]
->
LlvmUnresData
genLlvmData
(
CmmDataLabel
lbl
:
xs
)
=
let
static
=
map
genData
xs
label
=
strCLabel_llvm
lbl
...
...
@@ -51,20 +50,20 @@ genLlvmData _ ( _ , (CmmDataLabel lbl):xs) =
alias
=
LMAlias
(
label
`
appendFS
`
structStr
)
strucTy
in
(
lbl
,
alias
,
static
)
genLlvmData
_
_
=
panic
"genLlvmData: CmmData section doesn't start with label!"
genLlvmData
_
=
panic
"genLlvmData: CmmData section doesn't start with label!"
resolveLlvmDatas
::
DynFlags
->
LlvmEnv
->
[
LlvmUnresData
]
->
[
LlvmData
]
resolveLlvmDatas
::
LlvmEnv
->
[
LlvmUnresData
]
->
[
LlvmData
]
->
(
LlvmEnv
,
[
LlvmData
])
resolveLlvmDatas
_
env
[]
ldata
resolveLlvmDatas
env
[]
ldata
=
(
env
,
ldata
)
resolveLlvmDatas
dflags
env
(
udata
:
rest
)
ldata
=
let
(
env'
,
ndata
)
=
resolveLlvmData
dflags
env
udata
in
resolveLlvmDatas
dflags
env'
rest
(
ldata
++
[
ndata
])
resolveLlvmDatas
env
(
udata
:
rest
)
ldata
=
let
(
env'
,
ndata
)
=
resolveLlvmData
env
udata
in
resolveLlvmDatas
env'
rest
(
ldata
++
[
ndata
])
-- | Fix up CLabel references now that we should have passed all CmmData.
resolveLlvmData
::
DynFlags
->
LlvmEnv
->
LlvmUnresData
->
(
LlvmEnv
,
LlvmData
)
resolveLlvmData
_
env
(
lbl
,
alias
,
unres
)
=
resolveLlvmData
::
LlvmEnv
->
LlvmUnresData
->
(
LlvmEnv
,
LlvmData
)
resolveLlvmData
env
(
lbl
,
alias
,
unres
)
=
let
(
env'
,
static
,
refs
)
=
resDatas
env
unres
(
[]
,
[]
)
refs'
=
catMaybes
refs
struct
=
Just
$
LMStaticStruc
static
alias
...
...
compiler/llvmGen/LlvmCodeGen/Ppr.hs
View file @
09e6aba8
...
...
@@ -15,7 +15,6 @@ import LlvmCodeGen.Data
import
CLabel
import
Cmm
import
DynFlags
import
FastString
import
Pretty
import
Unique
...
...
@@ -61,14 +60,14 @@ pprLlvmHeader = moduleLayout
-- | Pretty print LLVM code
pprLlvmCmmTop
::
DynFlags
->
LlvmEnv
->
Int
->
LlvmCmmTop
->
(
Doc
,
[
LlvmVar
])
pprLlvmCmmTop
dflags
_
_
(
CmmData
_
lmdata
)
=
(
vcat
$
map
(
pprLlvmData
dflags
)
lmdata
,
[]
)
pprLlvmCmmTop
::
LlvmEnv
->
Int
->
LlvmCmmTop
->
(
Doc
,
[
LlvmVar
])
pprLlvmCmmTop
_
_
(
CmmData
_
lmdata
)
=
(
vcat
$
map
pprLlvmData
lmdata
,
[]
)
pprLlvmCmmTop
dflags
env
count
(
CmmProc
info
lbl
_
(
ListGraph
blks
))
pprLlvmCmmTop
env
count
(
CmmProc
info
lbl
_
(
ListGraph
blks
))
=
let
static
=
CmmDataLabel
lbl
:
info
(
idoc
,
ivar
)
=
if
not
(
null
info
)
then
pprCmmStatic
dflags
env
count
static
then
pprCmmStatic
env
count
static
else
(
empty
,
[]
)
in
(
idoc
$+$
(
let
sec
=
mkLayoutSection
(
count
+
1
)
...
...
@@ -87,18 +86,18 @@ pprLlvmCmmTop dflags env count (CmmProc info lbl _ (ListGraph blks))
-- | Pretty print LLVM data code
pprLlvmData
::
DynFlags
->
LlvmData
->
Doc
pprLlvmData
_
(
globals
,
types
)
=
pprLlvmData
::
LlvmData
->
Doc
pprLlvmData
(
globals
,
types
)
=
let
globals'
=
ppLlvmGlobals
globals
types'
=
ppLlvmTypes
types
in
types'
$+$
globals'
-- | Pretty print CmmStatic
pprCmmStatic
::
DynFlags
->
LlvmEnv
->
Int
->
[
CmmStatic
]
->
(
Doc
,
[
LlvmVar
])
pprCmmStatic
dflags
env
count
stat
=
let
unres
=
genLlvmData
dflags
(
Data
,
stat
)
(
_
,
(
ldata
,
ltypes
))
=
resolveLlvmData
dflags
env
unres
pprCmmStatic
::
LlvmEnv
->
Int
->
[
CmmStatic
]
->
(
Doc
,
[
LlvmVar
])
pprCmmStatic
env
count
stat
=
let
unres
=
genLlvmData
stat
(
_
,
(
ldata
,
ltypes
))
=
resolveLlvmData
env
unres
setSection
(
gv
@
(
LMGlobalVar
s
ty
l
_
_
),
d
)
=
let
v
=
if
l
==
Internal
then
[
gv
]
else
[]
...
...
@@ -107,7 +106,7 @@ pprCmmStatic dflags env count stat
setSection
v
=
(
v
,
[]
)
(
ldata'
,
llvmUsed
)
=
mapAndUnzip
setSection
ldata
in
(
pprLlvmData
dflags
(
ldata'
,
ltypes
),
concat
llvmUsed
)
in
(
pprLlvmData
(
ldata'
,
ltypes
),
concat
llvmUsed
)
-- | Create an appropriate section declaration for subsection <n> of text
...
...
Write
Preview
Markdown
is supported
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