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    function Get_Event_Length (Data : T) return Natural
  62    is
  63       Status : constant Word32 := Data.Status;
  64    begin
  65       return Natural (Status and 16#ff_ffff#);
  66    end Get_Event_Length;
  67
  68    ----------------------------------------------------------------------------
  69
  70    function Get_Completion_Code (Data : T) return Completion_Code
  71    is
  72       Status : constant Word32 := Data.Status;
  73    begin
  74       return 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    function Get_Cycle (Data : T) return Bit
  87    is
  88       Control : constant Word32 := Data.Control;
  89    begin
  90       return 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    function Get_Type (Data : T) return TRB_Types
 125    is
 126       Control : constant Word32 := Data.Control;
 127    begin
 128       return TRB_Types (Shift_Right (Control, 10) and 63);
 129    end Get_Type;
 130
 131    ----------------------------------------------------------------------------
 132
 133    function Get_Endpoint_ID (Data : T) return Natural
 134    is
 135       Control : constant Word32 := Data.Control;
 136    begin
 137       return Natural (Shift_Right (Control, 16) and 16#1f#);
 138    end Get_Endpoint_ID;
 139
 140    function Get_Slot_ID (Data : T) return Word8
 141    is
 142       Control : constant Word32 := Data.Control;
 143    begin
 144       return 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    function Get_Parameter (Data : T) return Word64
 156    is
 157       Result : constant Word64 := Data.Parameter;
 158    begin
 159       return Result;
 160    end Get_Parameter;
 161
 162    ----------------------------------------------------------------------------
 163
 164    procedure Clear (TR : out T; PCS : in Bit)
 165    is
 166    begin
 167       TR := T'
 168         (Parameter => 0, Status => 0, Control => Word32 ((not PCS) and 1));
 169    end Clear;
 170
 171    procedure Clear_Ring (TR : out Transfer_Ring; PCS : in Bit)
 172    is
 173    begin
 174       TR := Transfer_Ring'
 175         (Ring_Range => T'
 176            (Parameter => 0, Status => 0, Control => Word32 ((not PCS) and 1)));
 177    end Clear_Ring;
 178
 179    procedure Init_Cycle_Ring
 180      (Ring     :    out Transfer_Ring;
 181       Physical : in     Word64)
 182    is
 183    begin
 184       Clear_Ring (Ring, 1);
 185
 186       declare
 187          Last : constant Ring_Range := Ring'Last;
 188       begin
 189
 190          -- Link last T in the ring to the first.
 191
 192          Set_Type (Ring (Last), Link);
 193          Set_Toggle_Cycle (Ring (Last));
 194          Ring (Last).Parameter := Physical;
 195       end;
 196    end Init_Cycle_Ring;
 197
 198 end HW.DbC.TRBs;
 199
 200 --  vim: set ts=8 sts=3 sw=3 et: