Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
67136d3a
Commit
67136d3a
authored
Feb 04, 2009
by
Ben.Lippmeier@anu.edu.au
Browse files
NCG: Split RegAllocInfo into arch specific modules
parent
ee6bba6f
Changes
12
Expand all
Hide whitespace changes
Inline
Side-by-side
compiler/ghc.cabal.in
View file @
67136d3a
...
...
@@ -458,18 +458,22 @@ Library
Regs
RegsBase
Instrs
RegAllocInfo
Alpha.Regs
Alpha.RegInfo
Alpha.Instr
X86.Regs
X86.RegInfo
X86.Instr
PPC.Regs
PPC.RegInfo
PPC.Instr
SPARC.Regs
SPARC.RegInfo
SPARC.Instr
NCGMonad
PositionIndependentCode
PprMach
RegAllocInfo
RegAlloc.Liveness
RegAlloc.Graph.Main
RegAlloc.Graph.Stats
...
...
compiler/nativeGen/Alpha/RegInfo.hs
0 → 100644
View file @
67136d3a
-----------------------------------------------------------------------------
--
-- (c) The University of Glasgow 1996-2004
--
-----------------------------------------------------------------------------
module
Alpha.RegInfo
(
{-
RegUsage(..),
noUsage,
regUsage,
patchRegs,
jumpDests,
isJumpish,
patchJump,
isRegRegMove,
JumpDest, canShortcut, shortcutJump, shortcutStatic,
maxSpillSlots,
mkSpillInstr,
mkLoadInstr,
mkRegRegMoveInstr,
mkBranchInstr
-}
)
where
{-
#include "nativeGen/NCG.h"
#include "HsVersions.h"
import BlockId
import Cmm
import CLabel
import Instrs
import Regs
import Outputable
import Constants ( rESERVED_C_STACK_BYTES )
import FastBool
data RegUsage = RU [Reg] [Reg]
noUsage :: RegUsage
noUsage = RU [] []
regUsage :: Instr -> RegUsage
regUsage instr = case instr of
SPILL reg slot -> usage ([reg], [])
RELOAD slot reg -> usage ([], [reg])
LD B reg addr -> usage (regAddr addr, [reg, t9])
LD Bu reg addr -> usage (regAddr addr, [reg, t9])
-- LD W reg addr -> usage (regAddr addr, [reg, t9]) : UNUSED
-- LD Wu reg addr -> usage (regAddr addr, [reg, t9]) : UNUSED
LD sz reg addr -> usage (regAddr addr, [reg])
LDA reg addr -> usage (regAddr addr, [reg])
LDAH reg addr -> usage (regAddr addr, [reg])
LDGP reg addr -> usage (regAddr addr, [reg])
LDI sz reg imm -> usage ([], [reg])
ST B reg addr -> usage (reg : regAddr addr, [t9, t10])
-- ST W reg addr -> usage (reg : regAddr addr, [t9, t10]) : UNUSED
ST sz reg addr -> usage (reg : regAddr addr, [])
CLR reg -> usage ([], [reg])
ABS sz ri reg -> usage (regRI ri, [reg])
NEG sz ov ri reg -> usage (regRI ri, [reg])
ADD sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2])
SADD sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
SUB sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2])
SSUB sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
MUL sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2])
DIV sz un r1 ar r2 -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
REM sz un r1 ar r2 -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
NOT ri reg -> usage (regRI ri, [reg])
AND r1 ar r2 -> usage (r1 : regRI ar, [r2])
ANDNOT r1 ar r2 -> usage (r1 : regRI ar, [r2])
OR r1 ar r2 -> usage (r1 : regRI ar, [r2])
ORNOT r1 ar r2 -> usage (r1 : regRI ar, [r2])
XOR r1 ar r2 -> usage (r1 : regRI ar, [r2])
XORNOT r1 ar r2 -> usage (r1 : regRI ar, [r2])
SLL r1 ar r2 -> usage (r1 : regRI ar, [r2])
SRL r1 ar r2 -> usage (r1 : regRI ar, [r2])
SRA r1 ar r2 -> usage (r1 : regRI ar, [r2])
ZAP r1 ar r2 -> usage (r1 : regRI ar, [r2])
ZAPNOT r1 ar r2 -> usage (r1 : regRI ar, [r2])
CMP co r1 ar r2 -> usage (r1 : regRI ar, [r2])
FCLR reg -> usage ([], [reg])
FABS r1 r2 -> usage ([r1], [r2])
FNEG sz r1 r2 -> usage ([r1], [r2])
FADD sz r1 r2 r3 -> usage ([r1, r2], [r3])
FDIV sz r1 r2 r3 -> usage ([r1, r2], [r3])
FMUL sz r1 r2 r3 -> usage ([r1, r2], [r3])
FSUB sz r1 r2 r3 -> usage ([r1, r2], [r3])
CVTxy sz1 sz2 r1 r2 -> usage ([r1], [r2])
FCMP sz co r1 r2 r3 -> usage ([r1, r2], [r3])
FMOV r1 r2 -> usage ([r1], [r2])
-- We assume that all local jumps will be BI/BF/BR. JMP must be out-of-line.
BI cond reg lbl -> usage ([reg], [])
BF cond reg lbl -> usage ([reg], [])
JMP reg addr hint -> RU (mkRegSet (filter interesting (regAddr addr))) freeRegSet
BSR _ n -> RU (argRegSet n) callClobberedRegSet
JSR reg addr n -> RU (argRegSet n) callClobberedRegSet
_ -> noUsage
where
usage (src, dst) = RU (mkRegSet (filter interesting src))
(mkRegSet (filter interesting dst))
interesting (FixedReg _) = False
interesting _ = True
regAddr (AddrReg r1) = [r1]
regAddr (AddrRegImm r1 _) = [r1]
regAddr (AddrImm _) = []
regRI (RIReg r) = [r]
regRI _ = []
patchRegs :: Instr -> (Reg -> Reg) -> Instr
patchRegs instr env = case instr of
SPILL reg slot -> SPILL (env reg) slot
RELOAD slot reg -> RELOAD slot (env reg)
LD sz reg addr -> LD sz (env reg) (fixAddr addr)
LDA reg addr -> LDA (env reg) (fixAddr addr)
LDAH reg addr -> LDAH (env reg) (fixAddr addr)
LDGP reg addr -> LDGP (env reg) (fixAddr addr)
LDI sz reg imm -> LDI sz (env reg) imm
ST sz reg addr -> ST sz (env reg) (fixAddr addr)
CLR reg -> CLR (env reg)
ABS sz ar reg -> ABS sz (fixRI ar) (env reg)
NEG sz ov ar reg -> NEG sz ov (fixRI ar) (env reg)
ADD sz ov r1 ar r2 -> ADD sz ov (env r1) (fixRI ar) (env r2)
SADD sz sc r1 ar r2 -> SADD sz sc (env r1) (fixRI ar) (env r2)
SUB sz ov r1 ar r2 -> SUB sz ov (env r1) (fixRI ar) (env r2)
SSUB sz sc r1 ar r2 -> SSUB sz sc (env r1) (fixRI ar) (env r2)
MUL sz ov r1 ar r2 -> MUL sz ov (env r1) (fixRI ar) (env r2)
DIV sz un r1 ar r2 -> DIV sz un (env r1) (fixRI ar) (env r2)
REM sz un r1 ar r2 -> REM sz un (env r1) (fixRI ar) (env r2)
NOT ar reg -> NOT (fixRI ar) (env reg)
AND r1 ar r2 -> AND (env r1) (fixRI ar) (env r2)
ANDNOT r1 ar r2 -> ANDNOT (env r1) (fixRI ar) (env r2)
OR r1 ar r2 -> OR (env r1) (fixRI ar) (env r2)
ORNOT r1 ar r2 -> ORNOT (env r1) (fixRI ar) (env r2)
XOR r1 ar r2 -> XOR (env r1) (fixRI ar) (env r2)
XORNOT r1 ar r2 -> XORNOT (env r1) (fixRI ar) (env r2)
SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
ZAP r1 ar r2 -> ZAP (env r1) (fixRI ar) (env r2)
ZAPNOT r1 ar r2 -> ZAPNOT (env r1) (fixRI ar) (env r2)
CMP co r1 ar r2 -> CMP co (env r1) (fixRI ar) (env r2)
FCLR reg -> FCLR (env reg)
FABS r1 r2 -> FABS (env r1) (env r2)
FNEG s r1 r2 -> FNEG s (env r1) (env r2)
FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
CVTxy s1 s2 r1 r2 -> CVTxy s1 s2 (env r1) (env r2)
FCMP s co r1 r2 r3 -> FCMP s co (env r1) (env r2) (env r3)
FMOV r1 r2 -> FMOV (env r1) (env r2)
BI cond reg lbl -> BI cond (env reg) lbl
BF cond reg lbl -> BF cond (env reg) lbl
JMP reg addr hint -> JMP (env reg) (fixAddr addr) hint
JSR reg addr i -> JSR (env reg) (fixAddr addr) i
_ -> instr
where
fixAddr (AddrReg r1) = AddrReg (env r1)
fixAddr (AddrRegImm r1 i) = AddrRegImm (env r1) i
fixAddr other = other
fixRI (RIReg r) = RIReg (env r)
fixRI other = other
mkSpillInstr
:: Reg -- register to spill
-> Int -- current stack delta
-> Int -- spill slot to use
-> Instr
mkSpillInstr reg delta slot
= let off = spillSlotToOffset slot
in
-- Alpha: spill below the stack pointer (?)
ST sz dyn (spRel (- (off `div` 8)))
mkLoadInstr
:: Reg -- register to load
-> Int -- current stack delta
-> Int -- spill slot to use
-> Instr
mkLoadInstr reg delta slot
= let off = spillSlotToOffset slot
in
LD sz dyn (spRel (- (off `div` 8)))
mkBranchInstr
:: BlockId
-> [Instr]
mkBranchInstr id = [BR id]
-}
compiler/nativeGen/PPC/Instr.hs
View file @
67136d3a
...
...
@@ -19,7 +19,8 @@ module PPC.Instr (
where
import
BlockId
import
Regs
import
PPC.Regs
import
RegsBase
import
Cmm
import
Outputable
import
FastString
...
...
compiler/nativeGen/PPC/RegInfo.hs
0 → 100644
View file @
67136d3a
-----------------------------------------------------------------------------
--
-- Machine-specific parts of the register allocator
--
-- (c) The University of Glasgow 1996-2004
--
-----------------------------------------------------------------------------
module
PPC.RegInfo
(
RegUsage
(
..
),
noUsage
,
regUsage
,
patchRegs
,
jumpDests
,
isJumpish
,
patchJump
,
isRegRegMove
,
JumpDest
,
canShortcut
,
shortcutJump
,
mkSpillInstr
,
mkLoadInstr
,
mkRegRegMoveInstr
,
mkBranchInstr
,
spillSlotSize
,
maxSpillSlots
,
spillSlotToOffset
)
where
#
include
"nativeGen/NCG.h"
#
include
"HsVersions.h"
import
BlockId
import
Cmm
import
CLabel
import
RegsBase
import
PPC.Regs
import
PPC.Instr
import
Outputable
import
Constants
(
rESERVED_C_STACK_BYTES
)
import
FastBool
data
RegUsage
=
RU
[
Reg
]
[
Reg
]
noUsage
::
RegUsage
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
])
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
MTCTR
reg
->
usage
([
reg
],
[]
)
BCTR
targets
->
noUsage
BL
imm
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
])
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
])
DIVWU
reg1
reg2
reg3
->
usage
([
reg2
,
reg3
],
[
reg1
])
MULLW_MayOflo
reg1
reg2
reg3
->
usage
([
reg2
,
reg3
],
[
reg1
])
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
])
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
->
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
])
FNEG
r1
r2
->
usage
([
r2
],
[
r1
])
FCMP
r1
r2
->
usage
([
r1
,
r2
],
[]
)
FCTIWZ
r1
r2
->
usage
([
r2
],
[
r1
])
FRSP
r1
r2
->
usage
([
r2
],
[
r1
])
MFCR
reg
->
usage
(
[]
,
[
reg
])
MFLR
reg
->
usage
(
[]
,
[
reg
])
FETCHPC
reg
->
usage
(
[]
,
[
reg
])
_
->
noUsage
where
usage
(
src
,
dst
)
=
RU
(
filter
interesting
src
)
(
filter
interesting
dst
)
regAddr
(
AddrRegReg
r1
r2
)
=
[
r1
,
r2
]
regAddr
(
AddrRegImm
r1
_
)
=
[
r1
]
regRI
(
RIReg
r
)
=
[
r
]
regRI
_
=
[]
interesting
::
Reg
->
Bool
interesting
(
VirtualRegI
_
)
=
True
interesting
(
VirtualRegHi
_
)
=
True
interesting
(
VirtualRegF
_
)
=
True
interesting
(
VirtualRegD
_
)
=
True
interesting
(
RealReg
i
)
=
isFastTrue
(
freeReg
i
)
-- -----------------------------------------------------------------------------
-- 'patchRegs' function
-- 'patchRegs' takes an instruction and applies the given mapping to
-- all the register references.
patchRegs
::
Instr
->
(
Reg
->
Reg
)
->
Instr
patchRegs
instr
env
=
case
instr
of
SPILL
reg
slot
->
SPILL
(
env
reg
)
slot
RELOAD
slot
reg
->
RELOAD
slot
(
env
reg
)
LD
sz
reg
addr
->
LD
sz
(
env
reg
)
(
fixAddr
addr
)
LA
sz
reg
addr
->
LA
sz
(
env
reg
)
(
fixAddr
addr
)
ST
sz
reg
addr
->
ST
sz
(
env
reg
)
(
fixAddr
addr
)
STU
sz
reg
addr
->
STU
sz
(
env
reg
)
(
fixAddr
addr
)
LIS
reg
imm
->
LIS
(
env
reg
)
imm
LI
reg
imm
->
LI
(
env
reg
)
imm
MR
reg1
reg2
->
MR
(
env
reg1
)
(
env
reg2
)
CMP
sz
reg
ri
->
CMP
sz
(
env
reg
)
(
fixRI
ri
)
CMPL
sz
reg
ri
->
CMPL
sz
(
env
reg
)
(
fixRI
ri
)
BCC
cond
lbl
->
BCC
cond
lbl
BCCFAR
cond
lbl
->
BCCFAR
cond
lbl
MTCTR
reg
->
MTCTR
(
env
reg
)
BCTR
targets
->
BCTR
targets
BL
imm
argRegs
->
BL
imm
argRegs
-- argument regs
BCTRL
argRegs
->
BCTRL
argRegs
-- cannot be remapped
ADD
reg1
reg2
ri
->
ADD
(
env
reg1
)
(
env
reg2
)
(
fixRI
ri
)
ADDC
reg1
reg2
reg3
->
ADDC
(
env
reg1
)
(
env
reg2
)
(
env
reg3
)
ADDE
reg1
reg2
reg3
->
ADDE
(
env
reg1
)
(
env
reg2
)
(
env
reg3
)
ADDIS
reg1
reg2
imm
->
ADDIS
(
env
reg1
)
(
env
reg2
)
imm
SUBF
reg1
reg2
reg3
->
SUBF
(
env
reg1
)
(
env
reg2
)
(
env
reg3
)
MULLW
reg1
reg2
ri
->
MULLW
(
env
reg1
)
(
env
reg2
)
(
fixRI
ri
)
DIVW
reg1
reg2
reg3
->
DIVW
(
env
reg1
)
(
env
reg2
)
(
env
reg3
)
DIVWU
reg1
reg2
reg3
->
DIVWU
(
env
reg1
)
(
env
reg2
)
(
env
reg3
)
MULLW_MayOflo
reg1
reg2
reg3
->
MULLW_MayOflo
(
env
reg1
)
(
env
reg2
)
(
env
reg3
)
AND
reg1
reg2
ri
->
AND
(
env
reg1
)
(
env
reg2
)
(
fixRI
ri
)
OR
reg1
reg2
ri
->
OR
(
env
reg1
)
(
env
reg2
)
(
fixRI
ri
)
XOR
reg1
reg2
ri
->
XOR
(
env
reg1
)
(
env
reg2
)
(
fixRI
ri
)
XORIS
reg1
reg2
imm
->
XORIS
(
env
reg1
)
(
env
reg2
)
imm
EXTS
sz
reg1
reg2
->
EXTS
sz
(
env
reg1
)
(
env
reg2
)
NEG
reg1
reg2
->
NEG
(
env
reg1
)
(
env
reg2
)
NOT
reg1
reg2
->
NOT
(
env
reg1
)
(
env
reg2
)
SLW
reg1
reg2
ri
->
SLW
(
env
reg1
)
(
env
reg2
)
(
fixRI
ri
)
SRW
reg1
reg2
ri
->
SRW
(
env
reg1
)
(
env
reg2
)
(
fixRI
ri
)
SRAW
reg1
reg2
ri
->
SRAW
(
env
reg1
)
(
env
reg2
)
(
fixRI
ri
)
RLWINM
reg1
reg2
sh
mb
me
->
RLWINM
(
env
reg1
)
(
env
reg2
)
sh
mb
me
FADD
sz
r1
r2
r3
->
FADD
sz
(
env
r1
)
(
env
r2
)
(
env
r3
)
FSUB
sz
r1
r2
r3
->
FSUB
sz
(
env
r1
)
(
env
r2
)
(
env
r3
)
FMUL
sz
r1
r2
r3
->
FMUL
sz
(
env
r1
)
(
env
r2
)
(
env
r3
)
FDIV
sz
r1
r2
r3
->
FDIV
sz
(
env
r1
)
(
env
r2
)
(
env
r3
)
FNEG
r1
r2
->
FNEG
(
env
r1
)
(
env
r2
)
FCMP
r1
r2
->
FCMP
(
env
r1
)
(
env
r2
)
FCTIWZ
r1
r2
->
FCTIWZ
(
env
r1
)
(
env
r2
)
FRSP
r1
r2
->
FRSP
(
env
r1
)
(
env
r2
)
MFCR
reg
->
MFCR
(
env
reg
)
MFLR
reg
->
MFLR
(
env
reg
)
FETCHPC
reg
->
FETCHPC
(
env
reg
)
_
->
instr
where
fixAddr
(
AddrRegReg
r1
r2
)
=
AddrRegReg
(
env
r1
)
(
env
r2
)
fixAddr
(
AddrRegImm
r1
i
)
=
AddrRegImm
(
env
r1
)
i
fixRI
(
RIReg
r
)
=
RIReg
(
env
r
)
fixRI
other
=
other
jumpDests
::
Instr
->
[
BlockId
]
->
[
BlockId
]
jumpDests
insn
acc
=
case
insn
of
BCC
_
id
->
id
:
acc
BCCFAR
_
id
->
id
:
acc
BCTR
targets
->
targets
++
acc
_
->
acc
-- | Check whether a particular instruction is a jump, branch or call instruction (jumpish)
-- We can't just use jumpDests above because the jump might take its arg,
-- so the instr won't contain a blockid.
--
isJumpish
::
Instr
->
Bool
isJumpish
instr
=
case
instr
of
BCC
{}
->
True
BCCFAR
{}
->
True
JMP
{}
->
True
-- | Change the destination of this jump instruction
-- Used in joinToTargets in the linear allocator, when emitting fixup code
-- for join points.
patchJump
::
Instr
->
BlockId
->
BlockId
->
Instr
patchJump
insn
old
new
=
case
insn
of
BCC
cc
id
|
id
==
old
->
BCC
cc
new
BCCFAR
cc
id
|
id
==
old
->
BCCFAR
cc
new
BCTR
targets
->
error
"Cannot patch BCTR"
_
->
insn
isRegRegMove
::
Instr
->
Maybe
(
Reg
,
Reg
)
isRegRegMove
(
MR
dst
src
)
=
Just
(
src
,
dst
)
isRegRegMove
_
=
Nothing
data
JumpDest
=
DestBlockId
BlockId
|
DestImm
Imm
canShortcut
::
Instr
->
Maybe
JumpDest
canShortcut
_
=
Nothing
shortcutJump
::
(
BlockId
->
Maybe
JumpDest
)
->
Instr
->
Instr
shortcutJump
fn
other
=
other
-- -----------------------------------------------------------------------------
-- Generating spill instructions
mkSpillInstr
::
Reg
-- register to spill
->
Int
-- current stack delta
->
Int
-- spill slot to use
->
Instr
mkSpillInstr
reg
delta
slot
=
let
off
=
spillSlotToOffset
slot
in
let
sz
=
case
regClass
reg
of
RcInteger
->
II32
RcDouble
->
FF64
in
ST
sz
reg
(
AddrRegImm
sp
(
ImmInt
(
off
-
delta
)))
mkLoadInstr
::
Reg
-- register to load
->
Int
-- current stack delta
->
Int
-- spill slot to use
->
Instr
mkLoadInstr
reg
delta
slot
=
let
off
=
spillSlotToOffset
slot
in
let
sz
=
case
regClass
reg
of
RcInteger
->
II32
RcDouble
->
FF64
in
LD
sz
reg
(
AddrRegImm
sp
(
ImmInt
(
off
-
delta
)))
mkRegRegMoveInstr
::
Reg
->
Reg
->
Instr
mkRegRegMoveInstr
src
dst
=
MR
dst
src
mkBranchInstr
::
BlockId
->
[
Instr
]
mkBranchInstr
id
=
[
BCC
ALWAYS
id
]
spillSlotSize
::
Int
spillSlotSize
=
8
maxSpillSlots
::
Int
maxSpillSlots
=
((
rESERVED_C_STACK_BYTES
-
64
)
`
div
`
spillSlotSize
)
-
1
-- convert a spill slot number to a *byte* offset, with no sign:
-- decide on a per arch basis whether you are spilling above or below
-- the C stack pointer.
spillSlotToOffset
::
Int
->
Int
spillSlotToOffset
slot
|
slot
>=
0
&&
slot
<
maxSpillSlots
=
64
+
spillSlotSize
*
slot
|
otherwise
=
pprPanic
"spillSlotToOffset:"
(
text
"invalid spill location: "
<>
int
slot
$$
text
"maxSpillSlots: "
<>
int
maxSpillSlots
)
compiler/nativeGen/RegAlloc/Linear/Main.hs
View file @
67136d3a
...
...
@@ -323,7 +323,7 @@ raInsn block_live new_instrs id (Instr instr (Just live))
(
uniqSetToList
$
liveDieWrite
live
)
raInsn
_
_
id
instr
raInsn
_
_
_
instr
=
pprPanic
"raInsn"
(
text
"no match for:"
<>
ppr
instr
)
...
...
compiler/nativeGen/RegAllocInfo.hs
View file @
67136d3a
This diff is collapsed.
Click to expand it.
compiler/nativeGen/Regs.hs
View file @
67136d3a
...
...
@@ -61,18 +61,11 @@ module Regs (
freg
,
sp
,
r3
,
r4
,
r27
,
r28
,
f1
,
f20
,
f21
,
#
elif
i386_TARGET_ARCH
#
elif
i386_TARGET_ARCH
||
i386_64_TARGET_ARCH
EABase
(
..
),
EAIndex
(
..
),
addrModeRegs
,
eax
,
ebx
,
ecx
,
edx
,
esi
,
edi
,
ebp
,
esp
,
fake0
,
fake1
,
fake2
,
fake3
,
fake4
,
fake5
,
#
elif
i386_64_TARGET_ARCH
EABase
(
..
),
EAIndex
(
..
),
addrModeRegs
,
ripRel
,
allFPArgRegs
,
rax
,
rbx
,
rcx
,
rdx
,
rsi
,
rdi
,
rbp
,
rsp
,
eax
,
ebx
,
ecx
,
edx
,
esi
,
edi
,
ebp
,
esp
,
r8
,
r9
,
r10
,
r11
,
r12
,
r13
,
r14
,
r15
,
...
...
@@ -80,6 +73,9 @@ module Regs (
xmm8
,
xmm9
,
xmm10
,
xmm11
,
xmm12
,
xmm13
,
xmm14
,
xmm15
,
xmm
,
ripRel
,
allFPArgRegs
,
#
elif
sparc_TARGET_ARCH
fpRel
,
fits13Bits
,
...
...
compiler/nativeGen/SPARC/Instr.hs
View file @
67136d3a
...
...
@@ -22,7 +22,8 @@ module SPARC.Instr (
where