Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Topic/unsigned #105

Open
wants to merge 3 commits into
base: master
Choose a base branch
from
Open

Topic/unsigned #105

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
8a33a5b
Use common type with corresponding range constraints
reznikmm Jun 18, 2024
c7b062f
Make `--use-unsigned-type` work without `--no-uint-subtypes` option.
reznikmm Jun 23, 2024
54287f3
Drop special cases for 8/16/32 bits
reznikmm Jun 24, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
45 changes: 34 additions & 11 deletions src/ada_gen.adb
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand All @@ -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 --
----------------------
Expand Down Expand Up @@ -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);

Expand Down Expand Up @@ -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);
Expand Down Expand Up @@ -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);

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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;

Expand Down Expand Up @@ -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
Expand All @@ -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;

----------------
Expand Down Expand Up @@ -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;
Expand All @@ -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,
Expand All @@ -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;
Expand All @@ -2106,6 +2122,7 @@ package body Ada_Gen is
(Rec,
Id => Id,
Typ => Typ,
Constraint => Constraint,
Offset => Offset,
LSB => LSB,
MSB => MSB,
Expand All @@ -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;
Expand All @@ -2135,6 +2153,7 @@ package body Ada_Gen is
(Rec,
Id => Id,
Typ => Typ,
Constraint => Constraint,
Offset => Offset,
LSB => LSB,
MSB => MSB,
Expand All @@ -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;
Expand All @@ -2164,6 +2184,7 @@ package body Ada_Gen is
(Rec,
Id => Id,
Typ => Typ,
Constraint => Constraint,
Offset => Offset,
LSB => LSB,
MSB => MSB,
Expand Down Expand Up @@ -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;
Expand All @@ -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,
Expand Down
17 changes: 13 additions & 4 deletions src/ada_gen.ads
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand All @@ -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
Expand Down Expand Up @@ -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;
Expand All @@ -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;
Expand All @@ -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;
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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
Expand All @@ -527,6 +534,7 @@ private
Index_First : Natural;
Index_Last : Natural;
Element_Type : Unbounded_String;
Constraint : Field_Constraint;
end record;

overriding procedure Dump
Expand Down Expand Up @@ -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;
Expand Down
19 changes: 18 additions & 1 deletion src/base_types.adb
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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";
Expand All @@ -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;

---------
-- "=" --
---------
Expand Down
15 changes: 15 additions & 0 deletions src/base_types.ads
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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;
5 changes: 5 additions & 0 deletions src/descriptors-cluster.adb
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand All @@ -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,
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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;
Expand Down
Loading
Loading