diff --git a/src/ada_gen.adb b/src/ada_gen.adb index c075e17..ec5c59f 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 -- ---------------------- @@ -415,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); @@ -465,6 +473,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 +616,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 +797,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 @@ -1661,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; @@ -1723,6 +1734,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 +1745,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 +2069,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 +2092,7 @@ package body Ada_Gen is Rec.Fields.Append ((Id => Current, Typ => Typ.Id, + Constraint => Constraint, Offset => Offset, LSB => LSB, MSB => MSB, @@ -2095,6 +2110,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 +2122,7 @@ package body Ada_Gen is (Rec, Id => Id, Typ => Typ, + Constraint => Constraint, Offset => Offset, LSB => LSB, MSB => MSB, @@ -2123,6 +2140,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 +2153,7 @@ package body Ada_Gen is (Rec, Id => Id, Typ => Typ, + Constraint => Constraint, Offset => Offset, LSB => LSB, MSB => MSB, @@ -2152,6 +2171,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 +2184,7 @@ package body Ada_Gen is (Rec, Id => Id, Typ => Typ, + Constraint => Constraint, Offset => Offset, LSB => LSB, MSB => MSB, @@ -2244,6 +2265,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 +2288,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..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; @@ -183,6 +184,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 +236,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 +247,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 +259,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 +301,7 @@ package Ada_Gen is Enum_Val : String; Id : String; Typ : Ada_Type'Class; + Constraint : Field_Constraint; Offset : Natural; LSB : Natural; MSB : Natural; @@ -515,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 @@ -527,6 +534,7 @@ private Index_First : Natural; Index_Last : Natural; Element_Type : Unbounded_String; + Constraint : Field_Constraint; end record; overriding procedure Dump @@ -556,6 +564,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..ff57e70 100644 --- a/src/base_types.adb +++ b/src/base_types.adb @@ -64,8 +64,11 @@ 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 + return Pkg & Unsigned_Type; + elsif Size = 1 then return Pkg & "Bit"; elsif Size = 8 and then not SVD2Ada_Utils.Use_UInt_Always then return Pkg & "Byte"; @@ -74,6 +77,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 = 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..3aa8dff 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 @@ -486,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; @@ -519,10 +528,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 @@ -532,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; @@ -547,6 +560,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 +580,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 +593,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 +605,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 +699,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 +712,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 +726,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;