Fix SPARK warning regarding nonvolatile functions
[libxhcidbg.git] / src / hw-dbc-trbs.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.DbC;
16 with HW.Debug;
17
18 use type HW.Bit;
19 use type HW.Word32;
20
21 package body HW.DbC.TRBs
22 is
23
24    Debug_Error_Codes : constant Boolean := False;
25
26    function CC_To_Usb_Error (CC : Completion_Code) return Error
27    is
28       Err : Error;
29    begin
30       case CC is
31       when Success                     => Err := DbC.Success;
32       when Data_Buffer_Error           => Err := DbC.Communication_Error;
33       when Babble_Detected_Error       => Err := DbC.Communication_Error;
34       when USB_Transaction_Error       => Err := DbC.Communication_Error;
35       when TRB_Error                   => Err := DbC.Driver_Error;
36       when Stall_Error                 => Err := DbC.Stall_Error;
37       when Short_Packet                => Err := DbC.Data_Residue;
38       when Bandwidth_Error             => Err := DbC.Not_Enough_Bandwidth;
39       when Command_Aborted             => Err := DbC.Timeout;
40       when Secondary_Bandwidth_Error   => Err := DbC.Not_Enough_Bandwidth;
41       when Split_Transaction_Error     => Err := DbC.Communication_Error;
42       when others                      => Err := DbC.Unknown_Error;
43          pragma Debug (Debug.Put_Reg8 ("Unknown_Error", Word8 (CC)));
44       end case;
45       pragma Debug
46         (Debug_Error_Codes and Err /= DbC.Success and Err /= DbC.Unknown_Error,
47          Debug.Put_Reg8 ("Completion code", Word8 (CC)));
48       return Err;
49    end CC_To_Usb_Error;
50
51    ----------------------------------------------------------------------------
52
53    procedure Set_Length (Data : in out T; Length : in Natural)
54    is
55       Status : constant Word32 := Data.Status;
56    begin
57       Data.Status := (Status and not 16#1_ffff#) or
58         (Word32 (Length) and 16#1_ffff#);
59    end Set_Length;
60
61    procedure Get_Event_Length (Data : in T; Length : out Natural)
62    is
63       Status : constant Word32 := Data.Status;
64    begin
65       Length := Natural (Status and 16#ff_ffff#);
66    end Get_Event_Length;
67
68    ----------------------------------------------------------------------------
69
70    procedure Get_Completion_Code (Data : in T; Code : out Completion_Code)
71    is
72       Status : constant Word32 := Data.Status;
73    begin
74       Code := Completion_Code (Shift_Right (Status, 24));
75    end Get_Completion_Code;
76
77    ----------------------------------------------------------------------------
78
79    procedure Set_Cycle (Data : in out T; Cycle : in Bit)
80    is
81       Control : constant Word32 := Data.Control;
82    begin
83       Data.Control := (Control and not 1) or Word32 (Cycle);
84    end Set_Cycle;
85
86    procedure Get_Cycle (Data : in T; Cycle : out Bit)
87    is
88       Control : constant Word32 := Data.Control;
89    begin
90       Cycle := Bit (Control and 1);
91    end Get_Cycle;
92
93    procedure Set_Toggle_Cycle (Data : in out T)
94    is
95       Control : constant Word32 := Data.Control;
96    begin
97       Data.Control := Control or 16#00_02#;
98    end Set_Toggle_Cycle;
99
100    procedure Set_ISP (Data : in out T)
101    is
102       Control : constant Word32 := Data.Control;
103    begin
104       Data.Control := Control or 16#00_04#;
105    end Set_ISP;
106
107    procedure Set_IOC (Data : in out T)
108    is
109       Control : constant Word32 := Data.Control;
110    begin
111       Data.Control := Control or 16#00_20#;
112    end Set_IOC;
113
114    ----------------------------------------------------------------------------
115
116    procedure Set_Type (Data : in out T; TRB_Type : in TRB_Types)
117    is
118       Control : constant Word32 := Data.Control;
119    begin
120       Data.Control := (Control and not 16#fc00#) or
121         Shift_Left (Word32 (TRB_Type), 10);
122    end Set_Type;
123
124    procedure Get_Type (Data : in T; TRB_Type : out TRB_Types)
125    is
126       Control : constant Word32 := Data.Control;
127    begin
128       TRB_Type := TRB_Types (Shift_Right (Control, 10) and 63);
129    end Get_Type;
130
131    ----------------------------------------------------------------------------
132
133    procedure Get_Endpoint_ID (Data : in T; Endpoint_ID : out Natural)
134    is
135       Control : constant Word32 := Data.Control;
136    begin
137       Endpoint_ID := Natural (Shift_Right (Control, 16) and 16#1f#);
138    end Get_Endpoint_ID;
139
140    procedure Get_Slot_ID (Data : in T; Slot_ID : out Word8)
141    is
142       Control : constant Word32 := Data.Control;
143    begin
144       Slot_ID := Word8 (Shift_Right (Control, 24));
145    end Get_Slot_ID;
146
147    ----------------------------------------------------------------------------
148
149    procedure Set_Parameter (Data : in out T; Parameter : Word64)
150    is
151    begin
152       Data.Parameter := Parameter;
153    end Set_Parameter;
154
155    procedure Get_Parameter (Data : in T; Parameter : out Word64)
156    is
157    begin
158       Parameter := Data.Parameter;
159    end Get_Parameter;
160
161    ----------------------------------------------------------------------------
162
163    procedure Clear (TR : out T; PCS : in Bit)
164    is
165    begin
166       TR := T'
167         (Parameter => 0, Status => 0, Control => Word32 ((not PCS) and 1));
168    end Clear;
169
170    procedure Clear_Ring (TR : out Transfer_Ring; PCS : in Bit)
171    is
172    begin
173       TR := Transfer_Ring'
174         (Ring_Range => T'
175            (Parameter => 0, Status => 0, Control => Word32 ((not PCS) and 1)));
176    end Clear_Ring;
177
178    procedure Init_Cycle_Ring
179      (Ring     :    out Transfer_Ring;
180       Physical : in     Word64)
181    is
182    begin
183       Clear_Ring (Ring, 1);
184
185       declare
186          Last : constant Ring_Range := Ring'Last;
187       begin
188
189          -- Link last T in the ring to the first.
190
191          Set_Type (Ring (Last), Link);
192          Set_Toggle_Cycle (Ring (Last));
193          Ring (Last).Parameter := Physical;
194       end;
195    end Init_Cycle_Ring;
196
197 end HW.DbC.TRBs;
198
199 --  vim: set ts=8 sts=3 sw=3 et: