never executed always true always false
1
2 module GHC.CmmToAsm.Instr
3 ( Instruction(..)
4 , RegUsage(..)
5 , noUsage
6 )
7 where
8
9 import GHC.Prelude
10
11 import GHC.Platform
12 import GHC.Platform.Reg
13 import GHC.Utils.Outputable (SDoc)
14
15 import GHC.Cmm.BlockId
16
17 import GHC.CmmToAsm.Config
18
19 -- | Holds a list of source and destination registers used by a
20 -- particular instruction.
21 --
22 -- Machine registers that are pre-allocated to stgRegs are filtered
23 -- out, because they are uninteresting from a register allocation
24 -- standpoint. (We wouldn't want them to end up on the free list!)
25 --
26 -- As far as we are concerned, the fixed registers simply don't exist
27 -- (for allocation purposes, anyway).
28 --
29 data RegUsage
30 = RU {
31 reads :: [Reg],
32 writes :: [Reg]
33 }
34 deriving Show
35
36 -- | No regs read or written to.
37 noUsage :: RegUsage
38 noUsage = RU [] []
39
40 -- | Common things that we can do with instructions, on all architectures.
41 -- These are used by the shared parts of the native code generator,
42 -- specifically the register allocators.
43 --
44 class Instruction instr where
45
46 -- | Get the registers that are being used by this instruction.
47 -- regUsage doesn't need to do any trickery for jumps and such.
48 -- Just state precisely the regs read and written by that insn.
49 -- The consequences of control flow transfers, as far as register
50 -- allocation goes, are taken care of by the register allocator.
51 --
52 regUsageOfInstr
53 :: Platform
54 -> instr
55 -> RegUsage
56
57
58 -- | Apply a given mapping to all the register references in this
59 -- instruction.
60 patchRegsOfInstr
61 :: instr
62 -> (Reg -> Reg)
63 -> instr
64
65
66 -- | Checks whether this instruction is a jump/branch instruction.
67 -- One that can change the flow of control in a way that the
68 -- register allocator needs to worry about.
69 isJumpishInstr
70 :: instr -> Bool
71
72
73 -- | Give the possible destinations of this jump instruction.
74 -- Must be defined for all jumpish instructions.
75 jumpDestsOfInstr
76 :: instr -> [BlockId]
77
78
79 -- | Change the destination of this jump instruction.
80 -- Used in the linear allocator when adding fixup blocks for join
81 -- points.
82 patchJumpInstr
83 :: instr
84 -> (BlockId -> BlockId)
85 -> instr
86
87
88 -- | An instruction to spill a register into a spill slot.
89 mkSpillInstr
90 :: NCGConfig
91 -> Reg -- ^ the reg to spill
92 -> Int -- ^ the current stack delta
93 -> Int -- ^ spill slot to use
94 -> [instr] -- ^ instructions
95
96
97 -- | An instruction to reload a register from a spill slot.
98 mkLoadInstr
99 :: NCGConfig
100 -> Reg -- ^ the reg to reload.
101 -> Int -- ^ the current stack delta
102 -> Int -- ^ the spill slot to use
103 -> [instr] -- ^ instructions
104
105 -- | See if this instruction is telling us the current C stack delta
106 takeDeltaInstr
107 :: instr
108 -> Maybe Int
109
110 -- | Check whether this instruction is some meta thing inserted into
111 -- the instruction stream for other purposes.
112 --
113 -- Not something that has to be treated as a real machine instruction
114 -- and have its registers allocated.
115 --
116 -- eg, comments, delta, ldata, etc.
117 isMetaInstr
118 :: instr
119 -> Bool
120
121
122
123 -- | Copy the value in a register to another one.
124 -- Must work for all register classes.
125 mkRegRegMoveInstr
126 :: Platform
127 -> Reg -- ^ source register
128 -> Reg -- ^ destination register
129 -> instr
130
131 -- | Take the source and destination from this reg -> reg move instruction
132 -- or Nothing if it's not one
133 takeRegRegMoveInstr
134 :: instr
135 -> Maybe (Reg, Reg)
136
137 -- | Make an unconditional jump instruction.
138 -- For architectures with branch delay slots, its ok to put
139 -- a NOP after the jump. Don't fill the delay slot with an
140 -- instruction that references regs or you'll confuse the
141 -- linear allocator.
142 mkJumpInstr
143 :: BlockId
144 -> [instr]
145
146
147 -- Subtract an amount from the C stack pointer
148 mkStackAllocInstr
149 :: Platform
150 -> Int
151 -> [instr]
152
153 -- Add an amount to the C stack pointer
154 mkStackDeallocInstr
155 :: Platform
156 -> Int
157 -> [instr]
158
159 -- | Pretty-print an instruction
160 pprInstr :: Platform -> instr -> SDoc
161
162 -- Create a comment instruction
163 mkComment :: SDoc -> [instr]