fe41a89df63e4bfc2463549c89035e140698f361
[libxhcidbg.git] / src / hw-dbc-transfer_info.adb
1 --
2 -- Copyright (C) 2016-2017 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; either version 2 of the License, or
7 -- (at your option) any later version.
8 --
9 -- This program is distributed in the hope that it will be useful,
10 -- but WITHOUT ANY WARRANTY; without even the implied warranty of
11 -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12 -- GNU General Public License for more details.
13 --
14
15 with HW.Debug;
16 with HW.DbC.DMA_Buffers;
17
18 package body HW.DbC.Transfer_Info
19 with
20    Refined_State => (State => (Start_Counter, Stats, Xfers))
21 is
22
23    Start_Counter : Word64 := 0;  -- Should not overflow
24
25    type Xfer_Info is record
26       Endpoint : Endpoint_Range;
27       Token    : Word64;
28       Offset   : Natural;
29       Length   : Natural;
30       Status   : Error;
31       Started  : Boolean;
32       Finished : Boolean;
33    end record;
34
35    type Xfer_Array is array (Transfer_Id) of Xfer_Info;
36
37    Xfers : Xfer_Array := Xfer_Array'
38      (Transfer_Id => Xfer_Info'
39         (Endpoint => Endpoint_Range'First,
40          Token    => 16#0000_0000_0000_0000#,
41          Offset   => 0,
42          Length   => 0,
43          Status   => Error'First,
44          Started  => False,
45          Finished => False));
46
47    type Stats_Info is record
48       Enqueued    : Word32;
49       Transfered  : Word32;
50       Lost        : Word32;
51    end record;
52    type Stats_Array is array (Endpoint_Range) of Stats_Info;
53    Stats : Stats_Array := (Endpoint_Range => (others => 0));
54
55    ----------------------------------------------------------------------------
56
57    function Get_Endpoint (Id : Transfer_Id) return Endpoint_Range
58    is
59    begin
60       return Xfers (Id).Endpoint;
61    end Get_Endpoint;
62
63    function Get_Offset (Id : Transfer_Id) return Natural
64    is
65    begin
66       return Xfers (Id).Offset;
67    end Get_Offset;
68
69    procedure Set_Offset (Id : Transfer_Id; Offset : Natural)
70    is
71    begin
72       Xfers (Id).Offset := Offset;
73    end Set_Offset;
74
75    function Get_Length (Id : Transfer_Id) return Natural
76    is
77    begin
78       return Xfers (Id).Length;
79    end Get_Length;
80
81    function Get_Status (Id : Transfer_Id) return Error
82    is
83    begin
84       return Xfers (Id).Status;
85    end Get_Status;
86
87    function Physical (Id : Transfer_Id) return Word64
88    is
89       use type Word64;
90    begin
91       return DMA_Buffers.Base + Word64 (Id) * Max_Bulk_Size;
92    end Physical;
93
94    ----------------------------------------------------------------------------
95
96    procedure Start
97      (Endpoint : in     Endpoint_Range;
98       Length   : in     Natural;
99       Id       :    out Transfer_Id;
100       Success  :    out Boolean)
101    is
102       use type Word32;
103       use type Word64;
104    begin
105       Success := False;
106       Id := Transfer_Id'First;
107       for I in Transfer_Id loop
108          if not Xfers (I).Started then
109             Xfers (I) :=
110               (Endpoint => Endpoint,
111                Token    => Start_Counter,
112                Offset   => 0,
113                Length   => Length,
114                Status   => Error'First,
115                Started  => True,
116                Finished => False);
117             Stats (Endpoint).Enqueued :=
118               Stats (Endpoint).Enqueued + Word32 (Length);
119             Start_Counter := Start_Counter + 1;
120             Success := True;
121             Id := I;
122          end if;
123          exit when Success;
124       end loop;
125    end Start;
126
127    procedure Restart
128      (Id       : Transfer_Id;
129       Length   : Natural)
130    is
131       use type Word32;
132       use type Word64;
133
134       Endpoint : constant Endpoint_Range := Xfers (Id).Endpoint;
135    begin
136       Xfers (Id) :=
137         (Endpoint => Endpoint,
138          Token    => Start_Counter,
139          Offset   => 0,
140          Length   => Length,
141          Status   => Error'First,
142          Started  => True,
143          Finished => False);
144       Start_Counter := Start_Counter + 1;
145       Stats (Endpoint).Enqueued
146         := Stats (Endpoint).Enqueued + Word32 (Length);
147    end Restart;
148
149    procedure Append
150      (Endpoint : in     Endpoint_Range;
151       Length   : in out Natural;
152       Offset   :    out Natural;
153       Id       :    out Transfer_Id)
154    is
155       use type Word32;
156       use type Word64;
157       Success : Boolean;
158       Max_Counter : Word64;
159    begin
160       Success := False;
161       Max_Counter := 0;
162       Id := Transfer_Id'First;
163       for I in Transfer_Id loop
164          if Xfers (I).Started and
165             Xfers (I).Endpoint = Endpoint and
166             Xfers (I).Token >= Max_Counter
167          then
168             Max_Counter := Xfers (I).Token;
169             Success := True;
170             Id := I;
171          end if;
172       end loop;
173       if Success then
174          Length := Natural'Min (Length, Max_Bulk_Size - Xfers (Id).Length);
175          Offset := Xfers (Id).Length;
176          Xfers (Id).Length := Xfers (Id).Length + Length;
177          Stats (Endpoint).Enqueued
178            := Stats (Endpoint).Enqueued + Word32 (Length);
179       else
180          Length := 0;
181          Offset := 0;
182       end if;
183    end Append;
184
185    procedure Finish
186      (DMA_Physical      : Word64;
187       Remaining_Length  : Natural;
188       Status            : Error)
189    is
190       use type Word32;
191       use type Word64;
192       Id : Transfer_Id;
193    begin
194       if Physical (Transfer_Id'First) <= DMA_Physical and
195          DMA_Physical <= Physical (Transfer_Id'Last) and
196          (DMA_Physical - Physical (Transfer_Id'First)) mod Max_Bulk_Size = 0
197       then
198          Id := Transfer_Id
199            ((DMA_Physical - Physical (Transfer_Id'First)) / Max_Bulk_Size);
200          if Xfers (Id).Started then
201             Xfers (Id).Finished := True;
202             Xfers (Id).Status := Status;
203             Xfers (Id).Offset := 0;
204             if Remaining_Length <= Xfers (Id).Length then
205                Xfers (Id).Length := Xfers (Id).Length - Remaining_Length;
206                Stats (Xfers (Id).Endpoint).Transfered :=
207                  Stats (Xfers (Id).Endpoint).Transfered + Word32
208                    (Xfers (Id).Length);
209                Stats (Xfers (Id).Endpoint).Lost :=
210                  Stats (Xfers (Id).Endpoint).Lost + Word32 (Remaining_Length);
211             else
212                Stats (Xfers (Id).Endpoint).Lost :=
213                  Stats (Xfers (Id).Endpoint).Lost + Word32 (Xfers (Id).Length);
214                Xfers (Id).Length := 0;
215                Xfers (Id).Status := Controller_Error;
216             end if;
217          else
218             pragma Debug (Debug.Put_Reg8
219               ("Spurious finish for transfer", Word8 (Id)));
220             null;
221          end if;
222       else
223          pragma Debug (Debug.Put_Reg64
224            ("WARNING: Invalid DMA pointer", DMA_Physical));
225          pragma Debug (Debug.Put_Reg64
226            ("           first DMA address", Physical (Transfer_Id'First)));
227          pragma Debug (Debug.Put_Reg64
228            ("            last DMA address", Physical (Transfer_Id'Last)));
229          null;
230       end if;
231    end Finish;
232
233    procedure Reset (Id : Transfer_Id)
234    is
235    begin
236       Xfers (Id).Started := False;
237    end Reset;
238
239    ----------------------------------------------------------------------------
240
241    generic
242       with function Check (Id : Transfer_Id) return Boolean;
243    procedure Walk
244      (Minimum_Ctr : in out Word64;
245       Id          :    out Transfer_Id;
246       Success     :    out Boolean);
247
248    procedure Walk
249      (Minimum_Ctr : in out Word64;
250       Id          :    out Transfer_Id;
251       Success     :    out Boolean)
252    is
253       use type Word64;
254    begin
255       Success := False;
256       Id := Transfer_Id'First;
257       for I in Transfer_Id loop
258          if Check (I) and Xfers (I).Token >= Minimum_Ctr then
259             if (Success and Xfers (I).Token < Xfers (Id).Token) or
260                not Success
261             then
262                Id := I;
263                Success := True;
264             end if;
265          end if;
266       end loop;
267       if Success then
268          Minimum_Ctr := Xfers (Id).Token + 1;
269       end if;
270    end Walk;
271
272    function Check_Started (Id : Transfer_Id) return Boolean
273    is
274    begin
275       return Xfers (Id).Started and not Xfers (Id).Finished;
276    end Check_Started;
277    procedure Walk_Started_Inst is new Walk (Check_Started);
278    procedure Walk_Started
279      (Minimum_Ctr : in out Word64;
280       Id          :    out Transfer_Id;
281       Success     :    out Boolean)
282       renames Walk_Started_Inst;
283
284    procedure Walk_Finished
285      (Endpoint    : in     Endpoint_Range;
286       Minimum_Ctr : in out Word64;
287       Id          :    out Transfer_Id;
288       Success     :    out Boolean)
289    is
290       function Check_Finished (Id : Transfer_Id) return Boolean;
291       function Check_Finished (Id : Transfer_Id) return Boolean
292       is
293       begin
294          return
295             Xfers (Id).Endpoint = Endpoint and
296             Xfers (Id).Started and
297             Xfers (Id).Finished;
298       end Check_Finished;
299
300       procedure Walk_Finished_Inst is new Walk (Check_Finished);
301    begin
302       Walk_Finished_Inst (Minimum_Ctr, Id, Success);
303    end Walk_Finished;
304
305    ----------------------------------------------------------------------------
306
307    procedure Dump_Stats
308    is
309       use type Word32;
310    begin
311       Debug.Put_Line ("DbC statistics:");
312       for EP in Endpoint_Range loop
313          Debug.Put ("  Endpoint #");
314          Debug.Put_Int8 (Int8 (EP));
315          Debug.New_Line;
316          Debug.Put ("      enqueued: ");
317          Debug.Put_Word32 (Stats (EP).Enqueued);
318          Debug.Put (" (");
319          Debug.Put_Int32 (Int32 (Stats (EP).Enqueued));
320          Debug.Put_Line (")");
321          Debug.Put ("    transfered: ");
322          Debug.Put_Word32 (Stats (EP).Transfered);
323          Debug.Put (" (");
324          Debug.Put_Int32 (Int32 (Stats (EP).Transfered));
325          Debug.Put_Line (")");
326          Debug.Put ("          lost: ");
327          Debug.Put_Word32 (Stats (EP).Lost);
328          Debug.Put (" (");
329          Debug.Put_Int32 (Int32 (Stats (EP).Lost));
330          Debug.Put_Line (")");
331          Debug.Put ("      in queue: ");
332          Debug.Put_Word32
333            (Stats (EP).Enqueued - Stats (EP).Transfered - Stats (EP).Lost);
334          Debug.Put (" (");
335          Debug.Put_Int32 (Int32
336            (Stats (EP).Enqueued - Stats (EP).Transfered - Stats (EP).Lost));
337          Debug.Put_Line (")");
338       end loop;
339    end Dump_Stats;
340
341 end HW.DbC.Transfer_Info;
342
343 --  vim: set ts=8 sts=3 sw=3 et: