blob: 22c5b9b6a7813a959b11996290cff09e0272ec8f [file] [log] [blame]
Nico Huber83693c82016-10-08 22:17:55 +02001--
2-- Copyright (C) 2015-2016 secunet Security Networks AG
3--
4-- This program is free software; you can redistribute it and/or modify
5-- it under the terms of the GNU General Public License as published by
6-- the Free Software Foundation; version 2 of the License.
7--
8-- This program is distributed in the hope that it will be useful,
9-- but WITHOUT ANY WARRANTY; without even the implied warranty of
10-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11-- GNU General Public License for more details.
12--
13
14with System.Storage_Elements;
15
16with HW.Time;
17with HW.MMIO_Range;
18pragma Elaborate_All (HW.MMIO_Range);
19
20with HW.Debug;
21with GNAT.Source_Info;
22
23use type System.Address;
24use type HW.Word64;
25
26package body HW.GFX.GMA.Registers
27with
28 Refined_State =>
29 (Address_State => (Regs.Base_Address, GTT.Base_Address),
30 Register_State => Regs.State,
31 GTT_State => GTT.State)
32is
33 pragma Disable_Atomic_Synchronization;
34
35 type Registers_Range is
36 new Natural range 0 .. 16#0020_0000# / Register_Width - 1;
37 type Registers_Type is array (Registers_Range) of Word32
38 with
39 Atomic_Components,
40 Size => 16#20_0000# * 8;
41 package Regs is new MMIO_Range
42 (Base_Addr => Config.Default_MMIO_Base,
43 Element_T => Word32,
44 Index_T => Registers_Range,
45 Array_T => Registers_Type);
46
47 ----------------------------------------------------------------------------
48
49 GTT_Offset : constant := (case Config.CPU is
50 when Ironlake .. Haswell => 16#0020_0000#,
51 when Broadwell .. Skylake => 16#0080_0000#);
52
53 GTT_Size : constant := (case Config.CPU is
54 when Ironlake .. Haswell => 16#0020_0000#,
55 -- Limit Broadwell to 4MiB to have a stable
56 -- interface (i.e. same number of entries):
57 when Broadwell .. Skylake => 16#0040_0000#);
58
59 GTT_PTE_Size : constant := (case Config.CPU is
60 when Ironlake .. Haswell => 4,
61 when Broadwell .. Skylake => 8);
62
63
64 type GTT_PTE_Type is mod 2 ** (GTT_PTE_Size * 8);
65 type GTT_Registers_Type is array (GTT_Range) of GTT_PTE_Type
66 with
67 Volatile_Components,
68 Size => GTT_Size * 8;
69 package GTT is new MMIO_Range
70 (Base_Addr => Config.Default_MMIO_Base + GTT_Offset,
71 Element_T => GTT_PTE_Type,
72 Index_T => GTT_Range,
73 Array_T => GTT_Registers_Type);
74
75 GTT_PTE_Valid : constant Word32 := 1;
76
77 ----------------------------------------------------------------------------
78
79 procedure Write_GTT
80 (GTT_Page : GTT_Range;
81 Device_Address : GTT_Address_Type;
82 Valid : Boolean)
83 is
84 begin
85 if Config.Fold_39Bit_GTT_PTE then
86 GTT.Write
87 (Index => GTT_Page,
88 Value => GTT_PTE_Type (Device_Address and 16#ffff_f000#) or
89 GTT_PTE_Type (Shift_Right (Word64 (Device_Address), 32 - 4)
90 and 16#0000_07f0#) or
91 Boolean'Pos (Valid));
92 else
93 GTT.Write
94 (Index => GTT_Page,
95 Value => GTT_PTE_Type (Device_Address and 16#7f_ffff_f000#) or
96 Boolean'Pos (Valid));
97 end if;
98 end Write_GTT;
99
100 ----------------------------------------------------------------------------
101
102 package Rep is
103 function Index (Reg : Registers_Index) return Registers_Range;
104 end Rep;
105
106 package body Rep is
107 function Index (Reg : Registers_Index) return Registers_Range
108 with
109 SPARK_Mode => Off
110 is
111 begin
112 return Reg'Enum_Rep;
113 end Index;
114 end Rep;
115
116 -- Read a specific register
117 procedure Read
118 (Register : in Registers_Index;
119 Value : out Word32;
120 Verbose : in Boolean := True)
121 is
122 begin
123 Regs.Read (Value, Rep.Index (Register));
124
125 pragma Debug (Verbose, Debug.Put (GNAT.Source_Info.Enclosing_Entity & ": "));
126 pragma Debug (Verbose, Debug.Put_Word32 (Value));
127 pragma Debug (Verbose, Debug.Put (" <- "));
128 pragma Debug (Verbose, Debug.Put_Word32 (Register'Enum_Rep * Register_Width));
129 pragma Debug (Verbose, Debug.Put (":"));
130 pragma Debug (Verbose, Debug.Put_Line (Registers_Index'Image (Register)));
131 end Read;
132
133 ----------------------------------------------------------------------------
134
135 -- Read a specific register to post a previous write
136 procedure Posting_Read (Register : Registers_Index)
137 is
138 Discard_Value : Word32;
139 begin
140 pragma Warnings
141 (Off, "unused assignment to ""Discard_Value""",
142 Reason => "Intentional dummy read to affect hardware.");
143
144 Read (Register, Discard_Value);
145
146 pragma Warnings
147 (On, "unused assignment to ""Discard_Value""");
148 end Posting_Read;
149
150 ----------------------------------------------------------------------------
151
152 -- Write a specific register
153 procedure Write (Register : Registers_Index; Value : Word32)
154 is
155 begin
156 pragma Debug (Debug.Put (GNAT.Source_Info.Enclosing_Entity & ": "));
157 pragma Debug (Debug.Put_Word32 (Value));
158 pragma Debug (Debug.Put (" -> "));
159 pragma Debug (Debug.Put_Word32 (Register'Enum_Rep * Register_Width));
160 pragma Debug (Debug.Put (":"));
161 pragma Debug (Debug.Put_Line (Registers_Index'Image (Register)));
162
163 Regs.Write (Rep.Index (Register), Value);
164 pragma Debug (Debug.Register_Write_Wait);
165 end Write;
166
167 ----------------------------------------------------------------------------
168
169 -- Check whether all bits in @Register@ indicated by @Mask@ are set
170 procedure Is_Set_Mask
171 (Register : in Registers_Index;
172 Mask : in Word32;
173 Result : out Boolean)
174 is
175 Value : Word32;
176 begin
177 pragma Debug (Debug.Put (GNAT.Source_Info.Enclosing_Entity & ": "));
178 pragma Debug (Debug.Put_Line (Registers_Index'Image (Register)));
179
180 Read (Register, Value);
181 Result := (Value and Mask) = Mask;
182
183 end Is_Set_Mask;
184
185 ----------------------------------------------------------------------------
186
187 -- TODO: Should have Success parameter
188 -- Wait for all bits in @Register@ indicated by @Mask@ to be set
189 procedure Wait_Set_Mask
190 (Register : in Registers_Index;
191 Mask : in Word32;
192 TOut_MS : in Natural := Default_Timeout_MS;
193 Verbose : in Boolean := False)
194 is
195 Value : Word32;
196 Timeout : Time.T;
197 Timed_Out : Boolean;
198 begin
199 pragma Debug (Debug.Put (GNAT.Source_Info.Enclosing_Entity & ": "));
200 pragma Debug (Debug.Put_Line (Registers_Index'Image (Register)));
201
202 Timeout := Time.MS_From_Now (TOut_MS);
203 loop
204 Timed_Out := Time.Timed_Out (Timeout);
205 Read (Register, Value, Verbose);
206 if (Value and Mask) = Mask then
207 exit;
208 end if;
209 pragma Debug (Timed_Out, Debug.Put (GNAT.Source_Info.Enclosing_Entity));
210 pragma Debug (Timed_Out, Debug.Put_Line (": Timed Out!"));
211 exit when Timed_Out;
212 end loop;
213
214 end Wait_Set_Mask;
215
216 ----------------------------------------------------------------------------
217
218 -- TODO: Should have Success parameter
219 -- Wait for bits in @Register@ indicated by @Mask@ to be clear
220 procedure Wait_Unset_Mask
221 (Register : Registers_Index;
222 Mask : Word32;
223 TOut_MS : in Natural := Default_Timeout_MS;
224 Verbose : in Boolean := False)
225 is
226 Value : Word32;
227 Timeout : Time.T;
228 Timed_Out : Boolean;
229 begin
230 pragma Debug (Debug.Put (GNAT.Source_Info.Enclosing_Entity & ": "));
231 pragma Debug (Debug.Put_Line (Registers_Index'Image (Register)));
232
233 Timeout := Time.MS_From_Now (TOut_MS);
234 loop
235 Timed_Out := Time.Timed_Out (Timeout);
236 Read (Register, Value, Verbose);
237 if (Value and Mask) = 0 then
238 exit;
239 end if;
240 pragma Debug (Timed_Out, Debug.Put (GNAT.Source_Info.Enclosing_Entity));
241 pragma Debug (Timed_Out, Debug.Put_Line (": Timed Out!"));
242 exit when Timed_Out;
243 end loop;
244
245 end Wait_Unset_Mask;
246
247 ----------------------------------------------------------------------------
248
249 -- Set bits from @Mask@ in @Register@
250 procedure Set_Mask
251 (Register : Registers_Index;
252 Mask : Word32)
253 is
254 Value : Word32;
255 begin
256 pragma Debug (Debug.Put (GNAT.Source_Info.Enclosing_Entity & ": "));
257 pragma Debug (Debug.Put_Word32 (Mask));
258 pragma Debug (Debug.Put (" .S "));
259 pragma Debug (Debug.Put_Line (Registers_Index'Image (Register)));
260
261 Read (Register, Value);
262 Value := Value or Mask;
263 Write (Register, Value);
264 end Set_Mask;
265
266 ----------------------------------------------------------------------------
267
268 -- Mask out @Mask@ in @Register@
269 procedure Unset_Mask
270 (Register : Registers_Index;
271 Mask : Word32)
272 is
273 Value : Word32;
274 begin
275 pragma Debug (Debug.Put (GNAT.Source_Info.Enclosing_Entity & ": "));
276 pragma Debug (Debug.Put_Word32 (Mask));
277 pragma Debug (Debug.Put (" !S "));
278 pragma Debug (Debug.Put_Line (Registers_Index'Image (Register)));
279
280 Read (Register, Value);
281 Value := Value and not Mask;
282 Write (Register, Value);
283 end Unset_Mask;
284
285 ----------------------------------------------------------------------------
286
287 -- Mask out @Unset_Mask@ and set @Set_Mask@ in @Register@
288 procedure Unset_And_Set_Mask
289 (Register : Registers_Index;
290 Mask_Unset : Word32;
291 Mask_Set : Word32)
292 is
293 Value : Word32;
294 begin
295 pragma Debug (Debug.Put (GNAT.Source_Info.Enclosing_Entity & ": "));
296 pragma Debug (Debug.Put_Line (Registers_Index'Image (Register)));
297
298 Read (Register, Value);
299 Value := (Value and not Mask_Unset) or Mask_Set;
300 Write (Register, Value);
301 end Unset_And_Set_Mask;
302
303 ----------------------------------------------------------------------------
304
305 procedure Set_Register_Base (Base : Word64)
306 is
307 begin
308 Regs.Set_Base_Address (Base);
309 GTT.Set_Base_Address (Base + GTT_Offset);
310 end Set_Register_Base;
311
312end HW.GFX.GMA.Registers;