Simplify Walk_Finished procedure
[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    : Natural;
49       Transfered  : Natural;
50       Lost        : Natural;
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 Word64;
103    begin
104       Success := False;
105       Id := Transfer_Id'First;
106       for I in Transfer_Id loop
107          if not Xfers (I).Started then
108             Xfers (I) :=
109               (Endpoint => Endpoint,
110                Token    => Start_Counter,
111                Offset   => 0,
112                Length   => Length,
113                Status   => Error'First,
114                Started  => True,
115                Finished => False);
116             Stats (Endpoint).Enqueued := Stats (Endpoint).Enqueued + Length;
117             Start_Counter := Start_Counter + 1;
118             Success := True;
119             Id := I;
120          end if;
121          exit when Success;
122       end loop;
123    end Start;
124
125    procedure Restart
126      (Id       : Transfer_Id;
127       Length   : Natural)
128    is
129       use type Word64;
130
131       Endpoint : constant Endpoint_Range := Xfers (Id).Endpoint;
132    begin
133       Xfers (Id) :=
134         (Endpoint => Endpoint,
135          Token    => Start_Counter,
136          Offset   => 0,
137          Length   => Length,
138          Status   => Error'First,
139          Started  => True,
140          Finished => False);
141       Start_Counter := Start_Counter + 1;
142       Stats (Endpoint).Enqueued := Stats (Endpoint).Enqueued + Length;
143    end Restart;
144
145    procedure Append
146      (Endpoint : in     Endpoint_Range;
147       Length   : in out Natural;
148       Offset   :    out Natural;
149       Id       :    out Transfer_Id)
150    is
151       use type Word64;
152       Success : Boolean;
153       Max_Counter : Word64;
154    begin
155       Success := False;
156       Max_Counter := 0;
157       Id := Transfer_Id'First;
158       for I in Transfer_Id loop
159          if Xfers (I).Started and
160             Xfers (I).Endpoint = Endpoint and
161             Xfers (I).Token >= Max_Counter
162          then
163             Max_Counter := Xfers (I).Token;
164             Success := True;
165             Id := I;
166          end if;
167       end loop;
168       if Success then
169          Length := Natural'Min (Length, Max_Bulk_Size - Xfers (Id).Length);
170          Offset := Xfers (Id).Length;
171          Xfers (Id).Length := Xfers (Id).Length + Length;
172          Stats (Endpoint).Enqueued := Stats (Endpoint).Enqueued + Length;
173       else
174          Length := 0;
175          Offset := 0;
176       end if;
177    end Append;
178
179    procedure Finish
180      (DMA_Physical      : Word64;
181       Remaining_Length  : Natural;
182       Status            : Error)
183    is
184       use type Word64;
185       Id : Transfer_Id;
186    begin
187       if Physical (Transfer_Id'First) <= DMA_Physical and
188          DMA_Physical <= Physical (Transfer_Id'Last) and
189          (DMA_Physical - Physical (Transfer_Id'First)) mod Max_Bulk_Size = 0
190       then
191          Id := Transfer_Id
192            ((DMA_Physical - Physical (Transfer_Id'First)) / Max_Bulk_Size);
193          if Xfers (Id).Started then
194             Xfers (Id).Finished := True;
195             Xfers (Id).Status := Status;
196             Xfers (Id).Offset := 0;
197             if Remaining_Length <= Xfers (Id).Length then
198                Xfers (Id).Length := Xfers (Id).Length - Remaining_Length;
199                Stats (Xfers (Id).Endpoint).Transfered :=
200                   Stats (Xfers (Id).Endpoint).Transfered + Xfers (Id).Length;
201                Stats (Xfers (Id).Endpoint).Lost :=
202                   Stats (Xfers (Id).Endpoint).Lost + Remaining_Length;
203             else
204                Stats (Xfers (Id).Endpoint).Lost :=
205                   Stats (Xfers (Id).Endpoint).Lost + Xfers (Id).Length;
206                Xfers (Id).Length := 0;
207                Xfers (Id).Status := Controller_Error;
208             end if;
209          else
210             pragma Debug (Debug.Put_Reg8
211               ("Spurious finish for transfer", Word8 (Id)));
212             null;
213          end if;
214       else
215          pragma Debug (Debug.Put_Reg64
216            ("WARNING: Invalid DMA pointer", DMA_Physical));
217          pragma Debug (Debug.Put_Reg64
218            ("           first DMA address", Physical (Transfer_Id'First)));
219          pragma Debug (Debug.Put_Reg64
220            ("            last DMA address", Physical (Transfer_Id'Last)));
221          null;
222       end if;
223    end Finish;
224
225    procedure Reset (Id : Transfer_Id)
226    is
227    begin
228       Xfers (Id).Started := False;
229    end Reset;
230
231    ----------------------------------------------------------------------------
232
233    generic
234       with function Check (Id : Transfer_Id) return Boolean;
235    procedure Walk
236      (Minimum_Ctr : in out Word64;
237       Id          :    out Transfer_Id;
238       Success     :    out Boolean);
239
240    procedure Walk
241      (Minimum_Ctr : in out Word64;
242       Id          :    out Transfer_Id;
243       Success     :    out Boolean)
244    is
245       use type Word64;
246    begin
247       Success := False;
248       Id := Transfer_Id'First;
249       for I in Transfer_Id loop
250          if Check (I) and Xfers (I).Token >= Minimum_Ctr then
251             if (Success and Xfers (I).Token < Xfers (Id).Token) or
252                not Success
253             then
254                Id := I;
255                Success := True;
256             end if;
257          end if;
258       end loop;
259       if Success then
260          Minimum_Ctr := Xfers (Id).Token + 1;
261       end if;
262    end Walk;
263
264    function Check_Started (Id : Transfer_Id) return Boolean
265    is
266    begin
267       return Xfers (Id).Started and not Xfers (Id).Finished;
268    end Check_Started;
269    procedure Walk_Started_Inst is new Walk (Check_Started);
270    procedure Walk_Started
271      (Minimum_Ctr : in out Word64;
272       Id          :    out Transfer_Id;
273       Success     :    out Boolean)
274       renames Walk_Started_Inst;
275
276    procedure Walk_Finished
277      (Endpoint    : in     Endpoint_Range;
278       Minimum_Ctr : in out Word64;
279       Id          :    out Transfer_Id;
280       Success     :    out Boolean)
281    is
282       function Check_Finished (Id : Transfer_Id) return Boolean;
283       function Check_Finished (Id : Transfer_Id) return Boolean
284       is
285       begin
286          return
287             Xfers (Id).Endpoint = Endpoint and
288             Xfers (Id).Started and
289             Xfers (Id).Finished;
290       end Check_Finished;
291
292       procedure Walk_Finished_Inst is new Walk (Check_Finished);
293    begin
294       Walk_Finished_Inst (Minimum_Ctr, Id, Success);
295    end Walk_Finished;
296
297    ----------------------------------------------------------------------------
298
299    procedure Dump_Stats
300    is
301    begin
302       Debug.Put_Line ("DbC statistics:");
303       for EP in Endpoint_Range loop
304          Debug.Put ("  Endpoint #");
305          Debug.Put_Int8 (Int8 (EP));
306          Debug.New_Line;
307          Debug.Put ("      enqueued: ");
308          Debug.Put_Word32 (Word32 (Stats (EP).Enqueued));
309          Debug.Put (" (");
310          Debug.Put_Int32 (Int32 (Stats (EP).Enqueued));
311          Debug.Put_Line (")");
312          Debug.Put ("    transfered: ");
313          Debug.Put_Word32 (Word32 (Stats (EP).Transfered));
314          Debug.Put (" (");
315          Debug.Put_Int32 (Int32 (Stats (EP).Transfered));
316          Debug.Put_Line (")");
317          Debug.Put ("          lost: ");
318          Debug.Put_Word32 (Word32 (Stats (EP).Lost));
319          Debug.Put (" (");
320          Debug.Put_Int32 (Int32 (Stats (EP).Lost));
321          Debug.Put_Line (")");
322          Debug.Put ("      in queue: ");
323          Debug.Put_Word32 (Word32
324            (Stats (EP).Enqueued - Stats (EP).Transfered - Stats (EP).Lost));
325          Debug.Put (" (");
326          Debug.Put_Int32 (Int32
327            (Stats (EP).Enqueued - Stats (EP).Transfered - Stats (EP).Lost));
328          Debug.Put_Line (")");
329       end loop;
330    end Dump_Stats;
331
332 end HW.DbC.Transfer_Info;
333
334 --  vim: set ts=8 sts=3 sw=3 et: