Initial upstream commit
The history contained unlicensed code so everything got squashed, sorry.
Change-Id: Ie1335ecfcee7f740bb6de2e9887606be30a2deff
Signed-off-by: Nico Huber <nico.huber@secunet.com>
diff --git a/debug/hw-debug.adb b/debug/hw-debug.adb
new file mode 100644
index 0000000..3ffa9b5
--- /dev/null
+++ b/debug/hw-debug.adb
@@ -0,0 +1,284 @@
+--
+-- Copyright (C) 2015 secunet Security Networks AG
+--
+-- This program is free software; you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation; version 2 of the License.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU General Public License for more details.
+--
+
+with HW;
+with HW.Time;
+with HW.Debug_Sink;
+
+use type HW.Word64;
+use type HW.Int64;
+
+package body HW.Debug
+with
+ SPARK_Mode => Off
+is
+
+ Start_Of_Line : Boolean := True;
+ Register_Write_Delay_Nanoseconds : Word64 := 0;
+
+ type Base_Range is new Positive range 2 .. 16;
+ type Width_Range is new Natural range 0 .. 64;
+
+ procedure Put_By_Base
+ (Item : Word64;
+ Min_Width : Width_Range;
+ Base : Base_Range);
+
+ procedure Do_Put_Int64
+ (Item : Int64);
+
+ ----------------------------------------------------------------------------
+
+ procedure Put_Time
+ is
+ Now_US : Int64;
+ begin
+ if Start_Of_Line then
+ Start_Of_Line := False;
+ Now_US := Time.Now_US;
+ Debug_Sink.Put_Char ('[');
+ Do_Put_Int64 ((Now_US / 1_000_000) mod 1_000_000);
+ Debug_Sink.Put_Char ('.');
+ Put_By_Base (Word64 (Now_US mod 1_000_000), 6, 10);
+ Debug_Sink.Put ("] ");
+ end if;
+ end Put_Time;
+
+ ----------------------------------------------------------------------------
+
+ procedure Put (Item : String) is
+ begin
+ Put_Time;
+ HW.Debug_Sink.Put (Item);
+ end Put;
+
+ procedure Put_Line (Item : String) is
+ begin
+ Put (Item);
+ New_Line;
+ end Put_Line;
+
+ procedure New_Line is
+ begin
+ HW.Debug_Sink.New_Line;
+ Start_Of_Line := True;
+ end New_Line;
+
+ ----------------------------------------------------------------------------
+
+ procedure Put_By_Base
+ (Item : Word64;
+ Min_Width : Width_Range;
+ Base : Base_Range)
+ is
+ Temp : Word64 := Item;
+
+ subtype Chars_Range is Width_Range range 0 .. 63;
+ Index : Width_Range := 0;
+
+ type Chars_Array is array (Chars_Range) of Character;
+ Chars : Chars_Array := (others => '0');
+
+ Digit : Natural;
+ begin
+ while Temp > 0 loop
+ Digit := Natural (Temp rem Word64 (Base));
+ if Digit < 10 then
+ Chars (Index) := Character'Val (Character'Pos ('0') + Digit);
+ else
+ Chars (Index) := Character'Val (Character'Pos ('a') + Digit - 10);
+ end if;
+ Temp := Temp / Word64 (Base);
+ Index := Index + 1;
+ end loop;
+ if Index < Min_Width then
+ Index := Min_Width;
+ end if;
+ for I in reverse Width_Range range 0 .. Index - 1 loop
+ HW.Debug_Sink.Put_Char (Chars (I));
+ end loop;
+ end Put_By_Base;
+
+ ----------------------------------------------------------------------------
+
+ procedure Put_Word
+ (Item : Word64;
+ Min_Width : Width_Range;
+ Print_Ox : Boolean := True) is
+ begin
+ Put_Time;
+ if Print_Ox then
+ Put ("0x");
+ end if;
+ Put_By_Base (Item, Min_Width, 16);
+ end Put_Word;
+
+ procedure Put_Word8 (Item : Word8) is
+ begin
+ Put_Word (Word64 (Item), 2);
+ end Put_Word8;
+
+ procedure Put_Word16 (Item : Word16) is
+ begin
+ Put_Word (Word64 (Item), 4);
+ end Put_Word16;
+
+ procedure Put_Word32 (Item : Word32) is
+ begin
+ Put_Word (Word64 (Item), 8);
+ end Put_Word32;
+
+ procedure Put_Word64 (Item : Word64) is
+ begin
+ Put_Word (Item, 16);
+ end Put_Word64;
+
+ ----------------------------------------------------------------------------
+
+ procedure Do_Put_Int64 (Item : Int64)
+ is
+ Temp : Word64;
+ begin
+ if Item < 0 then
+ Debug_Sink.Put_Char ('-');
+ Temp := Word64 (-Item);
+ else
+ Temp := Word64 (Item);
+ end if;
+ Put_By_Base (Temp, 1, 10);
+ end Do_Put_Int64;
+
+ procedure Put_Int64 (Item : Int64)
+ is
+ begin
+ Put_Time;
+ Do_Put_Int64 (Item);
+ end Put_Int64;
+
+ procedure Put_Int8 (Item : Int8) is
+ begin
+ Put_Int64 (Int64 (Item));
+ end Put_Int8;
+
+ procedure Put_Int16 (Item : Int16) is
+ begin
+ Put_Int64 (Int64 (Item));
+ end Put_Int16;
+
+ procedure Put_Int32 (Item : Int32) is
+ begin
+ Put_Int64 (Int64 (Item));
+ end Put_Int32;
+
+ ----------------------------------------------------------------------------
+
+ procedure Put_Reg8 (Name : String; Item : Word8) is
+ begin
+ Put (Name);
+ Put (": ");
+ Put_Word8 (Item);
+ New_Line;
+ end Put_Reg8;
+
+ procedure Put_Reg16 (Name : String; Item : Word16)
+ is
+ begin
+ Put (Name);
+ Put (": ");
+ Put_Word16 (Item);
+ New_Line;
+ end Put_Reg16;
+
+ procedure Put_Reg32 (Name : String; Item : Word32)
+ is
+ begin
+ Put (Name);
+ Put (": ");
+ Put_Word32 (Item);
+ New_Line;
+ end Put_Reg32;
+
+ procedure Put_Reg64 (Name : String; Item : Word64)
+ is
+ begin
+ Put (Name);
+ Put (": ");
+ Put_Word64 (Item);
+ New_Line;
+ end Put_Reg64;
+
+ ----------------------------------------------------------------------------
+
+ procedure Put_Buffer
+ (Name : String;
+ Buf : Buffer;
+ Len : Buffer_Range)
+ is
+ Line_Start, Left : Natural;
+ begin
+ if Len = 0 then
+ if Name'Length > 0 then
+ Put (Name);
+ Put_Line ("+0x00:");
+ end if;
+ else
+ Line_Start := 0;
+ Left := Len - 1;
+ for I in Natural range 1 .. ((Len + 15) / 16) loop
+ if Name'Length > 0 then
+ Put (Name);
+ Debug_Sink.Put_Char ('+');
+ Put_Word16 (Word16 (Line_Start));
+ Put (": ");
+ end if;
+ for J in Natural range 0 .. Natural'Min (7, Left)
+ loop
+ Put_Word (Word64 (Buf (Line_Start + J)), 2, False);
+ Debug_Sink.Put_Char (' ');
+ end loop;
+
+ Debug_Sink.Put_Char (' ');
+ for J in Natural range 8 .. Natural'Min (15, Left)
+ loop
+ Put_Word (Word64(Buf (Line_Start + J)), 2, False);
+ Debug_Sink.Put_Char (' ');
+ end loop;
+ New_Line;
+
+ Line_Start := Line_Start + 16;
+ Left := Left - Natural'Min (Left, 16);
+ end loop;
+ end if;
+ end Put_Buffer;
+
+ ----------------------------------------------------------------------------
+
+ procedure Set_Register_Write_Delay (Value : Word64)
+ is
+ begin
+ Register_Write_Delay_Nanoseconds := Value;
+ end Set_Register_Write_Delay;
+
+ ----------------------------------------------------------------------------
+
+ Procedure Register_Write_Wait
+ is
+ begin
+ if Register_Write_Delay_Nanoseconds > 0 then
+ Time.U_Delay (Natural ((Register_Write_Delay_Nanoseconds + 999) / 1000));
+ end if;
+ end Register_Write_Wait;
+
+end HW.Debug;
+
+-- vim: set ts=8 sts=3 sw=3 et: