2 -----------------------------------------------------------------------------
4 -- (c) The University of Glasgow 1996-2004
6 -----------------------------------------------------------------------------
19 JumpDest, canShortcut, shortcutJump, shortcutStatic,
32 #include "nativeGen/NCG.h"
33 #include "HsVersions.h"
42 import Constants ( rESERVED_C_STACK_BYTES )
45 data RegUsage = RU [Reg] [Reg]
50 regUsage :: Instr -> RegUsage
52 regUsage instr = case instr of
53 SPILL reg slot -> usage ([reg], [])
54 RELOAD slot reg -> usage ([], [reg])
55 LD B reg addr -> usage (regAddr addr, [reg, t9])
56 LD Bu reg addr -> usage (regAddr addr, [reg, t9])
57 -- LD W reg addr -> usage (regAddr addr, [reg, t9]) : UNUSED
58 -- LD Wu reg addr -> usage (regAddr addr, [reg, t9]) : UNUSED
59 LD sz reg addr -> usage (regAddr addr, [reg])
60 LDA reg addr -> usage (regAddr addr, [reg])
61 LDAH reg addr -> usage (regAddr addr, [reg])
62 LDGP reg addr -> usage (regAddr addr, [reg])
63 LDI sz reg imm -> usage ([], [reg])
64 ST B reg addr -> usage (reg : regAddr addr, [t9, t10])
65 -- ST W reg addr -> usage (reg : regAddr addr, [t9, t10]) : UNUSED
66 ST sz reg addr -> usage (reg : regAddr addr, [])
67 CLR reg -> usage ([], [reg])
68 ABS sz ri reg -> usage (regRI ri, [reg])
69 NEG sz ov ri reg -> usage (regRI ri, [reg])
70 ADD sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2])
71 SADD sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
72 SUB sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2])
73 SSUB sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
74 MUL sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2])
75 DIV sz un r1 ar r2 -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
76 REM sz un r1 ar r2 -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
77 NOT ri reg -> usage (regRI ri, [reg])
78 AND r1 ar r2 -> usage (r1 : regRI ar, [r2])
79 ANDNOT r1 ar r2 -> usage (r1 : regRI ar, [r2])
80 OR r1 ar r2 -> usage (r1 : regRI ar, [r2])
81 ORNOT r1 ar r2 -> usage (r1 : regRI ar, [r2])
82 XOR r1 ar r2 -> usage (r1 : regRI ar, [r2])
83 XORNOT r1 ar r2 -> usage (r1 : regRI ar, [r2])
84 SLL r1 ar r2 -> usage (r1 : regRI ar, [r2])
85 SRL r1 ar r2 -> usage (r1 : regRI ar, [r2])
86 SRA r1 ar r2 -> usage (r1 : regRI ar, [r2])
87 ZAP r1 ar r2 -> usage (r1 : regRI ar, [r2])
88 ZAPNOT r1 ar r2 -> usage (r1 : regRI ar, [r2])
89 CMP co r1 ar r2 -> usage (r1 : regRI ar, [r2])
90 FCLR reg -> usage ([], [reg])
91 FABS r1 r2 -> usage ([r1], [r2])
92 FNEG sz r1 r2 -> usage ([r1], [r2])
93 FADD sz r1 r2 r3 -> usage ([r1, r2], [r3])
94 FDIV sz r1 r2 r3 -> usage ([r1, r2], [r3])
95 FMUL sz r1 r2 r3 -> usage ([r1, r2], [r3])
96 FSUB sz r1 r2 r3 -> usage ([r1, r2], [r3])
97 CVTxy sz1 sz2 r1 r2 -> usage ([r1], [r2])
98 FCMP sz co r1 r2 r3 -> usage ([r1, r2], [r3])
99 FMOV r1 r2 -> usage ([r1], [r2])
102 -- We assume that all local jumps will be BI/BF/BR. JMP must be out-of-line.
103 BI cond reg lbl -> usage ([reg], [])
104 BF cond reg lbl -> usage ([reg], [])
105 JMP reg addr hint -> RU (mkRegSet (filter interesting (regAddr addr))) freeRegSet
107 BSR _ n -> RU (argRegSet n) callClobberedRegSet
108 JSR reg addr n -> RU (argRegSet n) callClobberedRegSet
113 usage (src, dst) = RU (mkRegSet (filter interesting src))
114 (mkRegSet (filter interesting dst))
116 interesting (FixedReg _) = False
119 regAddr (AddrReg r1) = [r1]
120 regAddr (AddrRegImm r1 _) = [r1]
121 regAddr (AddrImm _) = []
123 regRI (RIReg r) = [r]
127 patchRegs :: Instr -> (Reg -> Reg) -> Instr
128 patchRegs instr env = case instr of
129 SPILL reg slot -> SPILL (env reg) slot
130 RELOAD slot reg -> RELOAD slot (env reg)
131 LD sz reg addr -> LD sz (env reg) (fixAddr addr)
132 LDA reg addr -> LDA (env reg) (fixAddr addr)
133 LDAH reg addr -> LDAH (env reg) (fixAddr addr)
134 LDGP reg addr -> LDGP (env reg) (fixAddr addr)
135 LDI sz reg imm -> LDI sz (env reg) imm
136 ST sz reg addr -> ST sz (env reg) (fixAddr addr)
137 CLR reg -> CLR (env reg)
138 ABS sz ar reg -> ABS sz (fixRI ar) (env reg)
139 NEG sz ov ar reg -> NEG sz ov (fixRI ar) (env reg)
140 ADD sz ov r1 ar r2 -> ADD sz ov (env r1) (fixRI ar) (env r2)
141 SADD sz sc r1 ar r2 -> SADD sz sc (env r1) (fixRI ar) (env r2)
142 SUB sz ov r1 ar r2 -> SUB sz ov (env r1) (fixRI ar) (env r2)
143 SSUB sz sc r1 ar r2 -> SSUB sz sc (env r1) (fixRI ar) (env r2)
144 MUL sz ov r1 ar r2 -> MUL sz ov (env r1) (fixRI ar) (env r2)
145 DIV sz un r1 ar r2 -> DIV sz un (env r1) (fixRI ar) (env r2)
146 REM sz un r1 ar r2 -> REM sz un (env r1) (fixRI ar) (env r2)
147 NOT ar reg -> NOT (fixRI ar) (env reg)
148 AND r1 ar r2 -> AND (env r1) (fixRI ar) (env r2)
149 ANDNOT r1 ar r2 -> ANDNOT (env r1) (fixRI ar) (env r2)
150 OR r1 ar r2 -> OR (env r1) (fixRI ar) (env r2)
151 ORNOT r1 ar r2 -> ORNOT (env r1) (fixRI ar) (env r2)
152 XOR r1 ar r2 -> XOR (env r1) (fixRI ar) (env r2)
153 XORNOT r1 ar r2 -> XORNOT (env r1) (fixRI ar) (env r2)
154 SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
155 SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
156 SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
157 ZAP r1 ar r2 -> ZAP (env r1) (fixRI ar) (env r2)
158 ZAPNOT r1 ar r2 -> ZAPNOT (env r1) (fixRI ar) (env r2)
159 CMP co r1 ar r2 -> CMP co (env r1) (fixRI ar) (env r2)
160 FCLR reg -> FCLR (env reg)
161 FABS r1 r2 -> FABS (env r1) (env r2)
162 FNEG s r1 r2 -> FNEG s (env r1) (env r2)
163 FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
164 FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
165 FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
166 FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
167 CVTxy s1 s2 r1 r2 -> CVTxy s1 s2 (env r1) (env r2)
168 FCMP s co r1 r2 r3 -> FCMP s co (env r1) (env r2) (env r3)
169 FMOV r1 r2 -> FMOV (env r1) (env r2)
170 BI cond reg lbl -> BI cond (env reg) lbl
171 BF cond reg lbl -> BF cond (env reg) lbl
172 JMP reg addr hint -> JMP (env reg) (fixAddr addr) hint
173 JSR reg addr i -> JSR (env reg) (fixAddr addr) i
176 fixAddr (AddrReg r1) = AddrReg (env r1)
177 fixAddr (AddrRegImm r1 i) = AddrRegImm (env r1) i
178 fixAddr other = other
180 fixRI (RIReg r) = RIReg (env r)
185 :: Reg -- register to spill
186 -> Int -- current stack delta
187 -> Int -- spill slot to use
190 mkSpillInstr reg delta slot
191 = let off = spillSlotToOffset slot
193 -- Alpha: spill below the stack pointer (?)
194 ST sz dyn (spRel (- (off `div` 8)))
198 :: Reg -- register to load
199 -> Int -- current stack delta
200 -> Int -- spill slot to use
202 mkLoadInstr reg delta slot
203 = let off = spillSlotToOffset slot
205 LD sz dyn (spRel (- (off `div` 8)))
212 mkBranchInstr id = [BR id]