From 8a33a5b3a8928f3264e07129cae9568ae9cd487e Mon Sep 17 00:00:00 2001 From: Maxim Reznik Date: Tue, 18 Jun 2024 18:29:17 +0300 Subject: [PATCH 1/3] Use common type with corresponding range constraints for all unsigned fields and array component. --- src/ada_gen.adb | 27 ++++++++++++++++++++++++--- src/ada_gen.ads | 7 +++++++ src/base_types.adb | 28 +++++++++++++++++++++++++++- src/base_types.ads | 15 +++++++++++++++ src/descriptors-cluster.adb | 5 +++++ src/descriptors-field.adb | 17 +++++++++++++++++ src/descriptors-register.adb | 1 + src/svd2ada.adb | 11 +++++++++++ src/svd2ada_utils.adb | 19 +++++++++++++++++++ src/svd2ada_utils.ads | 4 ++++ 10 files changed, 130 insertions(+), 4 deletions(-) diff --git a/src/ada_gen.adb b/src/ada_gen.adb index c075e17..e7fa153 100644 --- a/src/ada_gen.adb +++ b/src/ada_gen.adb @@ -69,6 +69,7 @@ package body Ada_Gen is (Rec : in out Ada_Type_Record'Class; Id : String; Typ : Ada_Type'Class; + Constraint : Field_Constraint; Offset : Natural; LSB : Natural; MSB : Natural; @@ -77,6 +78,12 @@ package body Ada_Gen is Properties : Field_Properties; Comment : String := ""); + function Image (Value : Field_Constraint) return String is + (case Value.Kind is + when No_Constraint => "", + when Range_Constraint => + " range " & To_String (Value.From) & " .. " & To_String (Value.To)); + ---------------------- -- Protect_Keywords -- ---------------------- @@ -465,6 +472,7 @@ package body Ada_Gen is To_String (Element.Index_Last) & ")"); Line2 := To_Unbounded_String (" of ") & Element.Element_Type; + Append (Line2, Image (Element.Constraint)); if Length (Line) + Length (Line2) + 1 < Max_Width then Append (Line, Line2); @@ -607,10 +615,11 @@ package body Ada_Gen is declare Id : constant String := Get_Id (F); + Con : constant String := Image (F.Constraint); Line : constant String := (1 .. 6 => ' ') & Id & " : " & (if F.Properties.Is_Aliased then "aliased " else "") & - To_String (F.Typ); + To_String (F.Typ) & Con; begin Ada.Text_IO.Put (File, Line); @@ -787,7 +796,7 @@ package body Ada_Gen is Ada.Text_IO.Put_Line (File, To_String (F.Id) & " : " & (if F.Properties.Is_Aliased then "aliased " else "") & - To_String (F.Typ) & ";"); + To_String (F.Typ) & Image (F.Constraint) & ";"); if F.Properties.Is_Volatile_FA then Ada.Text_IO.Put (File, (1 .. 4 * 3 => ' ')); Ada.Text_IO.Put_Line @@ -1723,6 +1732,7 @@ package body Ada_Gen is Index_First : Natural; Index_Last : Natural; Element_Type : Ada_Type'Class; + Constraint : Field_Constraint; Comment : String := "") return Ada_Type_Array is @@ -1733,7 +1743,8 @@ package body Ada_Gen is Index_Type => To_Unbounded_String (Index_Type), Index_First => Index_First, Index_Last => Index_Last, - Element_Type => Element_Type.Id); + Element_Type => Element_Type.Id, + Constraint => Constraint); end New_Type_Array; ---------------- @@ -2056,6 +2067,7 @@ package body Ada_Gen is (Rec : in out Ada_Type_Record'Class; Id : String; Typ : Ada_Type'Class; + Constraint : Field_Constraint; Offset : Natural; LSB : Natural; MSB : Natural; @@ -2078,6 +2090,7 @@ package body Ada_Gen is Rec.Fields.Append ((Id => Current, Typ => Typ.Id, + Constraint => Constraint, Offset => Offset, LSB => LSB, MSB => MSB, @@ -2095,6 +2108,7 @@ package body Ada_Gen is (Rec : in out Ada_Type_Record'Class; Id : String; Typ : Ada_Type'Class; + Constraint : Field_Constraint; Offset : Natural; LSB : Natural; MSB : Natural; @@ -2106,6 +2120,7 @@ package body Ada_Gen is (Rec, Id => Id, Typ => Typ, + Constraint => Constraint, Offset => Offset, LSB => LSB, MSB => MSB, @@ -2123,6 +2138,7 @@ package body Ada_Gen is (Rec : in out Ada_Type_Record'Class; Id : String; Typ : Ada_Type'Class; + Constraint : Field_Constraint; Offset : Natural; LSB : Natural; MSB : Natural; @@ -2135,6 +2151,7 @@ package body Ada_Gen is (Rec, Id => Id, Typ => Typ, + Constraint => Constraint, Offset => Offset, LSB => LSB, MSB => MSB, @@ -2152,6 +2169,7 @@ package body Ada_Gen is (Rec : in out Ada_Type_Record'Class; Id : String; Typ : Ada_Type'Class; + Constraint : Field_Constraint; Offset : Natural; LSB : Natural; MSB : Natural; @@ -2164,6 +2182,7 @@ package body Ada_Gen is (Rec, Id => Id, Typ => Typ, + Constraint => Constraint, Offset => Offset, LSB => LSB, MSB => MSB, @@ -2244,6 +2263,7 @@ package body Ada_Gen is Enum_Val : String; Id : String; Typ : Ada_Type'Class; + Constraint : Field_Constraint; Offset : Natural; LSB : Natural; MSB : Natural; @@ -2266,6 +2286,7 @@ package body Ada_Gen is Rec.Disc_Fields (Enum_Val).Append ((Id => Current, Typ => Typ.Id, + Constraint => Constraint, Offset => Offset, LSB => LSB, MSB => MSB, diff --git a/src/ada_gen.ads b/src/ada_gen.ads index 820afc4..7adf7c2 100644 --- a/src/ada_gen.ads +++ b/src/ada_gen.ads @@ -183,6 +183,7 @@ package Ada_Gen is Index_First : Natural; Index_Last : Natural; Element_Type : Ada_Type'Class; + Constraint : Field_Constraint; Comment : String := "") return Ada_Type_Array; overriding function Is_Similar @@ -234,6 +235,7 @@ package Ada_Gen is (Rec : in out Ada_Type_Record'Class; Id : String; Typ : Ada_Type'Class; + Constraint : Field_Constraint; Offset : Natural; LSB : Natural; MSB : Natural; @@ -244,6 +246,7 @@ package Ada_Gen is (Rec : in out Ada_Type_Record'Class; Id : String; Typ : Ada_Type'Class; + Constraint : Field_Constraint; Offset : Natural; LSB : Natural; MSB : Natural; @@ -255,6 +258,7 @@ package Ada_Gen is (Rec : in out Ada_Type_Record'Class; Id : String; Typ : Ada_Type'Class; + Constraint : Field_Constraint; Offset : Natural; LSB : Natural; MSB : Natural; @@ -296,6 +300,7 @@ package Ada_Gen is Enum_Val : String; Id : String; Typ : Ada_Type'Class; + Constraint : Field_Constraint; Offset : Natural; LSB : Natural; MSB : Natural; @@ -527,6 +532,7 @@ private Index_First : Natural; Index_Last : Natural; Element_Type : Unbounded_String; + Constraint : Field_Constraint; end record; overriding procedure Dump @@ -556,6 +562,7 @@ private type Record_Field is record Id : Unbounded_String; Typ : Unbounded_String; + Constraint : Field_Constraint; Offset : Natural; LSB : Natural; MSB : Natural; diff --git a/src/base_types.adb b/src/base_types.adb index 790c175..6847663 100644 --- a/src/base_types.adb +++ b/src/base_types.adb @@ -64,8 +64,20 @@ package body Base_Types is then SVD2Ada_Utils.Root_Package & "." else SVD2Ada_Utils.Base_Types_Package & "."); + Unsigned_Type : constant String := SVD2Ada_Utils.Unsigned_Type; begin - if Size = 1 then + if Unsigned_Type /= "" then + case Size is + when 8 => + return Pkg & "Unsigned_8"; + when 16 => + return Pkg & "Unsigned_16"; + when 32 => + return Pkg & "Unsigned_32"; + when others => + return Pkg & Unsigned_Type; + end case; + elsif Size = 1 then return Pkg & "Bit"; elsif Size = 8 and then not SVD2Ada_Utils.Use_UInt_Always then return Pkg & "Byte"; @@ -74,6 +86,20 @@ package body Base_Types is end if; end Target_Type; + ---------------------------- + -- Target_Type_Constraint -- + ---------------------------- + + function Target_Type_Constraint (Size : Natural) return Field_Constraint is + Unsigned_Type : constant String := SVD2Ada_Utils.Unsigned_Type; + begin + if Unsigned_Type = "" or else Size in 8 | 16 | 32 then + return None; + else + return (Range_Constraint, From => 0, To => 2 ** Size - 1); + end if; + end Target_Type_Constraint; + --------- -- "=" -- --------- diff --git a/src/base_types.ads b/src/base_types.ads index 4eafe25..964430d 100644 --- a/src/base_types.ads +++ b/src/base_types.ads @@ -197,4 +197,19 @@ package Base_Types is function Full_Name (Elt : DOM.Core.Node) return String; + type Field_Constraint_Kind is (No_Constraint, Range_Constraint); + + type Field_Constraint (Kind : Field_Constraint_Kind := No_Constraint) is record + case Kind is + when Range_Constraint => + From, To : Unsigned; + when No_Constraint => + null; + end case; + end record; + + function None return Field_Constraint is (Kind => No_Constraint); + + function Target_Type_Constraint (Size : Natural) return Field_Constraint; + end Base_Types; diff --git a/src/descriptors-cluster.adb b/src/descriptors-cluster.adb index 2ee52f1..b6e3fc6 100644 --- a/src/descriptors-cluster.adb +++ b/src/descriptors-cluster.adb @@ -685,6 +685,7 @@ package body Descriptors.Cluster is Enum_Val => Overlap_Suffix (Elt), Id => Name, Typ => Get_Ada_Type (Elt), + Constraint => None, Offset => Address_Offset + J * Dim_Increment, LSB => 0, MSB => Elt_Size - 1, @@ -695,6 +696,7 @@ package body Descriptors.Cluster is (Parent, Id => Name, Typ => Get_Ada_Type (Elt), + Constraint => None, Offset => Address_Offset + J * Dim_Increment, LSB => 0, MSB => Elt_Size - 1, @@ -711,6 +713,7 @@ package body Descriptors.Cluster is Enum_Val => Overlap_Suffix (Elt), Id => Get_Name (Elt), Typ => Get_Ada_Type (Elt), + Constraint => None, Offset => Address_Offset, LSB => 0, MSB => (if Dim (Elt) = 1 @@ -723,6 +726,7 @@ package body Descriptors.Cluster is (Parent, Id => Get_Name (Elt), Typ => Get_Ada_Type (Elt), + Constraint => None, Offset => Address_Offset, LSB => 0, MSB => (if Dim (Elt) = 1 @@ -827,6 +831,7 @@ package body Descriptors.Cluster is Index_First => 0, Index_Last => Cluster.Dim - 1, Element_Type => -Cluster.Ada_Type, + Constraint => None, Comment => To_String (Cluster.Description)); Add (Spec, Array_T); Cluster.Ada_Type := -Array_T; diff --git a/src/descriptors-field.adb b/src/descriptors-field.adb index 5962c95..010202f 100644 --- a/src/descriptors-field.adb +++ b/src/descriptors-field.adb @@ -288,6 +288,7 @@ package body Descriptors.Field is Ada_Type : Descriptors.Register.Type_Holders.Holder; Ada_Type_Size : Natural; Ada_Name : Unbounded_String; + Constraint : Field_Constraint; As_Boolean : Boolean; Description : Unbounded_String; All_RO : Boolean := True; @@ -314,6 +315,7 @@ package body Descriptors.Field is Index := 0; while Index < Properties.Size loop Ada_Type := Type_Holders.Empty_Holder; + Constraint := None; if Fields (Index) = Null_Field then -- First look for undefined/reserved parts of the register @@ -335,6 +337,7 @@ package body Descriptors.Field is (Rec, "Reserved_" & To_String (Index) & "_" & To_String (Index + Length - 1), Target_Type (Length), + Constraint => Target_Type_Constraint (Length), Offset => 0, LSB => Index, MSB => Index + Length - 1, @@ -347,6 +350,7 @@ package body Descriptors.Field is (Rec, "Reserved_" & To_String (Index) & "_" & To_String (Index + Length - 1), Target_Type (Length), + Constraint => Target_Type_Constraint (Length), Offset => 0, LSB => Index, MSB => Index + Length - 1, @@ -431,6 +435,7 @@ package body Descriptors.Field is Add (Spec, Enum_T); Ada_Type := -Enum_T; + Constraint := None; end; end loop; end if; @@ -462,6 +467,7 @@ package body Descriptors.Field is if Ada_Type_Size = 1 and then As_Boolean then if Ada_Type.Is_Empty then Ada_Type := -Get_Boolean; + Constraint := None; if not All_RO then if Default = 0 then @@ -477,6 +483,7 @@ package body Descriptors.Field is -- subtype for it, so that programming conversion to this -- field is allowed using FIELD_TYPE (Value). Ada_Type := -Ada_Gen.Target_Type (Ada_Type_Size); + Constraint := Target_Type_Constraint (Ada_Type_Size); if SVD2Ada_Utils.Gen_UInt_Subtype then declare @@ -519,10 +526,12 @@ package body Descriptors.Field is if Ada_Type_Size = 1 and then As_Boolean then if Ada_Type.Is_Empty then Ada_Type := -Get_Boolean; + Constraint := None; end if; elsif Ada_Type.Is_Empty then Ada_Type := -Target_Type (Ada_Type_Size); + Constraint := Target_Type_Constraint (Ada_Type_Size); if SVD2Ada_Utils.Gen_UInt_Subtype then declare @@ -547,6 +556,7 @@ package body Descriptors.Field is Index_First => First, Index_Last => First + Length - 1, Element_Type => -Ada_Type, + Constraint => Constraint, Comment => T_Name & " array"); Add_Aspect @@ -566,6 +576,7 @@ package body Descriptors.Field is Enum_Val => "True", Id => "Arr", Typ => Array_T, + Constraint => None, Offset => 0, LSB => 0, MSB => Fields (Index).Size * Length - 1, @@ -578,6 +589,8 @@ package body Descriptors.Field is Id => "Val", Typ => Target_Type (Fields (Index).Size * Length), + Constraint => + Target_Type_Constraint (Fields (Index).Size * Length), Offset => 0, LSB => 0, MSB => Fields (Index).Size * Length - 1, @@ -588,6 +601,7 @@ package body Descriptors.Field is Add (Spec, Union_T); Ada_Type := -Union_T; + Constraint := None; Ada_Type_Size := Fields (Index).Size * Length; Ada_Name := To_Unbounded_String (F_Name); @@ -681,6 +695,7 @@ package body Descriptors.Field is (Rec, Id => To_String (Ada_Name), Typ => -Ada_Type, + Constraint => Constraint, Offset => 0, LSB => Index, MSB => Index + Ada_Type_Size - 1, @@ -693,6 +708,7 @@ package body Descriptors.Field is (Rec, Id => To_String (Ada_Name), Typ => -Ada_Type, + Constraint => Constraint, Offset => 0, LSB => Index, MSB => Index + Ada_Type_Size - 1, @@ -706,6 +722,7 @@ package body Descriptors.Field is (Rec, Id => To_String (Ada_Name), Typ => -Ada_Type, + Constraint => Constraint, Offset => 0, LSB => Index, MSB => Index + Ada_Type_Size - 1, diff --git a/src/descriptors-register.adb b/src/descriptors-register.adb index 9bbfb71..a4e4b71 100644 --- a/src/descriptors-register.adb +++ b/src/descriptors-register.adb @@ -340,6 +340,7 @@ package body Descriptors.Register is Index_First => 0, Index_Last => Reg.Dim - 1, Element_Type => Get_Ada_Type (Reg), + Constraint => None, Comment => To_String (Reg.Description)); begin Add (Spec, Array_T); diff --git a/src/svd2ada.adb b/src/svd2ada.adb index cf7202a..54c4249 100644 --- a/src/svd2ada.adb +++ b/src/svd2ada.adb @@ -75,6 +75,7 @@ procedure SVD2Ada is Root_Pkg_Name : aliased GNAT.Strings.String_Access; Output_Dir : aliased GNAT.Strings.String_Access; Base_Types_Pkg : aliased GNAT.Strings.String_Access; + Unsigned_Type : aliased GNAT.Strings.String_Access; Gen_Booleans : aliased Boolean := False; Gen_UInt_Always : aliased Boolean := False; No_UInt_Subtype : aliased Boolean := False; @@ -177,6 +178,12 @@ procedure SVD2Ada is -- register record type when those fields are -- themselves represented as register types Value => True); + Define_Switch + (Cmd_Line_Cfg, + Output => Unsigned_Type'Access, + Long_Switch => "--use-unsigned-type=", + Help => "use this type for each unsigned field in combination with a constraint", + Argument => "Type_Name"); end Configure_Command_Line; ------------------------ @@ -206,6 +213,10 @@ procedure SVD2Ada is if Base_Types_Pkg.all /= "" then Set_Base_Types_Package (Base_Types_Pkg.all); end if; + + if Unsigned_Type.all /= "" then + Set_Unsigned_Type (Unsigned_Type.all); + end if; end Apply_Command_Line; ----------------------- diff --git a/src/svd2ada_utils.adb b/src/svd2ada_utils.adb index 9ca9982..fd69fd0 100644 --- a/src/svd2ada_utils.adb +++ b/src/svd2ada_utils.adb @@ -28,6 +28,7 @@ package body SVD2Ada_Utils is G_Use_Boolean : Boolean := False; G_Types_Pkg : Unbounded_String := Null_Unbounded_String; G_Root_Pkg : Unbounded_String := Null_Unbounded_String; + G_Unsigned_Type : Unbounded_String := Null_Unbounded_String; G_Use_UInt : Boolean := False; G_Gen_Arrays : Boolean := True; G_No_VFA_On_Reg_Types : Boolean := False; @@ -271,6 +272,24 @@ package body SVD2Ada_Utils is return G_Gen_IRQ_Support or else In_Runtime; end Gen_IRQ_Support; + ----------------------- + -- Set_Unsigned_Type -- + ----------------------- + + procedure Set_Unsigned_Type (Value : String) is + begin + G_Unsigned_Type := To_Unbounded_String (Value); + end Set_Unsigned_Type; + + ------------------- + -- Unsigned_Type -- + ------------------- + + function Unsigned_Type return String is + begin + return To_String (G_Unsigned_Type); + end Unsigned_Type; + ---------------------- -- Installation_Dir -- ---------------------- diff --git a/src/svd2ada_utils.ads b/src/svd2ada_utils.ads index a2df8e0..7aa9048 100644 --- a/src/svd2ada_utils.ads +++ b/src/svd2ada_utils.ads @@ -43,6 +43,10 @@ package SVD2Ada_Utils is function External_Base_Types_Package return Boolean; + procedure Set_Unsigned_Type (Value : String); + + function Unsigned_Type return String; + procedure Set_Root_Package (Value : String); function Root_Package return String; From c7b062fd46d073db8515c2ac39178d2f306557e3 Mon Sep 17 00:00:00 2001 From: Maxim Reznik Date: Sun, 23 Jun 2024 19:00:59 +0300 Subject: [PATCH 2/3] Make `--use-unsigned-type` work without `--no-uint-subtypes` option. --- src/ada_gen.adb | 18 ++++++++++-------- src/ada_gen.ads | 10 ++++++---- src/descriptors-field.adb | 8 ++++++-- 3 files changed, 22 insertions(+), 14 deletions(-) diff --git a/src/ada_gen.adb b/src/ada_gen.adb index e7fa153..ec5c59f 100644 --- a/src/ada_gen.adb +++ b/src/ada_gen.adb @@ -422,7 +422,8 @@ package body Ada_Gen is declare Subt_String : constant String := " subtype " & To_String (Element.Id) & " is"; - Val : constant String := To_String (Element.Typ); + Val : constant String := To_String (Element.Typ) & + Image (Element.Constraint); begin Ada.Text_IO.Put (File, Subt_String); @@ -1670,15 +1671,16 @@ package body Ada_Gen is --------------------- function New_Subype_Scalar - (Id : String; - Typ : Ada_Type'Class; - Comment : String := "") - return Ada_Subtype_Scalar + (Id : String; + Typ : Ada_Type'Class; + Constraint : Field_Constraint; + Comment : String := "") return Ada_Subtype_Scalar is begin - return (Id => Ada_Identifier (Id, "Scalar"), - Comment => New_Comment (Comment, Strip => True), - Typ => Typ.Id, + return (Id => Ada_Identifier (Id, "Scalar"), + Comment => New_Comment (Comment, Strip => True), + Typ => Typ.Id, + Constraint => Constraint, others => <>); end New_Subype_Scalar; diff --git a/src/ada_gen.ads b/src/ada_gen.ads index 7adf7c2..aeaefe0 100644 --- a/src/ada_gen.ads +++ b/src/ada_gen.ads @@ -163,9 +163,10 @@ package Ada_Gen is -- A scalar subtype definition function New_Subype_Scalar - (Id : String; - Typ : Ada_Type'Class; - Comment : String := "") return Ada_Subtype_Scalar; + (Id : String; + Typ : Ada_Type'Class; + Constraint : Field_Constraint; + Comment : String := "") return Ada_Subtype_Scalar; overriding function Is_Similar (T1, T2 : Ada_Subtype_Scalar) return Boolean; @@ -520,7 +521,8 @@ private File : Ada.Text_IO.File_Type); type Ada_Subtype_Scalar is new Ada_Type with record - Typ : Unbounded_String; + Typ : Unbounded_String; + Constraint : Field_Constraint; end record; overriding procedure Dump diff --git a/src/descriptors-field.adb b/src/descriptors-field.adb index 010202f..3aa8dff 100644 --- a/src/descriptors-field.adb +++ b/src/descriptors-field.adb @@ -493,10 +493,12 @@ package body Descriptors.Field is "_" & To_String (Fields (Index).Name) & "_Field", - Typ => -Ada_Type); + Typ => -Ada_Type, + Constraint => Constraint); begin Add (Spec, Sub_T); Ada_Type := -Sub_T; + Constraint := None; end; end if; end if; @@ -541,10 +543,12 @@ package body Descriptors.Field is Typ => Target_Type (Ada_Type_Size), Comment => - T_Name & " array element"); + T_Name & " array element", + Constraint => Constraint); begin Add (Spec, Scalar_T); Ada_Type := -Scalar_T; + Constraint := None; end; end if; end if; From 54287f395f71de17f0c25eca2bb791f036c48038 Mon Sep 17 00:00:00 2001 From: Maxim Reznik Date: Mon, 24 Jun 2024 10:36:26 +0300 Subject: [PATCH 3/3] Drop special cases for 8/16/32 bits --- src/base_types.adb | 13 ++----------- 1 file changed, 2 insertions(+), 11 deletions(-) diff --git a/src/base_types.adb b/src/base_types.adb index 6847663..ff57e70 100644 --- a/src/base_types.adb +++ b/src/base_types.adb @@ -67,16 +67,7 @@ package body Base_Types is Unsigned_Type : constant String := SVD2Ada_Utils.Unsigned_Type; begin if Unsigned_Type /= "" then - case Size is - when 8 => - return Pkg & "Unsigned_8"; - when 16 => - return Pkg & "Unsigned_16"; - when 32 => - return Pkg & "Unsigned_32"; - when others => - return Pkg & Unsigned_Type; - end case; + return Pkg & Unsigned_Type; elsif Size = 1 then return Pkg & "Bit"; elsif Size = 8 and then not SVD2Ada_Utils.Use_UInt_Always then @@ -93,7 +84,7 @@ package body Base_Types is function Target_Type_Constraint (Size : Natural) return Field_Constraint is Unsigned_Type : constant String := SVD2Ada_Utils.Unsigned_Type; begin - if Unsigned_Type = "" or else Size in 8 | 16 | 32 then + if Unsigned_Type = "" or else Size = 32 then return None; else return (Range_Constraint, From => 0, To => 2 ** Size - 1);