Thomas Heijligen has uploaded this change for review. ( https://review.coreboot.org/c/libhwbase/+/37530 )
Change subject: [WIP] Printf like debugging ......................................................................
[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);