Thomas Heijligen has uploaded this change for review.
[WIP] Printf like debugging
Change-Id: I4989761d1b127c67510e50d7ecc657e4b0f475e5
Signed-off-by: Thomas Heijligen <thomas.heijligen@secunet.com>
---
M debug/Makefile.inc
A debug/hw-print.adb
A debug/hw-print.ads
M gnat.adc
4 files changed, 282 insertions(+), 0 deletions(-)
git pull ssh://review.coreboot.org:29418/libhwbase refs/changes/30/37530/1
diff --git a/debug/Makefile.inc b/debug/Makefile.inc
index b636a6f..7528e8c 100644
--- a/debug/Makefile.inc
+++ b/debug/Makefile.inc
@@ -1,4 +1,6 @@
hw-y += hw-debug.ads
hw-y += hw-debug.adb
+hw-y += hw-print.ads
+hw-y += hw-print.adb
hw-$(CONFIG_HWBASE_DEBUG_NULL) += null/hw-debug_sink.ads
hw-$(CONFIG_HWBASE_DEBUG_TEXT_IO) += text_io/hw-debug_sink.ads
diff --git a/debug/hw-print.adb b/debug/hw-print.adb
new file mode 100644
index 0000000..ab9e623
--- /dev/null
+++ b/debug/hw-print.adb
@@ -0,0 +1,269 @@
+with HW;
+with HW.Debug;
+with Interfaces;
+use HW;
+use HW.Debug;
+use Interfaces;
+
+package body HW.Print with
+ SPARK_Mode => On
+is
+
+ type Arg_Conversion is
+ (Arg_Invalid,
+ Arg_Int,
+ Arg_UInt,
+ Arg_Hex,
+ Arg_Char,
+ Arg_String
+ );
+
+ type Arg_Flags is
+ (Arg_Flag_Alternate_Form,
+ Arg_Flag_Padding,
+ Arg_Flag_Left_Adjusted,
+ Arg_Flag_Space,
+ Arg_Flag_Sign
+ );
+
+ type Arg_Flag_List is array (Arg_Flags) of Boolean;
+
+ type Arg_Length is
+ (Arg_Length_Normal,
+ Arg_Length_Long,
+ Arg_Length_Long_Long
+ );
+
+ type Arg_T is record
+ Conversion : Arg_Conversion;
+ Flags : Arg_Flag_List;
+ Length : Arg_Length;
+ Padding : Natural;
+ Position : Integer;
+ end record;
+
+-----------------------------------------------------------------------------------------------
+
+ procedure Parse_And_Put (Format_String : in String; Arg : out Arg_T; Pos : in out Integer) with
+ Pre => Format_String'First <= Format_String'Last and Pos >= Format_String'First and Format_String'Last < Integer'Last
+ is
+
+ function Char_To_UInt (Item : in Character) return Natural with
+ Pre => Item in '0' .. '9'
+ is begin
+ return Character'Pos (Item) - Character'Pos ('0');
+ end Char_To_UInt;
+
+ type State_T is (
+ State_Normal,
+ State_Arg_Flags,
+ State_Arg_Flag_Padding,
+ State_Arg_Modifier,
+ State_Arg_Modifier_Length,
+ State_Arg_Conversion
+ );
+
+ State : State_T := State_Normal;
+
+ begin
+
+ Arg := (Conversion => Arg_Invalid, Flags => (others => false), Length => Arg_Length_Normal, Padding => 0, Position => 0);
+
+ while Pos <= Format_String'Last loop
+ pragma loop_invariant (Pos >= Format_String'First);
+
+ case State is
+ when State_Normal =>
+ case Format_String (Pos) is
+ when '%' =>
+ State := State_Arg_Flags;
+ Arg.Position := Pos;
+ when others =>
+ Put (Format_String (Pos .. Pos));
+ end case;
+
+ when State_Arg_Flags =>
+ case Format_String (Pos) is
+ when '%' =>
+ State := State_Normal;
+ Put ("%");
+ when '#' =>
+ Arg.Flags (Arg_Flag_Alternate_Form) := True;
+ when '0' =>
+ Arg.Flags (Arg_Flag_Padding) := True;
+ when '-' =>
+ Arg.Flags (Arg_Flag_Left_Adjusted) := True;
+ when ' ' =>
+ Arg.Flags (Arg_Flag_Space) := True;
+ when '+' =>
+ Arg.Flags (Arg_Flag_Sign) := True;
+ when others =>
+ Pos := Pos - 1;
+ State := State_Arg_Flag_Padding;
+ end case;
+
+ when State_Arg_Flag_Padding =>
+ case Format_String (Pos) is
+ when '0' .. '9' =>
+ Arg.Padding := Arg.Padding * 10 + Char_To_UInt (Format_String (Pos));
+ when others =>
+ Pos := Pos - 1;
+ State := State_Arg_Modifier;
+ end case;
+
+ when State_Arg_Modifier =>
+ case Format_String (Pos) is
+ when 'l' =>
+ Arg.Length := Arg_Length_Long;
+ State := State_Arg_Modifier_Length;
+ when others =>
+ Pos := Pos - 1;
+ State := State_Arg_Conversion;
+ end case;
+
+ when State_Arg_Modifier_Length =>
+ case Format_String (Pos) is
+ when 'l' =>
+ Arg.Length := Arg_Length_Long_Long;
+ when others =>
+ Pos := Pos - 1;
+ State := State_Arg_Modifier;
+ end case;
+
+ when State_Arg_Conversion =>
+ case Format_String (Pos) is
+ when 'd' =>
+ Arg.Conversion := Arg_Int;
+ when 'i' =>
+ Arg.Conversion := Arg_Int;
+ when 'x' =>
+ Arg.Conversion := Arg_Hex;
+ when 'u' =>
+ Arg.Conversion := Arg_UInt;
+ when 'c' =>
+ Arg.Conversion := Arg_Char;
+ when 's' =>
+ Arg.Conversion := Arg_String;
+ when others =>
+ null;
+ end case;
+ Pos := Pos + 1;
+ exit;
+ end case;
+ Pos := Pos + 1;
+ end loop;
+
+ end Parse_And_Put;
+
+----------------------------------------------------------------------------------------------
+
+ subtype Word64_String_Range is Positive range 1 .. 20;
+ subtype Word64_String is String (Word64_String_Range);
+ type Int_Format is (Base_10, Base_16);
+
+ procedure Word64_To_String
+ (Output_String : out Word64_String;
+ String_Begin : out Word64_String_Range;
+ Item : in Word64;
+ Base : in Int_Format)
+ is
+
+ function Get_Character (Item : Word64; Base : Word64) return Character with
+ Pre => Base > 0 and Base <= 16
+ is
+
+ subtype Hex_Range is Natural range 0 .. 15;
+ type Hex_Characters is array (Hex_Range) of Character;
+ Character_Set : constant Hex_Characters := ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
+ Tmp : Word64;
+ begin
+ Tmp := Item rem Base;
+ -- GNATprove can't prove mod
+ --pragma assert ( Tmp = Item mod Base);
+ if Tmp > 15 then
+ Tmp := 15;
+ end if;
+ return Character_Set (Natural (Tmp));
+ end Get_Character;
+
+
+ Item_C : Word64;
+ Item_B : Word64;
+ begin
+ Item_C := Item;
+ Output_String:= " ";
+ String_Begin := Output_String'Last;
+
+ case (Base) is
+ when Base_10 =>
+ Item_B := 10;
+ when Base_16 =>
+ Item_B := 16;
+ end case;
+
+ loop
+ Output_String (String_Begin) := Get_Character (Item_C, Item_B);
+ Item_C := Item_C / Item_B;
+ pragma loop_invariant (Item_C < Item_B ** String_Begin);
+ exit when Item_C = 0;
+ String_Begin := String_Begin - 1;
+ end loop;
+
+ end Word64_To_String;
+
+---------------------------------------------------------------------------------------------------------
+
+ procedure Put_Arg (Item : in Word64; Arg : in Arg_T; Pos : in out Integer) is
+ Base : Int_Format;
+ Output : Word64_String;
+ Output_Begin : Word64_String_Range;
+ begin
+
+ case Arg.Conversion is
+ when Arg_UInt =>
+ Base := Base_10;
+
+ when Arg_Hex =>
+ Base := Base_16;
+
+ when others =>
+ Pos := Arg.Position + 1;
+ Put("%");
+ return;
+ end case;
+
+ Word64_To_String (Output, Output_Begin, Item, Base);
+ Put (Output (Output_Begin .. Output'Last));
+
+ end Put_Arg;
+
+ -----------------------------------------------------------------------------------------------
+ -----------------------------------------------------------------------------------------------
+
+ procedure Printf (Format_String : in String) is
+ begin
+ Put (Format_String);
+ end Printf;
+
+ -----------------------------------------------------------------------------------------------
+ procedure Printf (Format_String : in String; Arg_1 : in Word64) is
+ Arg : Arg_T;
+ Pos : Integer;
+ begin
+ Pos := Format_String'First;
+ Parse_And_Put (Format_String, Arg, Pos);
+ Put_Arg (Arg_1, Arg, Pos);
+
+ Put (format_String (Pos .. Format_String'Last));
+ end Printf;
+
+ -----------------------------------------------------------------------------------------------
+
+ -- procedure Printk (Level : in Debug_Level; Format_String : in String) is
+ -- begin
+ -- if Do_Print (Level) then
+ -- Printf (Format_String);
+ -- end if;
+ -- end Printk;
+
+end HW.Print;
diff --git a/debug/hw-print.ads b/debug/hw-print.ads
new file mode 100644
index 0000000..788ffd2
--- /dev/null
+++ b/debug/hw-print.ads
@@ -0,0 +1,10 @@
+package HW.Print is
+
+ type Debug_Level is (Emerg, Alert, Crit, Err, Warning, Notice, Info, Debug, Spew);
+
+ procedure Printf (Format_String : in String);
+ procedure Printf (Format_String : in String; Arg_1 : in Word64);
+
+-- procedure Printk (Level : in Debug_Level; Format_String : in String);
+
+end HW.Print;
diff --git a/gnat.adc b/gnat.adc
index 3494eba..2d49df2 100644
--- a/gnat.adc
+++ b/gnat.adc
@@ -1,6 +1,7 @@
pragma Restrictions (No_Allocators);
pragma Restrictions (No_Calendar);
pragma Restrictions (No_Dispatch);
+
pragma Restrictions (No_Fixed_Point);
pragma Restrictions (No_Floating_Point);
pragma Restrictions (No_Implicit_Dynamic_Code);
To view, visit change 37530. To unsubscribe, or for help writing mail filters, visit settings.