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
770f05e6
Commit
770f05e6
authored
Jul 07, 2010
by
dterei
Browse files
LLVM: Fix various typos in comments
parent
8538e4ba
Changes
6
Hide whitespace changes
Inline
Side-by-side
compiler/llvmGen/Llvm/AbsSyn.hs
View file @
770f05e6
...
...
@@ -23,12 +23,12 @@ data LlvmBlock = LlvmBlock {
type
LlvmBlocks
=
[
LlvmBlock
]
-- | An LLVM Module. This is a top level cont
i
aner in LLVM.
-- | An LLVM Module. This is a top level conta
i
ner in LLVM.
data
LlvmModule
=
LlvmModule
{
-- | Comments to include at the start of the module.
modComments
::
[
LMString
],
-- | LLVM Alias type def
e
nitions.
-- | LLVM Alias type def
i
nitions.
modAliases
::
[
LlvmAlias
],
-- | Global variables to include in the module.
...
...
@@ -128,7 +128,7 @@ data LlvmStatement
{- |
Raise an expression to a statement (if don't want result or want to use
Llvm unamed values.
Llvm un
n
amed values.
-}
|
Expr
LlvmExpression
...
...
@@ -206,7 +206,7 @@ data LlvmExpression
Merge variables from different basic blocks which are predecessors of this
basic block in a new variable of type tp.
* tp: type of the merged variable, must match the types of the
precessor
s
variables.
pre
de
cessor variables.
* precessors: A list of variables and the basic block that they originate
from.
-}
...
...
compiler/llvmGen/Llvm/Types.hs
View file @
770f05e6
...
...
@@ -70,7 +70,7 @@ instance Show LlvmType where
show
(
LMAlias
(
s
,
_
))
=
"%"
++
unpackFS
s
-- | An LLVM section def
e
nition. If Nothing then let LLVM decide the section
-- | An LLVM section def
i
nition. If Nothing then let LLVM decide the section
type
LMSection
=
Maybe
LMString
type
LMAlign
=
Maybe
Int
type
LMConst
=
Bool
-- ^ is a variable constant or not
...
...
compiler/llvmGen/LlvmCodeGen.hs
View file @
770f05e6
...
...
@@ -30,7 +30,7 @@ import Util
import
System.IO
-- -----------------------------------------------------------------------------
-- | Top-level of the
llvm c
odegen
-- | Top-level of the
LLVM C
ode
gen
erator
--
llvmCodeGen
::
DynFlags
->
Handle
->
UniqSupply
->
[
RawCmm
]
->
IO
()
llvmCodeGen
dflags
h
us
cmms
...
...
@@ -60,7 +60,7 @@ llvmCodeGen dflags h us cmms
-- -----------------------------------------------------------------------------
-- | Do
llvm
code generation on all these
c
mms data sections.
-- | Do
LLVM
code generation on all these
C
mms data sections.
--
cmmDataLlvmGens
::
DynFlags
->
BufHandle
->
LlvmEnv
->
[(
Section
,[
CmmStatic
])]
->
[
LlvmUnresData
]
->
IO
(
LlvmEnv
)
...
...
@@ -80,7 +80,7 @@ cmmDataLlvmGens dflags h env (cmm:cmms) lmdata
-- -----------------------------------------------------------------------------
-- | Do
llvm
code generation on all these
c
mms procs.
-- | Do
LLVM
code generation on all these
C
mms procs.
--
cmmProcLlvmGens
::
DynFlags
->
BufHandle
->
UniqSupply
->
LlvmEnv
->
[
RawCmmTop
]
->
Int
-- ^ count, used for generating unique subsections
...
...
@@ -109,7 +109,7 @@ cmmProcLlvmGens dflags h us env (cmm : cmms) count 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.
-- | Complete
LLVM
code generation phase for a single top-level chunk of Cmm.
cmmLlvmGen
::
DynFlags
->
UniqSupply
->
LlvmEnv
->
RawCmmTop
->
IO
(
UniqSupply
,
LlvmEnv
,
[
LlvmCmmTop
]
)
cmmLlvmGen
dflags
us
env
cmm
...
...
compiler/llvmGen/LlvmCodeGen/Base.hs
View file @
770f05e6
...
...
@@ -42,7 +42,7 @@ type LlvmCmmTop = GenCmmTop LlvmData [CmmStatic] (ListGraph LlvmStatement)
type
LlvmBasicBlock
=
GenBasicBlock
LlvmStatement
-- | Unresolved code.
-- Of the form: (data label, data type, unreso
v
led data)
-- Of the form: (data label, data type, unresol
v
ed data)
type
LlvmUnresData
=
(
CLabel
,
Section
,
LlvmType
,
[
UnresStatic
])
-- | Top level LLVM Data (globals and type aliases)
...
...
compiler/llvmGen/LlvmCodeGen/CodeGen.hs
View file @
770f05e6
...
...
@@ -31,7 +31,7 @@ import Control.Monad ( liftM )
type
LlvmStatements
=
OrdList
LlvmStatement
-- -----------------------------------------------------------------------------
-- | Top-level of the
llvm
proc
c
odegen
-- | Top-level of the
LLVM
proc
C
ode
gen
erator
--
genLlvmProc
::
LlvmEnv
->
RawCmmTop
->
UniqSM
(
LlvmEnv
,
[
LlvmCmmTop
])
genLlvmProc
env
(
CmmData
_
_
)
...
...
@@ -84,7 +84,7 @@ basicBlockCodeGen env (BasicBlock id stmts)
-- | Allocations need to be extracted so they can be moved to the entry
-- of a function to make sure they dominate all posible paths in the CFG.
-- of a function to make sure they dominate all pos
s
ible paths in the CFG.
dominateAllocs
::
LlvmBasicBlock
->
(
LlvmBasicBlock
,
[
LlvmStatement
])
dominateAllocs
(
BasicBlock
id
stmts
)
=
(
BasicBlock
id
allstmts
,
allallocs
)
...
...
@@ -101,8 +101,8 @@ dominateAllocs (BasicBlock id stmts)
--
-- A statement conversion return data.
-- * LlvmEnv: The new envi
o
rnment
-- * LlvmStatements: The compiled
llvm
statements.
-- * LlvmEnv: The new envir
o
nment
-- * LlvmStatements: The compiled
LLVM
statements.
-- * LlvmCmmTop: Any global data needed.
type
StmtData
=
(
LlvmEnv
,
LlvmStatements
,
[
LlvmCmmTop
])
...
...
@@ -142,7 +142,7 @@ stmtToInstrs env stmt = case stmt of
-- CPS, only tail calls, no return's
-- Actually, there are a few return statements that occur because of hand
-- written
c
mm code.
-- written
C
mm code.
CmmReturn
_
->
return
(
env
,
unitOL
$
Return
Nothing
,
[]
)
...
...
@@ -151,7 +151,7 @@ stmtToInstrs env stmt = case stmt of
genCall
::
LlvmEnv
->
CmmCallTarget
->
HintedCmmFormals
->
HintedCmmActuals
->
CmmReturnInfo
->
UniqSM
StmtData
-- Write barrier needs to be handled specially as it is implemented as an
llvm
-- Write barrier needs to be handled specially as it is implemented as an
LLVM
-- intrinsic function.
genCall
env
(
CmmPrim
MO_WriteBarrier
)
_
_
_
=
do
let
fname
=
fsLit
"llvm.memory.barrier"
...
...
@@ -177,7 +177,7 @@ genCall env (CmmPrim MO_WriteBarrier) _ _ _ = do
-- Handle all other foreign calls and prim ops.
genCall
env
target
res
args
ret
=
do
-- param
a
ter types
-- param
e
ter types
let
arg_type
(
CmmHinted
_
AddrHint
)
=
i8Ptr
-- cast pointers to i8*. Llvm equivalent of void*
arg_type
(
CmmHinted
expr
_
)
=
cmmToLlvmType
$
cmmExprType
expr
...
...
@@ -189,12 +189,12 @@ genCall env target res args ret = do
ret_type
t
=
panic
$
"genCall: Too many return values! Can only handle"
++
" 0 or 1, given "
++
show
(
length
t
)
++
"."
-- extract
c
mm call convention
-- extract
C
mm call convention
let
cconv
=
case
target
of
CmmCallee
_
conv
->
conv
CmmPrim
_
->
PrimCallConv
-- translate to
llvm
call convention
-- translate to
LLVM
call convention
let
lmconv
=
case
cconv
of
#
if
i386_TARGET_ARCH
||
x86_64_TARGET_ARCH
StdCallConv
->
CC_X86_Stdcc
...
...
@@ -224,7 +224,7 @@ genCall env target res args ret = do
let
funTy
name
=
LMFunction
$
LlvmFunctionDecl
name
ExternallyVisible
lmconv
retTy
FixedArgs
argTy
llvmFunAlign
-- get paramter values
-- get param
e
ter values
(
env1
,
argVars
,
stmts1
,
top1
)
<-
arg_vars
env
args
(
[]
,
nilOL
,
[]
)
-- get the return register
...
...
@@ -291,7 +291,7 @@ genCall env target res args ret = do
So this means LLVM considers them live across the entire function, when
in reality they usually aren't. For Caller save registers across C calls
the saving and restoring of them is done by the Cmm code generator,
using
c
mm local vars. So to stop LLVM saving them as well (and saving
using
C
mm local vars. So to stop LLVM saving them as well (and saving
all of them since it thinks they're always live, we trash them just
before the call by assigning the 'undef' value to them. The ones we
need are restored from the Cmm local var and the ones we don't need
...
...
@@ -583,7 +583,7 @@ genCondBranch env cond idT = do
-- | Switch branch
--
-- N.B.
w
e remove Nothing's from the list of branches, as they are 'undefined'.
-- N.B.
W
e remove Nothing's from the list of branches, as they are 'undefined'.
-- However, they may be defined one day, so we better document this behaviour.
genSwitch
::
LlvmEnv
->
CmmExpr
->
[
Maybe
BlockId
]
->
UniqSM
StmtData
genSwitch
env
cond
maybe_ids
=
do
...
...
@@ -714,20 +714,20 @@ genMachOp env _ op [x] = case op of
return
(
env'
,
v1
,
stmts
`
snocOL
`
s1
,
top
)
let
toWidth
=
llvmWidthInBits
ty
-- LLVM doesn't like trying to convert to same width, so
-- need to check for that as we do get
c
mm code doing it.
-- need to check for that as we do get
C
mm code doing it.
case
widthInBits
from
of
w
|
w
<
toWidth
->
sameConv'
expand
w
|
w
>
toWidth
->
sameConv'
reduce
_w
->
return
x'
--
h
andle
g
lobal
r
egs pointers
--
H
andle
G
lobal
R
egs pointers
genMachOp
env
opt
o
@
(
MO_Add
_
)
e
@
[(
CmmReg
(
CmmGlobal
r
)),
(
CmmLit
(
CmmInt
n
_
))]
=
genMachOp_fast
env
opt
o
r
(
fromInteger
n
)
e
genMachOp
env
opt
o
@
(
MO_Sub
_
)
e
@
[(
CmmReg
(
CmmGlobal
r
)),
(
CmmLit
(
CmmInt
n
_
))]
=
genMachOp_fast
env
opt
o
r
(
negate
.
fromInteger
$
n
)
e
--
g
eneric case
--
G
eneric case
genMachOp
env
opt
op
e
=
genMachOp_slow
env
opt
op
e
...
...
@@ -836,7 +836,7 @@ genMachOp_slow env opt op [x, y] = case op of
-- ++ "\ne2: " ++ (show.llvmSDoc.PprCmm.pprExpr $ y)
-- | Need to use EOption here as Cmm expects word size results from
-- comparisons while
llvm
return i1. Need to extend to llvmWord type
-- comparisons while
LLVM
return i1. Need to extend to llvmWord type
-- if expected
genBinComp
opt
cmp
=
do
ed
@
(
env'
,
v1
,
stmts
,
top
)
<-
binLlvmOp
(
\
_
->
i1
)
$
Compare
cmp
...
...
@@ -990,7 +990,7 @@ genLoad_slow env e ty = do
--
-- We allocate CmmReg on the stack. This avoids having to map a CmmReg to an
-- equivalent SSA form and avoids having to deal with Phi node insertion.
-- This is also the approach recommended by
llvm
developers.
-- This is also the approach recommended by
LLVM
developers.
getCmmReg
::
LlvmEnv
->
CmmReg
->
ExprData
getCmmReg
env
r
@
(
CmmLocal
(
LocalReg
un
_
))
=
let
exists
=
varLookup
un
env
...
...
@@ -1030,7 +1030,7 @@ genLit env cmm@(CmmLabel l)
ty
=
funLookup
label
env
lmty
=
cmmToLlvmType
$
cmmLitType
cmm
in
case
ty
of
-- Make generic external label def
e
nition and then pointer to it
-- Make generic external label def
i
nition and then pointer to it
Nothing
->
do
let
glob
@
(
var
,
_
)
=
genStringLabelRef
label
let
ldata
=
[
CmmData
Data
[([
glob
],
[]
)]]
...
...
compiler/llvmGen/LlvmCodeGen/Data.hs
View file @
770f05e6
...
...
@@ -106,7 +106,7 @@ resDatas env (cmm : rest) (stats, globs)
--
-- We check the 'LlvmEnv' to see if the reference has been defined in this
-- module. If it has we can retrieve its type and make a pointer, otherwise
-- we introduce a generic external def
e
nition for the referenced label and
-- we introduce a generic external def
i
nition for the referenced label and
-- then make a pointer.
resData
::
LlvmEnv
->
UnresStatic
->
(
LlvmEnv
,
LlvmStatic
,
[
Maybe
LMGlobal
])
...
...
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