Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
jberryman
GHC
Commits
25ea332f
Commit
25ea332f
authored
Apr 20, 2009
by
Ben.Lippmeier@anu.edu.au
Browse files
SPARC NCG: Base freeRegs on includes/MachRegs.h again
parent
253c523f
Changes
5
Hide whitespace changes
Inline
Side-by-side
compiler/ghc.cabal.in
View file @
25ea332f
...
...
@@ -481,6 +481,7 @@ Library
PPC.CodeGen
SPARC.Base
SPARC.Regs
SPARC.RegPlate
SPARC.Imm
SPARC.AddrMode
SPARC.Cond
...
...
compiler/nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs
View file @
25ea332f
...
...
@@ -4,6 +4,7 @@ module RegAlloc.Linear.SPARC.FreeRegs
where
import
SPARC.Regs
import
SPARC.RegPlate
import
RegClass
import
Reg
...
...
compiler/nativeGen/SPARC/Instr.hs
View file @
25ea332f
...
...
@@ -29,6 +29,7 @@ import SPARC.Imm
import
SPARC.AddrMode
import
SPARC.Cond
import
SPARC.Regs
import
SPARC.RegPlate
import
SPARC.Base
import
Instruction
import
RegClass
...
...
compiler/nativeGen/SPARC/RegPlate.hs
0 → 100644
View file @
25ea332f
-- | Nasty #ifdefery that generates the definitions for
-- freeReg and globalRegMaybe from the information in includes/MachRegs.h.
--
-- If the current TARGET_ARCH isn't sparc then these functions will be wrong.
--
module
SPARC.RegPlate
(
freeReg
,
globalRegMaybe
)
where
import
Reg
import
CmmExpr
import
FastBool
-- Register numbers for SPARC hardware registers.
-- These names are the same as the ones in Regs.hs, but those have
-- type Reg and not RegNo.
--
#
define
g0
0
#
define
g1
1
#
define
g2
2
#
define
g3
3
#
define
g4
4
#
define
g5
5
#
define
g6
6
#
define
g7
7
#
define
o0
8
#
define
o1
9
#
define
o2
10
#
define
o3
11
#
define
o4
12
#
define
o5
13
#
define
o6
14
#
define
o7
15
#
define
l0
16
#
define
l1
17
#
define
l2
18
#
define
l3
19
#
define
l4
20
#
define
l5
21
#
define
l6
22
#
define
l7
23
#
define
i0
24
#
define
i1
25
#
define
i2
26
#
define
i3
27
#
define
i4
28
#
define
i5
29
#
define
i6
30
#
define
i7
31
#
define
f0
32
#
define
f1
33
#
define
f2
34
#
define
f3
35
#
define
f4
36
#
define
f5
37
#
define
f6
38
#
define
f7
39
#
define
f8
40
#
define
f9
41
#
define
f10
42
#
define
f11
43
#
define
f12
44
#
define
f13
45
#
define
f14
46
#
define
f15
47
#
define
f16
48
#
define
f17
49
#
define
f18
50
#
define
f19
51
#
define
f20
52
#
define
f21
53
#
define
f22
54
#
define
f23
55
#
define
f24
56
#
define
f25
57
#
define
f26
58
#
define
f27
59
#
define
f28
60
#
define
f29
61
#
define
f30
62
#
define
f31
63
#
include
"../includes/MachRegs.h"
-- | Check whether a machine register is free for allocation.
freeReg
::
RegNo
->
FastBool
#
ifdef
sparc_REGS
-- SPARC regs used by the OS / ABI
-- %g0(r0) is always zero
freeReg
g0
=
fastBool
False
-- %g5(r5) - %g7(r7)
-- are reserved for the OS
freeReg
g5
=
fastBool
False
freeReg
g6
=
fastBool
False
freeReg
g7
=
fastBool
False
-- %o6(r14)
-- is the C stack pointer
freeReg
o6
=
fastBool
False
-- %o7(r15)
-- holds the C return address
freeReg
o7
=
fastBool
False
-- %i6(r30)
-- is the C frame pointer
freeReg
i6
=
fastBool
False
-- %i7(r31)
-- is used for C return addresses
freeReg
i7
=
fastBool
False
-- %f0(r32) - %f1(r32)
-- are C floating point return regs
freeReg
f0
=
fastBool
False
freeReg
f1
=
fastBool
False
freeReg
regNo
-- don't release high half of double regs
|
regNo
>=
f0
,
regNo
<
NCG_FirstFloatReg
,
regNo
`
mod
`
2
/=
0
=
fastBool
False
--------------------------------------
#
endif
#
ifdef
REG_Base
freeReg
REG_Base
=
fastBool
False
#
endif
#
ifdef
REG_R1
freeReg
REG_R1
=
fastBool
False
#
endif
#
ifdef
REG_R2
freeReg
REG_R2
=
fastBool
False
#
endif
#
ifdef
REG_R3
freeReg
REG_R3
=
fastBool
False
#
endif
#
ifdef
REG_R4
freeReg
REG_R4
=
fastBool
False
#
endif
#
ifdef
REG_R5
freeReg
REG_R5
=
fastBool
False
#
endif
#
ifdef
REG_R6
freeReg
REG_R6
=
fastBool
False
#
endif
#
ifdef
REG_R7
freeReg
REG_R7
=
fastBool
False
#
endif
#
ifdef
REG_R8
freeReg
REG_R8
=
fastBool
False
#
endif
#
ifdef
REG_F1
freeReg
REG_F1
=
fastBool
False
#
endif
#
ifdef
REG_F2
freeReg
REG_F2
=
fastBool
False
#
endif
#
ifdef
REG_F3
freeReg
REG_F3
=
fastBool
False
#
endif
#
ifdef
REG_F4
freeReg
REG_F4
=
fastBool
False
#
endif
#
ifdef
REG_D1
freeReg
REG_D1
=
fastBool
False
#
endif
#
ifdef
REG_D2
freeReg
REG_D2
=
fastBool
False
#
endif
#
ifdef
REG_Sp
freeReg
REG_Sp
=
fastBool
False
#
endif
#
ifdef
REG_Su
freeReg
REG_Su
=
fastBool
False
#
endif
#
ifdef
REG_SpLim
freeReg
REG_SpLim
=
fastBool
False
#
endif
#
ifdef
REG_Hp
freeReg
REG_Hp
=
fastBool
False
#
endif
#
ifdef
REG_HpLim
freeReg
REG_HpLim
=
fastBool
False
#
endif
freeReg
_
=
fastBool
True
-- | Returns 'Nothing' if this global register is not stored
-- in a real machine register, otherwise returns @'Just' reg@, where
-- reg is the machine register it is stored in.
globalRegMaybe
::
GlobalReg
->
Maybe
Reg
#
ifdef
REG_Base
globalRegMaybe
BaseReg
=
Just
(
RealReg
REG_Base
)
#
endif
#
ifdef
REG_R1
globalRegMaybe
(
VanillaReg
1
_
)
=
Just
(
RealReg
REG_R1
)
#
endif
#
ifdef
REG_R2
globalRegMaybe
(
VanillaReg
2
_
)
=
Just
(
RealReg
REG_R2
)
#
endif
#
ifdef
REG_R3
globalRegMaybe
(
VanillaReg
3
_
)
=
Just
(
RealReg
REG_R3
)
#
endif
#
ifdef
REG_R4
globalRegMaybe
(
VanillaReg
4
_
)
=
Just
(
RealReg
REG_R4
)
#
endif
#
ifdef
REG_R5
globalRegMaybe
(
VanillaReg
5
_
)
=
Just
(
RealReg
REG_R5
)
#
endif
#
ifdef
REG_R6
globalRegMaybe
(
VanillaReg
6
_
)
=
Just
(
RealReg
REG_R6
)
#
endif
#
ifdef
REG_R7
globalRegMaybe
(
VanillaReg
7
_
)
=
Just
(
RealReg
REG_R7
)
#
endif
#
ifdef
REG_R8
globalRegMaybe
(
VanillaReg
8
_
)
=
Just
(
RealReg
REG_R8
)
#
endif
#
ifdef
REG_R9
globalRegMaybe
(
VanillaReg
9
_
)
=
Just
(
RealReg
REG_R9
)
#
endif
#
ifdef
REG_R10
globalRegMaybe
(
VanillaReg
10
_
)
=
Just
(
RealReg
REG_R10
)
#
endif
#
ifdef
REG_F1
globalRegMaybe
(
FloatReg
1
)
=
Just
(
RealReg
REG_F1
)
#
endif
#
ifdef
REG_F2
globalRegMaybe
(
FloatReg
2
)
=
Just
(
RealReg
REG_F2
)
#
endif
#
ifdef
REG_F3
globalRegMaybe
(
FloatReg
3
)
=
Just
(
RealReg
REG_F3
)
#
endif
#
ifdef
REG_F4
globalRegMaybe
(
FloatReg
4
)
=
Just
(
RealReg
REG_F4
)
#
endif
#
ifdef
REG_D1
globalRegMaybe
(
DoubleReg
1
)
=
Just
(
RealReg
REG_D1
)
#
endif
#
ifdef
REG_D2
globalRegMaybe
(
DoubleReg
2
)
=
Just
(
RealReg
REG_D2
)
#
endif
#
ifdef
REG_Sp
globalRegMaybe
Sp
=
Just
(
RealReg
REG_Sp
)
#
endif
#
ifdef
REG_Lng1
globalRegMaybe
(
LongReg
1
)
=
Just
(
RealReg
REG_Lng1
)
#
endif
#
ifdef
REG_Lng2
globalRegMaybe
(
LongReg
2
)
=
Just
(
RealReg
REG_Lng2
)
#
endif
#
ifdef
REG_SpLim
globalRegMaybe
SpLim
=
Just
(
RealReg
REG_SpLim
)
#
endif
#
ifdef
REG_Hp
globalRegMaybe
Hp
=
Just
(
RealReg
REG_Hp
)
#
endif
#
ifdef
REG_HpLim
globalRegMaybe
HpLim
=
Just
(
RealReg
REG_HpLim
)
#
endif
#
ifdef
REG_CurrentTSO
globalRegMaybe
CurrentTSO
=
Just
(
RealReg
REG_CurrentTSO
)
#
endif
#
ifdef
REG_CurrentNursery
globalRegMaybe
CurrentNursery
=
Just
(
RealReg
REG_CurrentNursery
)
#
endif
globalRegMaybe
_
=
Nothing
compiler/nativeGen/SPARC/Regs.hs
View file @
25ea332f
...
...
@@ -17,9 +17,7 @@ module SPARC.Regs (
fPair
,
-- allocatable
freeReg
,
allocatableRegs
,
globalRegMaybe
,
get_GlobalReg_reg_or_addr
,
-- args
...
...
@@ -35,11 +33,13 @@ module SPARC.Regs (
where
import
SPARC.RegPlate
import
Reg
import
RegClass
import
Size
import
Cmm
import
PprCmm
import
CgUtils
(
get_GlobalReg_addr
)
import
Unique
...
...
@@ -142,15 +142,105 @@ fPair (RealReg n)
fPair
(
VirtualRegD
u
)
=
Just
(
VirtualRegHi
u
)
fPair
_
=
trace
(
"MachInstrs.fPair: can't get high half of supposed double reg "
)
fPair
reg
=
trace
(
"MachInstrs.fPair: can't get high half of supposed double reg "
++
showPpr
reg
)
Nothing
-- 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
::
[
RegNo
]
allocatableRegs
=
let
isFree
i
=
isFastTrue
(
freeReg
i
)
in
filter
isFree
allMachRegNos
-- We map STG registers onto appropriate CmmExprs. Either they map
-- to real machine registers or stored as offsets from BaseReg. Given
-- a GlobalReg, get_GlobalReg_reg_or_addr produces either the real
-- register it is in, on this platform, or a CmmExpr denoting the
-- address in the register table holding it.
-- (See also get_GlobalReg_addr in CgUtils.)
get_GlobalReg_reg_or_addr
::
GlobalReg
->
Either
Reg
CmmExpr
get_GlobalReg_reg_or_addr
mid
=
case
globalRegMaybe
mid
of
Just
rr
->
Left
rr
Nothing
->
Right
(
get_GlobalReg_addr
mid
)
-- | The registers to place arguments for function calls,
-- for some number of arguments.
--
argRegs
::
RegNo
->
[
Reg
]
argRegs
r
=
case
r
of
0
->
[]
1
->
map
(
RealReg
.
oReg
)
[
0
]
2
->
map
(
RealReg
.
oReg
)
[
0
,
1
]
3
->
map
(
RealReg
.
oReg
)
[
0
,
1
,
2
]
4
->
map
(
RealReg
.
oReg
)
[
0
,
1
,
2
,
3
]
5
->
map
(
RealReg
.
oReg
)
[
0
,
1
,
2
,
3
,
4
]
6
->
map
(
RealReg
.
oReg
)
[
0
,
1
,
2
,
3
,
4
,
5
]
_
->
panic
"MachRegs.argRegs(sparc): don't know about >6 arguments!"
-- | All all the regs that could possibly be returned by argRegs
--
allArgRegs
::
[
Reg
]
allArgRegs
=
map
RealReg
[
oReg
i
|
i
<-
[
0
..
5
]]
-- These are the regs that we cannot assume stay alive over a C call.
-- TODO: Why can we assume that o6 isn't clobbered? -- BL 2009/02
--
callClobberedRegs
::
[
Reg
]
callClobberedRegs
=
map
RealReg
(
oReg
7
:
[
oReg
i
|
i
<-
[
0
..
5
]]
++
[
gReg
i
|
i
<-
[
1
..
7
]]
++
[
fReg
i
|
i
<-
[
0
..
31
]]
)
-- | Make a virtual reg with this size.
mkVReg
::
Unique
->
Size
->
Reg
mkVReg
u
size
|
not
(
isFloatSize
size
)
=
VirtualRegI
u
|
otherwise
=
case
size
of
FF32
->
VirtualRegF
u
FF64
->
VirtualRegD
u
_
->
panic
"mkVReg"
regDotColor
::
Reg
->
SDoc
regDotColor
reg
=
case
regClass
reg
of
RcInteger
->
text
"blue"
RcFloat
->
text
"red"
RcDouble
->
text
"green"
-- Hard coded freeReg / globalRegMaybe -----------------------------------------
-- This isn't being used at the moment because we're generating
-- these functions from the information in includes/MachRegs.hs via RegPlate.hs
-- | Check whether a machine register is free for allocation.
-- This needs to match the info in includes/MachRegs.h otherwise modules
-- compiled with the NCG won't be compatible with via-C ones.
--
{-
freeReg :: RegNo -> FastBool
freeReg regno
= case regno of
...
...
@@ -228,20 +318,13 @@ freeReg regno
-- regs not matched above are allocable.
_ -> fastBool True
-- 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
::
[
RegNo
]
allocatableRegs
=
let
isFree
i
=
isFastTrue
(
freeReg
i
)
in
filter
isFree
allMachRegNos
-}
-- | Returns Just the real register that a global register is stored in.
-- Returns Nothing if the global has no real register, and is stored
-- in the in-memory register table instead.
--
{-
globalRegMaybe :: GlobalReg -> Maybe Reg
globalRegMaybe gg
= case gg of
...
...
@@ -269,74 +352,4 @@ globalRegMaybe gg
BaseReg -> Just (RealReg 25) -- %i1
_ -> Nothing
-- We map STG registers onto appropriate CmmExprs. Either they map
-- to real machine registers or stored as offsets from BaseReg. Given
-- a GlobalReg, get_GlobalReg_reg_or_addr produces either the real
-- register it is in, on this platform, or a CmmExpr denoting the
-- address in the register table holding it.
-- (See also get_GlobalReg_addr in CgUtils.)
get_GlobalReg_reg_or_addr
::
GlobalReg
->
Either
Reg
CmmExpr
get_GlobalReg_reg_or_addr
mid
=
case
globalRegMaybe
mid
of
Just
rr
->
Left
rr
Nothing
->
Right
(
get_GlobalReg_addr
mid
)
-- | The registers to place arguments for function calls,
-- for some number of arguments.
--
argRegs
::
RegNo
->
[
Reg
]
argRegs
r
=
case
r
of
0
->
[]
1
->
map
(
RealReg
.
oReg
)
[
0
]
2
->
map
(
RealReg
.
oReg
)
[
0
,
1
]
3
->
map
(
RealReg
.
oReg
)
[
0
,
1
,
2
]
4
->
map
(
RealReg
.
oReg
)
[
0
,
1
,
2
,
3
]
5
->
map
(
RealReg
.
oReg
)
[
0
,
1
,
2
,
3
,
4
]
6
->
map
(
RealReg
.
oReg
)
[
0
,
1
,
2
,
3
,
4
,
5
]
_
->
panic
"MachRegs.argRegs(sparc): don't know about >6 arguments!"
-- | All all the regs that could possibly be returned by argRegs
--
allArgRegs
::
[
Reg
]
allArgRegs
=
map
RealReg
[
oReg
i
|
i
<-
[
0
..
5
]]
-- These are the regs that we cannot assume stay alive over a C call.
-- TODO: Why can we assume that o6 isn't clobbered? -- BL 2009/02
--
callClobberedRegs
::
[
Reg
]
callClobberedRegs
=
map
RealReg
(
oReg
7
:
[
oReg
i
|
i
<-
[
0
..
5
]]
++
[
gReg
i
|
i
<-
[
1
..
7
]]
++
[
fReg
i
|
i
<-
[
0
..
31
]]
)
-- | Make a virtual reg with this size.
mkVReg
::
Unique
->
Size
->
Reg
mkVReg
u
size
|
not
(
isFloatSize
size
)
=
VirtualRegI
u
|
otherwise
=
case
size
of
FF32
->
VirtualRegF
u
FF64
->
VirtualRegD
u
_
->
panic
"mkVReg"
regDotColor
::
Reg
->
SDoc
regDotColor
reg
=
case
regClass
reg
of
RcInteger
->
text
"blue"
RcFloat
->
text
"red"
RcDouble
->
text
"green"
-}
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