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: