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
1353826e
Commit
1353826e
authored
Feb 05, 2009
by
Ben.Lippmeier@anu.edu.au
Browse files
NCG: Validate fixes
parent
67136d3a
Changes
8
Hide whitespace changes
Inline
Side-by-side
compiler/nativeGen/PPC/RegInfo.hs
View file @
1353826e
...
...
@@ -16,7 +16,7 @@ module PPC.RegInfo (
patchJump
,
isRegRegMove
,
JumpDest
,
JumpDest
(
..
)
,
canShortcut
,
shortcutJump
,
...
...
@@ -36,8 +36,6 @@ where
#
include
"HsVersions.h"
import
BlockId
import
Cmm
import
CLabel
import
RegsBase
import
PPC.Regs
import
PPC.Instr
...
...
@@ -52,28 +50,28 @@ noUsage = RU [] []
regUsage
::
Instr
->
RegUsage
regUsage
instr
=
case
instr
of
SPILL
reg
slot
->
usage
([
reg
],
[]
)
RELOAD
slot
reg
->
usage
(
[]
,
[
reg
])
LD
sz
reg
addr
->
usage
(
regAddr
addr
,
[
reg
])
LA
sz
reg
addr
->
usage
(
regAddr
addr
,
[
reg
])
ST
sz
reg
addr
->
usage
(
reg
:
regAddr
addr
,
[]
)
STU
sz
reg
addr
->
usage
(
reg
:
regAddr
addr
,
[]
)
LIS
reg
imm
->
usage
(
[]
,
[
reg
])
LI
reg
imm
->
usage
(
[]
,
[
reg
])
SPILL
reg
_
->
usage
([
reg
],
[]
)
RELOAD
_
reg
->
usage
(
[]
,
[
reg
])
LD
_
reg
addr
->
usage
(
regAddr
addr
,
[
reg
])
LA
_
reg
addr
->
usage
(
regAddr
addr
,
[
reg
])
ST
_
reg
addr
->
usage
(
reg
:
regAddr
addr
,
[]
)
STU
_
reg
addr
->
usage
(
reg
:
regAddr
addr
,
[]
)
LIS
reg
_
->
usage
(
[]
,
[
reg
])
LI
reg
_
->
usage
(
[]
,
[
reg
])
MR
reg1
reg2
->
usage
([
reg2
],
[
reg1
])
CMP
sz
reg
ri
->
usage
(
reg
:
regRI
ri
,
[]
)
CMPL
sz
reg
ri
->
usage
(
reg
:
regRI
ri
,
[]
)
BCC
cond
lbl
->
noUsage
BCCFAR
cond
lbl
->
noUsage
CMP
_
reg
ri
->
usage
(
reg
:
regRI
ri
,
[]
)
CMPL
_
reg
ri
->
usage
(
reg
:
regRI
ri
,
[]
)
BCC
_
_
->
noUsage
BCCFAR
_
_
->
noUsage
MTCTR
reg
->
usage
([
reg
],
[]
)
BCTR
targets
->
noUsage
BL
imm
params
->
usage
(
params
,
callClobberedRegs
)
BCTR
_
->
noUsage
BL
_
params
->
usage
(
params
,
callClobberedRegs
)
BCTRL
params
->
usage
(
params
,
callClobberedRegs
)
ADD
reg1
reg2
ri
->
usage
(
reg2
:
regRI
ri
,
[
reg1
])
ADDC
reg1
reg2
reg3
->
usage
([
reg2
,
reg3
],
[
reg1
])
ADDE
reg1
reg2
reg3
->
usage
([
reg2
,
reg3
],
[
reg1
])
ADDIS
reg1
reg2
imm
->
usage
([
reg2
],
[
reg1
])
ADDIS
reg1
reg2
_
->
usage
([
reg2
],
[
reg1
])
SUBF
reg1
reg2
reg3
->
usage
([
reg2
,
reg3
],
[
reg1
])
MULLW
reg1
reg2
ri
->
usage
(
reg2
:
regRI
ri
,
[
reg1
])
DIVW
reg1
reg2
reg3
->
usage
([
reg2
,
reg3
],
[
reg1
])
...
...
@@ -83,19 +81,19 @@ regUsage instr = case instr of
AND
reg1
reg2
ri
->
usage
(
reg2
:
regRI
ri
,
[
reg1
])
OR
reg1
reg2
ri
->
usage
(
reg2
:
regRI
ri
,
[
reg1
])
XOR
reg1
reg2
ri
->
usage
(
reg2
:
regRI
ri
,
[
reg1
])
XORIS
reg1
reg2
imm
->
usage
([
reg2
],
[
reg1
])
EXTS
siz
reg1
reg2
->
usage
([
reg2
],
[
reg1
])
XORIS
reg1
reg2
_
->
usage
([
reg2
],
[
reg1
])
EXTS
_
reg1
reg2
->
usage
([
reg2
],
[
reg1
])
NEG
reg1
reg2
->
usage
([
reg2
],
[
reg1
])
NOT
reg1
reg2
->
usage
([
reg2
],
[
reg1
])
SLW
reg1
reg2
ri
->
usage
(
reg2
:
regRI
ri
,
[
reg1
])
SRW
reg1
reg2
ri
->
usage
(
reg2
:
regRI
ri
,
[
reg1
])
SRAW
reg1
reg2
ri
->
usage
(
reg2
:
regRI
ri
,
[
reg1
])
RLWINM
reg1
reg2
sh
mb
me
RLWINM
reg1
reg2
_
_
_
->
usage
([
reg2
],
[
reg1
])
FADD
sz
r1
r2
r3
->
usage
([
r2
,
r3
],
[
r1
])
FSUB
sz
r1
r2
r3
->
usage
([
r2
,
r3
],
[
r1
])
FMUL
sz
r1
r2
r3
->
usage
([
r2
,
r3
],
[
r1
])
FDIV
sz
r1
r2
r3
->
usage
([
r2
,
r3
],
[
r1
])
FADD
_
r1
r2
r3
->
usage
([
r2
,
r3
],
[
r1
])
FSUB
_
r1
r2
r3
->
usage
([
r2
,
r3
],
[
r1
])
FMUL
_
r1
r2
r3
->
usage
([
r2
,
r3
],
[
r1
])
FDIV
_
r1
r2
r3
->
usage
([
r2
,
r3
],
[
r1
])
FNEG
r1
r2
->
usage
([
r2
],
[
r1
])
FCMP
r1
r2
->
usage
([
r1
,
r2
],
[]
)
FCTIWZ
r1
r2
->
usage
([
r2
],
[
r1
])
...
...
@@ -209,7 +207,7 @@ isJumpish instr
BCC
{}
->
True
BCCFAR
{}
->
True
JMP
{}
->
True
_
->
False
-- | Change the destination of this jump instruction
-- Used in joinToTargets in the linear allocator, when emitting fixup code
...
...
@@ -223,7 +221,7 @@ patchJump insn old new
BCCFAR
cc
id
|
id
==
old
->
BCCFAR
cc
new
BCTR
targets
->
error
"Cannot patch BCTR"
BCTR
_
->
error
"Cannot patch BCTR"
_
->
insn
...
...
@@ -239,7 +237,7 @@ canShortcut :: Instr -> Maybe JumpDest
canShortcut
_
=
Nothing
shortcutJump
::
(
BlockId
->
Maybe
JumpDest
)
->
Instr
->
Instr
shortcutJump
fn
other
=
other
shortcutJump
_
other
=
other
...
...
@@ -258,6 +256,7 @@ mkSpillInstr reg delta slot
let
sz
=
case
regClass
reg
of
RcInteger
->
II32
RcDouble
->
FF64
RcFloat
->
panic
"PPC.RegInfo.mkSpillInstr: no match"
in
ST
sz
reg
(
AddrRegImm
sp
(
ImmInt
(
off
-
delta
)))
...
...
@@ -272,6 +271,7 @@ mkLoadInstr reg delta slot
let
sz
=
case
regClass
reg
of
RcInteger
->
II32
RcDouble
->
FF64
RcFloat
->
panic
"PPC.RegInfo.mkSpillInstr: no match"
in
LD
sz
reg
(
AddrRegImm
sp
(
ImmInt
(
off
-
delta
)))
...
...
compiler/nativeGen/Regs.hs
View file @
1353826e
...
...
@@ -67,7 +67,6 @@ module Regs (
eax
,
ebx
,
ecx
,
edx
,
esi
,
edi
,
ebp
,
esp
,
fake0
,
fake1
,
fake2
,
fake3
,
fake4
,
fake5
,
rax
,
rbx
,
rcx
,
rdx
,
rsi
,
rdi
,
rbp
,
rsp
,
eax
,
ebx
,
ecx
,
edx
,
esi
,
edi
,
ebp
,
esp
,
r8
,
r9
,
r10
,
r11
,
r12
,
r13
,
r14
,
r15
,
xmm0
,
xmm1
,
xmm2
,
xmm3
,
xmm4
,
xmm5
,
xmm6
,
xmm7
,
xmm8
,
xmm9
,
xmm10
,
xmm11
,
xmm12
,
xmm13
,
xmm14
,
xmm15
,
...
...
compiler/nativeGen/SPARC/RegInfo.hs
View file @
1353826e
...
...
@@ -38,9 +38,11 @@ where
#
include
"nativeGen/NCG.h"
#
include
"HsVersions.h"
import
SPARC.Instr
import
SPARC.Regs
import
RegsBase
import
BlockId
import
Instrs
import
Regs
import
Outputable
import
Constants
(
rESERVED_C_STACK_BYTES
)
import
FastBool
...
...
compiler/nativeGen/SPARC/Regs.hs
View file @
1353826e
...
...
@@ -324,12 +324,18 @@ o1 = RealReg (oReg 1)
f0
=
RealReg
(
fReg
0
)
#
if
sparc_TARGET_ARCH
nCG_FirstFloatReg
::
RegNo
nCG_FirstFloatReg
=
unRealReg
NCG_FirstFloatReg
#
else
nCG_FirstFloatReg
::
RegNo
nCG_FirstFloatReg
=
unRealReg
f22
#
endif
-- horror show -----------------------------------------------------------------
#
if
sparc_TARGET_ARCH
#
define
g0
0
#
define
g1
1
#
define
g2
2
...
...
@@ -399,6 +405,10 @@ nCG_FirstFloatReg = unRealReg NCG_FirstFloatReg
freeReg
::
RegNo
->
FastBool
globalRegMaybe
::
GlobalReg
->
Maybe
Reg
#
if
defined
(
sparc_TARGET_ARCH
)
freeReg
g0
=
fastBool
False
-- %g0 is always 0.
...
...
@@ -492,7 +502,6 @@ freeReg _ = fastBool True
-- 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
)
...
...
@@ -570,3 +579,13 @@ globalRegMaybe CurrentTSO = Just (RealReg REG_CurrentTSO)
globalRegMaybe
CurrentNursery
=
Just
(
RealReg
REG_CurrentNursery
)
#
endif
globalRegMaybe
_
=
Nothing
#
else
freeReg
_
=
0
#
globalRegMaybe
=
panic
"SPARC.Regs.globalRegMaybe: not defined"
#
endif
compiler/nativeGen/X86/Instr.hs
View file @
1353826e
...
...
@@ -41,7 +41,7 @@ data Cond
|
OFLO
|
PARITY
|
NOTPARITY
deriving
(
Eq
)
-- -----------------------------------------------------------------------------
...
...
compiler/nativeGen/X86/RegInfo.hs
View file @
1353826e
...
...
@@ -9,7 +9,7 @@ module X86.RegInfo (
patchJump
,
isRegRegMove
,
JumpDest
,
JumpDest
(
..
)
,
canShortcut
,
shortcutJump
,
...
...
@@ -457,6 +457,7 @@ mkRegRegMoveInstr src dst
RcInteger
->
MOV
wordSize
(
OpReg
src
)
(
OpReg
dst
)
#
if
i386_TARGET_ARCH
RcDouble
->
GMOV
src
dst
RcFloat
->
panic
"X86.RegInfo.mkRegRegMoveInstr: no match"
#
else
RcDouble
->
MOV
FF64
(
OpReg
src
)
(
OpReg
dst
)
RcFloat
->
panic
"X86.RegInfo.mkRegRegMoveInstr: no match"
...
...
compiler/nativeGen/X86/Regs.hs
View file @
1353826e
...
...
@@ -70,6 +70,7 @@ import Outputable ( Outputable(..), pprPanic, panic )
import
qualified
Outputable
import
Unique
import
FastBool
import
Constants
-- -----------------------------------------------------------------------------
-- Sizes on this architecture
...
...
@@ -247,38 +248,6 @@ argRegs _ = panic "MachRegs.argRegs(x86): should not be used!"
--
allArgRegs
::
[
Reg
]
#
if
i386_TARGET_ARCH
allArgRegs
=
panic
"X86.Regs.allArgRegs: should not be used!"
#
elif
x86_64_TARGET_ARCH
allArgRegs
=
map
RealReg
[
rdi
,
rsi
,
rdx
,
rcx
,
r8
,
r9
]
#
else
allArgRegs
=
panic
"X86.Regs.allArgRegs: not defined for this architecture"
#
endif
-- | these are the regs which we cannot assume stay alive over a C call.
callClobberedRegs
::
[
Reg
]
#
if
i386_TARGET_ARCH
-- caller-saves registers
callClobberedRegs
=
map
RealReg
[
eax
,
ecx
,
edx
,
fake0
,
fake1
,
fake2
,
fake3
,
fake4
,
fake5
]
#
elif
x86_64_TARGET_ARCH
-- all xmm regs are caller-saves
-- caller-saves registers
callClobberedRegs
=
map
RealReg
([
rax
,
rcx
,
rdx
,
rsi
,
rdi
,
r8
,
r9
,
r10
,
r11
]
++
[
16
..
31
])
#
else
callClobberedRegs
=
panic
"X86.Regs.callClobberedRegs: not defined for this architecture"
#
endif
-- | The complete set of machine registers.
...
...
@@ -306,11 +275,10 @@ regClass :: Reg -> RegClass
-- However, we can get away without this at the moment because the
-- only allocatable integer regs are also 8-bit compatible (1, 3, 4).
regClass
(
RealReg
i
)
=
if
i
<
8
then
RcInteger
else
RcDouble
regClass
(
VirtualRegI
u
)
=
RcInteger
regClass
(
VirtualRegHi
u
)
=
RcInteger
regClass
(
VirtualRegD
u
)
=
RcDouble
regClass
(
VirtualRegF
u
)
=
pprPanic
"regClass(x86):VirtualRegF"
(
ppr
(
VirtualRegF
u
))
regClass
(
VirtualRegI
_
)
=
RcInteger
regClass
(
VirtualRegHi
_
)
=
RcInteger
regClass
(
VirtualRegD
_
)
=
RcDouble
regClass
(
VirtualRegF
u
)
=
pprPanic
(
"regClass(x86):VirtualRegF"
)
(
ppr
u
)
#
elif
x86_64_TARGET_ARCH
-- On x86, we might want to have an 8-bit RegClass, which would
...
...
@@ -318,11 +286,10 @@ regClass (VirtualRegF u) = pprPanic "regClass(x86):VirtualRegF"
-- However, we can get away without this at the moment because the
-- only allocatable integer regs are also 8-bit compatible (1, 3, 4).
regClass
(
RealReg
i
)
=
if
i
<
16
then
RcInteger
else
RcDouble
regClass
(
VirtualRegI
u
)
=
RcInteger
regClass
(
VirtualRegHi
u
)
=
RcInteger
regClass
(
VirtualRegD
u
)
=
RcDouble
regClass
(
VirtualRegF
u
)
=
pprPanic
"regClass(x86_64):VirtualRegF"
(
ppr
(
VirtualRegF
u
))
regClass
(
VirtualRegI
_
)
=
RcInteger
regClass
(
VirtualRegHi
_
)
=
RcInteger
regClass
(
VirtualRegD
_
)
=
RcDouble
regClass
(
VirtualRegF
u
)
=
pprPanic
"regClass(x86_64):VirtualRegF"
(
ppr
u
)
#
else
regClass
_
=
panic
"X86.Regs.regClass: not defined for this architecture"
...
...
@@ -339,6 +306,7 @@ showReg n
then
regNames
!!
n
else
"%unknown_x86_real_reg_"
++
show
n
regNames
::
[
String
]
regNames
=
[
"%eax"
,
"%ebx"
,
"%ecx"
,
"%edx"
,
"%esi"
,
"%edi"
,
"%ebp"
,
"%esp"
,
"%fake0"
,
"%fake1"
,
"%fake2"
,
"%fake3"
,
"%fake4"
,
"%fake5"
,
"%fake6"
]
...
...
@@ -349,6 +317,7 @@ showReg n
|
n
>=
8
=
"%r"
++
show
n
|
otherwise
=
regNames
!!
n
regNames
::
[
String
]
regNames
=
[
"%rax"
,
"%rbx"
,
"%rcx"
,
"%rdx"
,
"%rsi"
,
"%rdi"
,
"%rbp"
,
"%rsp"
]
...
...
@@ -597,7 +566,7 @@ freeReg REG_Hp = fastBool False
#
ifdef
REG_HpLim
freeReg
REG_HpLim
=
fastBool
False
#
endif
freeReg
n
=
fastBool
True
freeReg
_
=
fastBool
True
-- | Returns 'Nothing' if this global register is not stored
...
...
@@ -681,9 +650,50 @@ globalRegMaybe CurrentNursery = Just (RealReg REG_CurrentNursery)
#
endif
globalRegMaybe
_
=
Nothing
--
allArgRegs
::
[
Reg
]
#
if
i386_TARGET_ARCH
allArgRegs
=
panic
"X86.Regs.allArgRegs: should not be used!"
#
elif
x86_64_TARGET_ARCH
allArgRegs
=
map
RealReg
[
rdi
,
rsi
,
rdx
,
rcx
,
r8
,
r9
]
#
else
allArgRegs
=
panic
"X86.Regs.allArgRegs: not defined for this architecture"
#
endif
-- | these are the regs which we cannot assume stay alive over a C call.
callClobberedRegs
::
[
Reg
]
#
if
i386_TARGET_ARCH
-- caller-saves registers
callClobberedRegs
=
map
RealReg
[
eax
,
ecx
,
edx
,
fake0
,
fake1
,
fake2
,
fake3
,
fake4
,
fake5
]
#
elif
x86_64_TARGET_ARCH
-- all xmm regs are caller-saves
-- caller-saves registers
callClobberedRegs
=
map
RealReg
([
rax
,
rcx
,
rdx
,
rsi
,
rdi
,
r8
,
r9
,
r10
,
r11
]
++
[
16
..
31
])
#
else
callClobberedRegs
=
panic
"X86.Regs.callClobberedRegs: not defined for this architecture"
#
endif
#
else
/*
i386_TARGET_ARCH
||
x86_64_TARGET_ARCH
*/
freeReg
_
=
0
#
globalRegMaybe
_
=
panic
"X86.Regs.globalRegMaybe: not defined"
allArgRegs
=
panic
"X86.Regs.globalRegMaybe: not defined"
callClobberedRegs
=
panic
"X86.Regs.globalRegMaybe: not defined"
#
endif
rts/Makefile
View file @
1353826e
...
...
@@ -35,8 +35,7 @@ endif
# -----------------------------------------------------------------------------
# RTS ways
WAYS
=
# $(strip $(GhcLibWays) $(GhcRTSWays))
WAYS
=
$(
strip
$(GhcLibWays)
$(GhcRTSWays)
)
ifneq
"$(findstring debug, $(way))" ""
GhcRtsHcOpts
=
...
...
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