1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
|
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
-- | Expand out synthetic instructions into single machine instrs.
module GHC.CmmToAsm.SPARC.CodeGen.Expand (
expandTop
)
where
import GHC.Prelude
import GHC.CmmToAsm.SPARC.Instr
import GHC.CmmToAsm.SPARC.Imm
import GHC.CmmToAsm.SPARC.AddrMode
import GHC.CmmToAsm.SPARC.Regs
import GHC.CmmToAsm.Format
import GHC.CmmToAsm.Types
import GHC.Cmm
import GHC.Platform.Reg
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Data.OrdList
-- | Expand out synthetic instructions in this top level thing
expandTop :: NatCmmDecl RawCmmStatics Instr -> NatCmmDecl RawCmmStatics Instr
expandTop top@(CmmData{})
= top
expandTop (CmmProc info lbl live (ListGraph blocks))
= CmmProc info lbl live (ListGraph $ map expandBlock blocks)
-- | Expand out synthetic instructions in this block
expandBlock :: NatBasicBlock Instr -> NatBasicBlock Instr
expandBlock (BasicBlock label instrs)
= let instrs_ol = expandBlockInstrs instrs
instrs' = fromOL instrs_ol
in BasicBlock label instrs'
-- | Expand out some instructions
expandBlockInstrs :: [Instr] -> OrdList Instr
expandBlockInstrs [] = nilOL
expandBlockInstrs (ii:is)
= let ii_doubleRegs = remapRegPair ii
is_misaligned = expandMisalignedDoubles ii_doubleRegs
in is_misaligned `appOL` expandBlockInstrs is
-- | In the SPARC instruction set the FP register pairs that are used
-- to hold 64 bit floats are referred to by just the first reg
-- of the pair. Remap our internal reg pairs to the appropriate reg.
--
-- For example:
-- ldd [%l1], (%f0 | %f1)
--
-- gets mapped to
-- ldd [$l1], %f0
--
remapRegPair :: Instr -> Instr
remapRegPair instr
= let patchF reg
= case reg of
RegReal (RealRegSingle _)
-> reg
RegReal (RealRegPair r1 r2)
-- sanity checking
| r1 >= 32
, r1 <= 63
, r1 `mod` 2 == 0
, r2 == r1 + 1
-> RegReal (RealRegSingle r1)
| otherwise
-> pprPanic "SPARC.CodeGen.Expand: not remapping dodgy looking reg pair " (ppr reg)
RegVirtual _
-> pprPanic "SPARC.CodeGen.Expand: not remapping virtual reg " (ppr reg)
in patchRegsOfInstr instr patchF
-- Expand out 64 bit load/stores into individual instructions to handle
-- possible double alignment problems.
--
-- TODO: It'd be better to use a scratch reg instead of the add/sub thing.
-- We might be able to do this faster if we use the UA2007 instr set
-- instead of restricting ourselves to SPARC V9.
--
expandMisalignedDoubles :: Instr -> OrdList Instr
expandMisalignedDoubles instr
-- Translate to:
-- add g1,g2,g1
-- ld [g1],%fn
-- ld [g1+4],%f(n+1)
-- sub g1,g2,g1 -- to restore g1
| LD FF64 (AddrRegReg r1 r2) fReg <- instr
= toOL [ ADD False False r1 (RIReg r2) r1
, LD FF32 (AddrRegReg r1 g0) fReg
, LD FF32 (AddrRegImm r1 (ImmInt 4)) (fRegHi fReg)
, SUB False False r1 (RIReg r2) r1 ]
-- Translate to
-- ld [addr],%fn
-- ld [addr+4],%f(n+1)
| LD FF64 addr fReg <- instr
= let Just addr' = addrOffset addr 4
in toOL [ LD FF32 addr fReg
, LD FF32 addr' (fRegHi fReg) ]
-- Translate to:
-- add g1,g2,g1
-- st %fn,[g1]
-- st %f(n+1),[g1+4]
-- sub g1,g2,g1 -- to restore g1
| ST FF64 fReg (AddrRegReg r1 r2) <- instr
= toOL [ ADD False False r1 (RIReg r2) r1
, ST FF32 fReg (AddrRegReg r1 g0)
, ST FF32 (fRegHi fReg) (AddrRegImm r1 (ImmInt 4))
, SUB False False r1 (RIReg r2) r1 ]
-- Translate to
-- ld [addr],%fn
-- ld [addr+4],%f(n+1)
| ST FF64 fReg addr <- instr
= let Just addr' = addrOffset addr 4
in toOL [ ST FF32 fReg addr
, ST FF32 (fRegHi fReg) addr' ]
-- some other instr
| otherwise
= unitOL instr
-- | The high partner for this float reg.
fRegHi :: Reg -> Reg
fRegHi (RegReal (RealRegSingle r1))
| r1 >= 32
, r1 <= 63
, r1 `mod` 2 == 0
= (RegReal $ RealRegSingle (r1 + 1))
-- Can't take high partner for non-low reg.
fRegHi reg
= pprPanic "SPARC.CodeGen.Expand: can't take fRegHi from " (ppr reg)
|
