Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
2d498de3
Commit
2d498de3
authored
May 26, 2009
by
Ben.Lippmeier@anu.edu.au
Browse files
Follow vreg/hreg patch in PPC NCG
parent
9d9eef1f
Changes
9
Hide whitespace changes
Inline
Side-by-side
compiler/nativeGen/PPC/CodeGen.hs
View file @
2d498de3
...
...
@@ -35,6 +35,7 @@ import PIC
import
Size
import
RegClass
import
Reg
import
TargetReg
import
Platform
-- Our intermediate code:
...
...
@@ -176,11 +177,11 @@ swizzleRegisterRep (Any _ codefn) size = Any size codefn
getRegisterReg
::
CmmReg
->
Reg
getRegisterReg
(
CmmLocal
(
LocalReg
u
pk
))
=
mkV
Reg
u
(
cmmTypeSize
pk
)
=
RegVirtual
$
mkVirtual
Reg
u
(
cmmTypeSize
pk
)
getRegisterReg
(
CmmGlobal
mid
)
=
case
get_GlobalReg_reg_or_addr
mid
of
Left
reg
@
(
RegReal
_
)
->
reg
Left
reg
->
reg
_other
->
pprPanic
"getRegisterReg-memory"
(
ppr
$
CmmGlobal
mid
)
-- By this stage, the only MagicIds remaining should be the
-- ones which map to a real machine register on this
...
...
@@ -305,7 +306,7 @@ assignReg_I64Code :: CmmReg -> CmmExpr -> NatM InstrBlock
assignReg_I64Code
(
CmmLocal
(
LocalReg
u_dst
pk
))
valueTree
=
do
ChildCode64
vcode
r_src_lo
<-
iselExpr64
valueTree
let
r_dst_lo
=
mkV
Reg
u_dst
II32
r_dst_lo
=
RegVirtual
$
mkVirtual
Reg
u_dst
II32
r_dst_hi
=
getHiVRegFromLo
r_dst_lo
r_src_hi
=
getHiVRegFromLo
r_src_lo
mov_lo
=
MR
r_dst_lo
r_src_lo
...
...
@@ -329,7 +330,7 @@ iselExpr64 (CmmLoad addrTree ty) | isWord64 ty = do
rlo
iselExpr64
(
CmmReg
(
CmmLocal
(
LocalReg
vu
ty
)))
|
isWord64
ty
=
return
(
ChildCode64
nilOL
(
mkV
Reg
vu
II32
))
=
return
(
ChildCode64
nilOL
(
RegVirtual
$
mkVirtual
Reg
vu
II32
))
iselExpr64
(
CmmLit
(
CmmInt
i
_
))
=
do
(
rlo
,
rhi
)
<-
getNewRegPairNat
II32
...
...
@@ -413,7 +414,7 @@ getRegister (CmmLoad mem pk)
|
not
(
isWord64
pk
)
=
do
Amode
addr
addr_code
<-
getAmode
mem
let
code
dst
=
ASSERT
((
regClass
dst
==
RcDouble
)
==
isFloatType
pk
)
let
code
dst
=
ASSERT
((
targetClassOfReg
dst
==
RcDouble
)
==
isFloatType
pk
)
addr_code
`
snocOL
`
LD
size
dst
addr
return
(
Any
size
code
)
where
size
=
cmmTypeSize
pk
...
...
compiler/nativeGen/PPC/Instr.hs
View file @
2d498de3
...
...
@@ -22,6 +22,7 @@ import PPC.Regs
import
PPC.Cond
import
Instruction
import
Size
import
TargetReg
import
RegClass
import
Reg
...
...
@@ -353,7 +354,7 @@ ppc_mkSpillInstr
ppc_mkSpillInstr
reg
delta
slot
=
let
off
=
spillSlotToOffset
slot
in
let
sz
=
case
regClass
reg
of
let
sz
=
case
targetClassOfReg
reg
of
RcInteger
->
II32
RcDouble
->
FF64
_
->
panic
"PPC.Instr.mkSpillInstr: no match"
...
...
@@ -369,7 +370,7 @@ ppc_mkLoadInstr
ppc_mkLoadInstr
reg
delta
slot
=
let
off
=
spillSlotToOffset
slot
in
let
sz
=
case
regClass
reg
of
let
sz
=
case
targetClassOfReg
reg
of
RcInteger
->
II32
RcDouble
->
FF64
_
->
panic
"PPC.Instr.mkLoadInstr: no match"
...
...
compiler/nativeGen/PPC/Ppr.hs
View file @
2d498de3
...
...
@@ -31,6 +31,7 @@ import Instruction
import
Size
import
Reg
import
RegClass
import
TargetReg
import
BlockId
import
Cmm
...
...
@@ -469,7 +470,7 @@ pprInstr (MR reg1 reg2)
|
reg1
==
reg2
=
empty
|
otherwise
=
hcat
[
char
'
\t
'
,
case
regClass
reg1
of
case
targetClassOfReg
reg1
of
RcInteger
->
ptext
(
sLit
"mr"
)
_
->
ptext
(
sLit
"fmr"
),
char
'
\t
'
,
...
...
compiler/nativeGen/PPC/RegInfo.hs
View file @
2d498de3
...
...
@@ -7,14 +7,11 @@
-----------------------------------------------------------------------------
module
PPC.RegInfo
(
mkVReg
,
JumpDest
,
canShortcut
,
shortcutJump
,
shortcutStatic
,
regDotColor
shortcutStatic
)
where
...
...
@@ -24,28 +21,12 @@ where
import
PPC.Regs
import
PPC.Instr
import
RegClass
import
Reg
import
Size
import
BlockId
import
Cmm
import
CLabel
import
Outputable
import
Unique
mkVReg
::
Unique
->
Size
->
Reg
mkVReg
u
size
|
not
(
isFloatSize
size
)
=
RegVirtual
$
VirtualRegI
u
|
otherwise
=
case
size
of
FF32
->
RegVirtual
$
VirtualRegD
u
FF64
->
RegVirtual
$
VirtualRegD
u
_
->
panic
"mkVReg"
data
JumpDest
=
DestBlockId
BlockId
|
DestImm
Imm
...
...
@@ -84,11 +65,3 @@ shortBlockId fn blockid@(BlockId uq) =
Just
(
DestImm
(
ImmCLbl
lbl
))
->
lbl
_other
->
panic
"shortBlockId"
regDotColor
::
Reg
->
SDoc
regDotColor
reg
=
case
regClass
reg
of
RcInteger
->
text
"blue"
RcFloat
->
text
"red"
RcDouble
->
text
"green"
compiler/nativeGen/PPC/Regs.hs
View file @
2d498de3
...
...
@@ -5,6 +5,13 @@
-- -----------------------------------------------------------------------------
module
PPC.Regs
(
-- squeeze functions
virtualRegSqueeze
,
realRegSqueeze
,
mkVirtualReg
,
regDotColor
,
-- immediates
Imm
(
..
),
strImmLit
,
...
...
@@ -20,7 +27,7 @@ module PPC.Regs (
allArgRegs
,
callClobberedRegs
,
allMachRegNos
,
regClass
,
classOfRealReg
,
showReg
,
-- machine specific
...
...
@@ -46,21 +53,107 @@ where
import
Reg
import
RegClass
import
Size
import
CgUtils
(
get_GlobalReg_addr
)
import
BlockId
import
Cmm
import
CLabel
(
CLabel
)
import
Unique
import
Pretty
import
Outputable
(
Outputable
(
..
),
pprP
anic
,
pani
c
)
import
Outputable
(
p
anic
,
SDo
c
)
import
qualified
Outputable
import
Constants
import
FastBool
import
FastTypes
import
Data.Word
(
Word8
,
Word16
,
Word32
)
import
Data.Int
(
Int8
,
Int16
,
Int32
)
-- squeese functions for the graph allocator -----------------------------------
-- | regSqueeze_class reg
-- Calculuate the maximum number of register colors that could be
-- denied to a node of this class due to having this reg
-- as a neighbour.
--
{-# INLINE virtualRegSqueeze #-}
virtualRegSqueeze
::
RegClass
->
VirtualReg
->
FastInt
virtualRegSqueeze
cls
vr
=
case
cls
of
RcInteger
->
case
vr
of
VirtualRegI
{}
->
_ILIT
(
1
)
VirtualRegHi
{}
->
_ILIT
(
1
)
VirtualRegD
{}
->
_ILIT
(
0
)
VirtualRegF
{}
->
_ILIT
(
0
)
-- We don't use floats on this arch, but we can't
-- return error because the return type is unboxed...
RcFloat
->
case
vr
of
VirtualRegI
{}
->
_ILIT
(
0
)
VirtualRegHi
{}
->
_ILIT
(
0
)
VirtualRegD
{}
->
_ILIT
(
0
)
VirtualRegF
{}
->
_ILIT
(
0
)
RcDouble
->
case
vr
of
VirtualRegI
{}
->
_ILIT
(
0
)
VirtualRegHi
{}
->
_ILIT
(
0
)
VirtualRegD
{}
->
_ILIT
(
1
)
VirtualRegF
{}
->
_ILIT
(
0
)
{-# INLINE realRegSqueeze #-}
realRegSqueeze
::
RegClass
->
RealReg
->
FastInt
realRegSqueeze
cls
rr
=
case
cls
of
RcInteger
->
case
rr
of
RealRegSingle
regNo
|
regNo
<
32
->
_ILIT
(
1
)
-- first fp reg is 32
|
otherwise
->
_ILIT
(
0
)
RealRegPair
{}
->
_ILIT
(
0
)
-- We don't use floats on this arch, but we can't
-- return error because the return type is unboxed...
RcFloat
->
case
rr
of
RealRegSingle
regNo
|
regNo
<
32
->
_ILIT
(
0
)
|
otherwise
->
_ILIT
(
0
)
RealRegPair
{}
->
_ILIT
(
0
)
RcDouble
->
case
rr
of
RealRegSingle
regNo
|
regNo
<
32
->
_ILIT
(
0
)
|
otherwise
->
_ILIT
(
1
)
RealRegPair
{}
->
_ILIT
(
0
)
mkVirtualReg
::
Unique
->
Size
->
VirtualReg
mkVirtualReg
u
size
|
not
(
isFloatSize
size
)
=
VirtualRegI
u
|
otherwise
=
case
size
of
FF32
->
VirtualRegD
u
FF64
->
VirtualRegD
u
_
->
panic
"mkVirtualReg"
regDotColor
::
RealReg
->
SDoc
regDotColor
reg
=
case
classOfRealReg
reg
of
RcInteger
->
Outputable
.
text
"blue"
RcFloat
->
Outputable
.
text
"red"
RcDouble
->
Outputable
.
text
"green"
-- immediates ------------------------------------------------------------------
data
Imm
=
ImmInt
Int
...
...
@@ -173,18 +266,13 @@ allMachRegNos :: [RegNo]
allMachRegNos
=
[
0
..
63
]
{-# INLINE regClass #-}
regClass
::
Reg
->
RegClass
regClass
(
RegVirtual
(
VirtualRegI
_
))
=
RcInteger
regClass
(
RegVirtual
(
VirtualRegHi
_
))
=
RcInteger
regClass
(
RegVirtual
(
VirtualRegF
u
))
=
pprPanic
(
"regClass(ppc):VirtualRegF "
)
(
ppr
u
)
regClass
(
RegVirtual
(
VirtualRegD
_
))
=
RcDouble
regClass
(
RegReal
(
RealRegSingle
i
))
{-# INLINE classOfRealReg #-}
classOfRealReg
::
RealReg
->
RegClass
classOfRealReg
(
RealRegSingle
i
)
|
i
<
32
=
RcInteger
|
otherwise
=
RcDouble
regClass
(
RegReal
(
RealRegPair
{})
)
classOfRealReg
(
RealRegPair
{})
=
panic
"regClass(ppr): no reg pairs on this architecture"
showReg
::
RegNo
->
String
...
...
@@ -541,7 +629,7 @@ get_GlobalReg_reg_or_addr mid
-- allocatableRegs is allMachRegNos with the fixed-use regs removed.
-- i.e., these are the regs for which we are prepared to allow the
-- register allocator to attempt to map VRegs to.
allocatableRegs
::
[
Re
gNo
]
allocatableRegs
::
[
Re
alReg
]
allocatableRegs
=
let
isFree
i
=
isFastTrue
(
freeReg
i
)
in
filter
isFree
allMachRegNos
in
map
RealRegSingle
$
filter
isFree
allMachRegNos
compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs
View file @
2d498de3
...
...
@@ -30,27 +30,31 @@ data FreeRegs = FreeRegs !Word32 !Word32
noFreeRegs
::
FreeRegs
noFreeRegs
=
FreeRegs
0
0
releaseReg
::
Re
gNo
->
FreeRegs
->
FreeRegs
releaseReg
r
(
FreeRegs
g
f
)
releaseReg
::
Re
alReg
->
FreeRegs
->
FreeRegs
releaseReg
(
RealRegSingle
r
)
(
FreeRegs
g
f
)
|
r
>
31
=
FreeRegs
g
(
f
.|.
(
1
`
shiftL
`
(
fromIntegral
r
-
32
)))
|
otherwise
=
FreeRegs
(
g
.|.
(
1
`
shiftL
`
fromIntegral
r
))
f
releaseReg
_
_
=
panic
"RegAlloc.Linear.PPC.releaseReg: bad reg"
initFreeRegs
::
FreeRegs
initFreeRegs
=
foldr
releaseReg
noFreeRegs
allocatableRegs
getFreeRegs
::
RegClass
->
FreeRegs
->
[
Re
gNo
]
-- lazilly
getFreeRegs
::
RegClass
->
FreeRegs
->
[
Re
alReg
]
-- lazilly
getFreeRegs
cls
(
FreeRegs
g
f
)
|
RcDouble
<-
cls
=
go
f
(
0x80000000
)
63
|
RcInteger
<-
cls
=
go
g
(
0x80000000
)
31
|
otherwise
=
pprPanic
"RegAllocLinear.getFreeRegs: Bad register class"
(
ppr
cls
)
where
go
_
0
_
=
[]
go
x
m
i
|
x
.&.
m
/=
0
=
i
:
(
go
x
(
m
`
shiftR
`
1
)
$!
i
-
1
)
go
x
m
i
|
x
.&.
m
/=
0
=
RealRegSingle
i
:
(
go
x
(
m
`
shiftR
`
1
)
$!
i
-
1
)
|
otherwise
=
go
x
(
m
`
shiftR
`
1
)
$!
i
-
1
allocateReg
::
Re
gNo
->
FreeRegs
->
FreeRegs
allocateReg
r
(
FreeRegs
g
f
)
allocateReg
::
Re
alReg
->
FreeRegs
->
FreeRegs
allocateReg
(
RealRegSingle
r
)
(
FreeRegs
g
f
)
|
r
>
31
=
FreeRegs
g
(
f
.&.
complement
(
1
`
shiftL
`
(
fromIntegral
r
-
32
)))
|
otherwise
=
FreeRegs
(
g
.&.
complement
(
1
`
shiftL
`
fromIntegral
r
))
f
allocateReg
_
_
=
panic
"RegAlloc.Linear.PPC.allocateReg: bad reg"
compiler/nativeGen/TargetReg.hs
View file @
2d498de3
...
...
@@ -39,7 +39,6 @@ import qualified X86.RegInfo as X86
#
elif
powerpc_TARGET_ARCH
import
qualified
PPC.Regs
as
PPC
import
qualified
PPC.RegInfo
as
PPC
#
elif
sparc_TARGET_ARCH
import
qualified
SPARC.Regs
as
SPARC
...
...
compiler/nativeGen/X86/RegInfo.hs
View file @
2d498de3
...
...
@@ -9,7 +9,6 @@ where
#
include
"nativeGen/NCG.h"
#
include
"HsVersions.h"
import
X86.Regs
import
Size
import
Reg
...
...
@@ -18,6 +17,7 @@ import Unique
#
if
i386_TARGET_ARCH
||
x86_64_TARGET_ARCH
import
UniqFM
import
X86.Regs
#
endif
...
...
compiler/nativeGen/X86/Regs.hs
View file @
2d498de3
...
...
@@ -108,12 +108,10 @@ virtualRegSqueeze cls vr
VirtualRegD
{}
->
_ILIT
(
1
)
VirtualRegF
{}
->
_ILIT
(
0
)
realRegSqueeze
::
RegClass
->
RealReg
->
FastInt
#
if
defined
(
i386_TARGET_ARCH
)
{-# INLINE realRegSqueeze #-}
realRegSqueeze
::
RegClass
->
RealReg
->
FastInt
realRegSqueeze
cls
rr
=
case
cls
of
RcInteger
...
...
@@ -172,7 +170,7 @@ realRegSqueeze cls rr
RealRegPair
{}
->
_ILIT
(
0
)
#
else
realRegSqueeze
=
_ILIT
(
0
)
realRegSqueeze
_
_
=
_ILIT
(
0
)
#
endif
...
...
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