From b2cab4a6f6457f5c2662c0219753b96cae6c0237 Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Wed, 1 Feb 2023 21:10:17 +0100
Subject: translate: rework translate_object_subtype_indication.
Fix #2337
---
src/synth/elab-vhdl_annotations.adb | 10 +++----
src/vhdl/translate/trans-chap3.adb | 59 +++++++++++++++++++++----------------
src/vhdl/translate/trans-chap4.adb | 45 ++++++++++++++--------------
src/vhdl/vhdl-utils.adb | 29 ++++++++++--------
src/vhdl/vhdl-utils.ads | 6 +++-
5 files changed, 83 insertions(+), 66 deletions(-)
diff --git a/src/synth/elab-vhdl_annotations.adb b/src/synth/elab-vhdl_annotations.adb
index c7b8f64fb..83d19e225 100644
--- a/src/synth/elab-vhdl_annotations.adb
+++ b/src/synth/elab-vhdl_annotations.adb
@@ -285,7 +285,7 @@ package body Elab.Vhdl_Annotations is
| Iir_Kind_Interface_Constant_Declaration
| Iir_Kind_Interface_File_Declaration =>
-- Elaborate the subtype indication only if it not shared.
- if Is_Owned_Subtype_Indication (El) then
+ if Has_Owned_Subtype_Indication (El) then
Annotate_Type_Definition
(Block_Info, Get_Subtype_Indication (El));
end if;
@@ -323,14 +323,14 @@ package body Elab.Vhdl_Annotations is
begin
case Get_Kind (Decl) is
when Iir_Kind_Interface_Signal_Declaration =>
- if With_Types and then Is_Owned_Subtype_Indication (Decl) then
+ if With_Types and then Has_Owned_Subtype_Indication (Decl) then
Annotate_Type_Definition (Block_Info, Get_Type (Decl));
end if;
Create_Signal_Info (Block_Info, Decl);
when Iir_Kind_Interface_Variable_Declaration
| Iir_Kind_Interface_Constant_Declaration
| Iir_Kind_Interface_File_Declaration =>
- if With_Types and then Is_Owned_Subtype_Indication (Decl) then
+ if With_Types and then Has_Owned_Subtype_Indication (Decl) then
Annotate_Type_Definition (Block_Info, Get_Type (Decl));
end if;
Create_Object_Info (Block_Info, Decl);
@@ -557,7 +557,7 @@ package body Elab.Vhdl_Annotations is
procedure Annotate_Declaration_Type (Block_Info: Sim_Info_Acc; Decl: Iir) is
begin
- if Is_Owned_Subtype_Indication (Decl) then
+ if Has_Owned_Subtype_Indication (Decl) then
-- Really annotate the subtype indication, which might be different
-- from the type (for constant declarations).
Annotate_Type_Definition (Block_Info, Get_Subtype_Indication (Decl));
@@ -652,7 +652,7 @@ package body Elab.Vhdl_Annotations is
Annotate_Subprogram_Body (Block_Info, Decl);
when Iir_Kind_Object_Alias_Declaration =>
- if Is_Owned_Subtype_Indication (Decl) then
+ if Has_Owned_Subtype_Indication (Decl) then
Annotate_Type_Definition (Block_Info, Get_Type (Decl));
end if;
Create_Object_Info (Block_Info, Decl);
diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb
index 141bfca6e..b60cf343c 100644
--- a/src/vhdl/translate/trans-chap3.adb
+++ b/src/vhdl/translate/trans-chap3.adb
@@ -2700,8 +2700,9 @@ package body Trans.Chap3 is
procedure Translate_Object_Subtype_Indication (Decl : Iir;
With_Vars : Boolean := True)
is
- Def : Iir;
Ind : Iir;
+ Ind_Type : Iir;
+ Def : Iir;
Mark : Id_Mark_Type;
Mark2 : Id_Mark_Type;
begin
@@ -2722,7 +2723,15 @@ package body Trans.Chap3 is
Push_Identifier_Prefix (Mark, Get_Identifier (Decl));
- Def := Get_Type (Decl);
+ Ind := Get_Subtype_Indication (Decl);
+
+ -- Object subtype indication (if a proper one).
+ if Ind /= Null_Iir and then Is_Proper_Subtype_Indication (Ind) then
+ Ind_Type := Get_Type_Of_Subtype_Indication (Ind);
+ Push_Identifier_Prefix (Mark2, "OT");
+ Chap3.Translate_Subtype_Definition (Ind_Type, With_Vars);
+ Pop_Identifier_Prefix (Mark2);
+ end if;
-- 2) Constants may have a type that is different from the subtype
-- indication, when the subtype indication is not fully constrained.
@@ -2730,45 +2739,43 @@ package body Trans.Chap3 is
-- add some constraints on the type mark and the initial value add
-- even more constraints.
if Get_Kind (Decl) = Iir_Kind_Constant_Declaration then
- Ind := Get_Subtype_Indication (Decl);
- Ind := Get_Type_Of_Subtype_Indication (Ind);
- if Ind /= Def then
- Push_Identifier_Prefix (Mark2, "OTI");
- Chap3.Translate_Subtype_Definition (Ind, With_Vars);
+ Ind_Type := Get_Type_Of_Subtype_Indication (Ind);
+ Def := Get_Type (Decl);
+ if Def /= Ind_Type then
+ Push_Identifier_Prefix (Mark2, "OTD");
+ Chap3.Translate_Subtype_Definition (Def, With_Vars);
Pop_Identifier_Prefix (Mark2);
end if;
end if;
- Push_Identifier_Prefix (Mark2, "OT");
- Chap3.Translate_Subtype_Definition (Def, With_Vars);
- Pop_Identifier_Prefix (Mark2);
-
Pop_Identifier_Prefix (Mark);
end Translate_Object_Subtype_Indication;
procedure Elab_Object_Subtype_Indication (Decl : Iir)
is
- Def : constant Iir := Get_Type (Decl);
+ Ind : Iir;
+ Ind_Type : Iir;
+ Def : Iir;
begin
- if not Is_Anonymous_Type_Definition (Def) then
- -- The type refers to a declared type, so already handled.
+ -- See translate_Object_Subtype_Indication.
+ if Get_Is_Ref (Decl) then
return;
end if;
- declare
- Ind : constant Iir := Get_Subtype_Indication (Decl);
- begin
- if Ind /= Null_Iir
- and then Get_Kind (Ind) = Iir_Kind_Subtype_Attribute
- then
- if Is_Fully_Constrained_Type (Get_Type (Get_Prefix (Ind))) then
- return;
- end if;
- raise Internal_Error;
- else
+ Ind := Get_Subtype_Indication (Decl);
+
+ if Ind /= Null_Iir and then Is_Proper_Subtype_Indication (Ind) then
+ Ind_Type := Get_Type_Of_Subtype_Indication (Ind);
+ Elab_Subtype_Definition (Ind_Type);
+ end if;
+
+ if Get_Kind (Decl) = Iir_Kind_Constant_Declaration then
+ Ind_Type := Get_Type_Of_Subtype_Indication (Ind);
+ Def := Get_Type (Decl);
+ if Def /= Ind_Type then
Elab_Subtype_Definition (Def);
end if;
- end;
+ end if;
end Elab_Object_Subtype_Indication;
procedure Elab_Type_Declaration (Decl : Iir) is
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb
index 198bcbe62..b0ea8fae3 100644
--- a/src/vhdl/translate/trans-chap4.adb
+++ b/src/vhdl/translate/trans-chap4.adb
@@ -193,7 +193,10 @@ package body Trans.Chap4 is
Type_Info : Type_Info_Acc;
Info : Signal_Info_Acc;
begin
- Chap3.Translate_Object_Subtype_Indication (Decl);
+ if Get_Kind (Decl) /= Iir_Kind_Guard_Signal_Declaration then
+ -- No subtype indication for guard signals (and its type is boolean).
+ Chap3.Translate_Object_Subtype_Indication (Decl);
+ end if;
Type_Info := Get_Info (Sig_Type_Def);
Info := Add_Info (Decl, Kind_Signal);
@@ -730,6 +733,7 @@ package body Trans.Chap4 is
if Get_Info (Obj).Object_Static then
-- A static object is pre-initialized.
+ Chap3.Elab_Object_Subtype_Indication (Obj);
return;
end if;
@@ -1698,6 +1702,23 @@ package body Trans.Chap4 is
Info.Alias_Kind := Mode_Value;
end if;
+ if Get_Kind (Name) = Iir_Kind_Slice_Name then
+ -- The name subtype will be evaluated once at elaboration, as it is
+ -- needed when direct drivers are used (in that case, the name is
+ -- evaluated once again).
+ -- FIXME: only when the subtype indication is not set ?
+ declare
+ Name_Type : constant Iir := Get_Type (Name);
+ Mark1, Mark2 : Id_Mark_Type;
+ begin
+ Push_Identifier_Prefix (Mark1, Get_Identifier (Decl));
+ Push_Identifier_Prefix (Mark2, "AT");
+ Chap3.Translate_Array_Subtype (Name_Type);
+ Pop_Identifier_Prefix (Mark2);
+ Pop_Identifier_Prefix (Mark1);
+ end;
+ end if;
+
Tinfo := Get_Info (Decl_Type);
for Mode in Mode_Value .. Info.Alias_Kind loop
case Tinfo.Type_Mode is
@@ -1731,24 +1752,6 @@ package body Trans.Chap4 is
end if;
Info.Alias_Var (Mode) := Create_Var (Id, Atype);
end loop;
-
- if Get_Kind (Name) = Iir_Kind_Slice_Name
- and then Info.Alias_Kind = Mode_Signal
- then
- -- The name subtype will be evaluated once at elaboration, as it is
- -- needed when direct drivers are used (in that case, the name is
- -- evaluated once again).
- declare
- Name_Type : constant Iir := Get_Type (Name);
- Mark1, Mark2 : Id_Mark_Type;
- begin
- Push_Identifier_Prefix (Mark1, Get_Identifier (Decl));
- Push_Identifier_Prefix (Mark2, "AT");
- Chap3.Translate_Array_Subtype (Name_Type);
- Pop_Identifier_Prefix (Mark2);
- Pop_Identifier_Prefix (Mark1);
- end;
- end if;
end Translate_Object_Alias_Declaration;
procedure Elab_Object_Alias_Declaration
@@ -1767,9 +1770,7 @@ package body Trans.Chap4 is
Open_Temp;
- if Get_Kind (Name) = Iir_Kind_Slice_Name
- and then Alias_Info.Alias_Kind = Mode_Signal
- then
+ if Get_Kind (Name) = Iir_Kind_Slice_Name then
-- See Translate_Object_Alias_Declaration.
Chap3.Elab_Array_Subtype (Name_Type);
end if;
diff --git a/src/vhdl/vhdl-utils.adb b/src/vhdl/vhdl-utils.adb
index 04fab38a9..fa5f31ee8 100644
--- a/src/vhdl/vhdl-utils.adb
+++ b/src/vhdl/vhdl-utils.adb
@@ -1323,7 +1323,21 @@ package body Vhdl.Utils is
end case;
end Get_Nature_Of_Subnature_Indication;
- function Is_Owned_Subtype_Indication (Decl : Iir) return Boolean
+ function Is_Proper_Subtype_Indication (Def : Iir) return Boolean is
+ begin
+ case Get_Kind (Def) is
+ when Iir_Kinds_Subtype_Definition =>
+ return True;
+ when Iir_Kinds_Denoting_Name
+ | Iir_Kind_Element_Attribute
+ | Iir_Kind_Subtype_Attribute =>
+ return False;
+ when others =>
+ Error_Kind ("is_proper_subtype_indication", Def);
+ end case;
+ end Is_Proper_Subtype_Indication;
+
+ function Has_Owned_Subtype_Indication (Decl : Iir) return Boolean
is
Def : Iir;
begin
@@ -1341,17 +1355,8 @@ package body Vhdl.Utils is
return False;
end if;
- case Get_Kind (Def) is
- when Iir_Kinds_Subtype_Definition =>
- return True;
- when Iir_Kinds_Denoting_Name
- | Iir_Kind_Element_Attribute
- | Iir_Kind_Subtype_Attribute =>
- return False;
- when others =>
- Error_Kind ("is_owned_subtype_indication", Def);
- end case;
- end Is_Owned_Subtype_Indication;
+ return Is_Proper_Subtype_Indication (Def);
+ end Has_Owned_Subtype_Indication;
function Get_Index_Type (Indexes : Iir_Flist; Idx : Natural) return Iir
is
diff --git a/src/vhdl/vhdl-utils.ads b/src/vhdl/vhdl-utils.ads
index 5cdef0daa..8dba4e221 100644
--- a/src/vhdl/vhdl-utils.ads
+++ b/src/vhdl/vhdl-utils.ads
@@ -258,9 +258,13 @@ package Vhdl.Utils is
-- skip over denoting names.
function Get_Type_Of_Subtype_Indication (Ind : Iir) return Iir;
+ -- Return True iff DEF defines a new subtype indication, not just an
+ -- existing name (like a name).
+ function Is_Proper_Subtype_Indication (Def : Iir) return Boolean;
+
-- Return True iff the subtype indication of DECL is defined/owned by
-- DECL.
- function Is_Owned_Subtype_Indication (Decl : Iir) return Boolean;
+ function Has_Owned_Subtype_Indication (Decl : Iir) return Boolean;
-- Get the type of an index_subtype_definition or of a discrete_range from
-- an index_constraint.
--
cgit v1.2.3