aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/vhdl/translate/trans-chap1.adb3
-rw-r--r--src/vhdl/translate/trans-chap2.adb12
-rw-r--r--src/vhdl/translate/trans-chap3.adb102
-rw-r--r--src/vhdl/translate/trans-chap3.ads3
-rw-r--r--src/vhdl/translate/trans-chap4.adb68
-rw-r--r--src/vhdl/translate/trans-chap4.ads3
-rw-r--r--src/vhdl/translate/trans-chap9.adb6
-rw-r--r--src/vhdl/translate/trans.ads10
8 files changed, 126 insertions, 81 deletions
diff --git a/src/vhdl/translate/trans-chap1.adb b/src/vhdl/translate/trans-chap1.adb
index 68f4acd57..93534f028 100644
--- a/src/vhdl/translate/trans-chap1.adb
+++ b/src/vhdl/translate/trans-chap1.adb
@@ -163,7 +163,8 @@ package body Trans.Chap1 is
if Global_Storage = O_Storage_External then
-- Entity declaration subprograms.
- Chap4.Translate_Declaration_Chain_Subprograms (Entity);
+ Chap4.Translate_Declaration_Chain_Subprograms
+ (Entity, Subprg_Translate_Spec_And_Body);
else
-- Entity declaration and process subprograms.
Chap9.Translate_Block_Subprograms (Entity, Entity);
diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb
index 83bc97b31..df3298347 100644
--- a/src/vhdl/translate/trans-chap2.adb
+++ b/src/vhdl/translate/trans-chap2.adb
@@ -528,7 +528,8 @@ package body Trans.Chap2 is
Subprgs.Start_Prev_Subprg_Instance_Use_Via_Field
(Prev_Subprg_Instances, Upframe_Field);
- Chap4.Translate_Declaration_Chain_Subprograms (Subprg);
+ Chap4.Translate_Declaration_Chain_Subprograms
+ (Subprg, Subprg_Translate_Spec_And_Body);
-- Link to previous frame
Subprgs.Finish_Prev_Subprg_Instance_Use_Via_Field
@@ -556,7 +557,8 @@ package body Trans.Chap2 is
if not Has_Suspend and not Has_Nested then
Chap4.Translate_Declaration_Chain (Subprg);
Rtis.Generate_Subprogram_Body (Subprg);
- Chap4.Translate_Declaration_Chain_Subprograms (Subprg);
+ Chap4.Translate_Declaration_Chain_Subprograms
+ (Subprg, Subprg_Translate_Spec_And_Body);
else
New_Var_Decl (Frame_Ptr, Get_Identifier ("FRAMEPTR"),
O_Storage_Local, Frame_Ptr_Type);
@@ -827,7 +829,8 @@ package body Trans.Chap2 is
if not Is_Nested then
-- For nested package, this will be translated when translating
-- subprograms.
- Chap4.Translate_Declaration_Chain_Subprograms (Decl);
+ Chap4.Translate_Declaration_Chain_Subprograms
+ (Decl, Subprg_Translate_Spec_And_Body);
end if;
-- Declare elaborator for the body.
@@ -963,7 +966,8 @@ package body Trans.Chap2 is
if not Is_Nested then
-- Translate subprograms. For nested package, this has to be called
-- when translating subprograms.
- Chap4.Translate_Declaration_Chain_Subprograms (Bod);
+ Chap4.Translate_Declaration_Chain_Subprograms
+ (Bod, Subprg_Translate_Spec_And_Body);
end if;
if Is_Spec_Decl and then Is_Uninstantiated_Package (Spec) then
diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb
index 0cfaecd71..39c170d2d 100644
--- a/src/vhdl/translate/trans-chap3.adb
+++ b/src/vhdl/translate/trans-chap3.adb
@@ -1543,7 +1543,7 @@ package body Trans.Chap3 is
Pop_Identifier_Prefix (Mark);
end Translate_Protected_Type;
- procedure Translate_Protected_Type_Subprograms
+ procedure Translate_Protected_Type_Subprograms_Spec
(Def : Iir_Protected_Type_Declaration)
is
Info : constant Type_Info_Acc := Get_Info (Def);
@@ -1595,7 +1595,7 @@ package body Trans.Chap3 is
Subprgs.Pop_Subprg_Instance (Wki_Obj, Prev_Subprg_Instance);
Pop_Identifier_Prefix (Mark);
- end Translate_Protected_Type_Subprograms;
+ end Translate_Protected_Type_Subprograms_Spec;
procedure Translate_Protected_Type_Body (Bod : Iir)
is
@@ -1618,7 +1618,6 @@ package body Trans.Chap3 is
Chap4.Translate_Declaration_Chain (Bod);
Pop_Instance_Factory (Info.B.Prot_Scope'Unrestricted_Access);
- -- Info.Ortho_Type (Mode_Value) := Get_Scope_Type (Info.B.Prot_Scope);
Pop_Identifier_Prefix (Mark);
end Translate_Protected_Type_Body;
@@ -1644,8 +1643,8 @@ package body Trans.Chap3 is
Mark : Id_Mark_Type;
Decl : constant Iir := Get_Protected_Type_Declaration (Bod);
Info : constant Type_Info_Acc := Get_Info (Decl);
- Final : Boolean;
Prev_Subprg_Instance : Subprgs.Subprg_Instance_Stack;
+ Final : Boolean;
begin
Push_Identifier_Prefix (Mark, Get_Identifier (Bod));
@@ -1657,7 +1656,8 @@ package body Trans.Chap3 is
Subprgs.Start_Prev_Subprg_Instance_Use_Via_Field
(Prev_Subprg_Instance, Info.B.Prot_Subprg_Instance_Field);
- Chap4.Translate_Declaration_Chain_Subprograms (Bod);
+ Chap4.Translate_Declaration_Chain_Subprograms
+ (Bod, Subprg_Translate_Spec_And_Body);
Subprgs.Finish_Prev_Subprg_Instance_Use_Via_Field
(Prev_Subprg_Instance, Info.B.Prot_Subprg_Instance_Field);
@@ -2349,29 +2349,33 @@ package body Trans.Chap3 is
Create_Scalar_Type_Range_Type (Def, True);
end Translate_Bool_Type_Definition;
- procedure Translate_Type_Subprograms (Decl : Iir)
+ procedure Translate_Type_Subprograms
+ (Decl : Iir; Kind : Subprg_Translate_Kind)
is
- Def : Iir;
+ Def : constant Iir := Get_Type_Definition (Decl);
Tinfo : Type_Info_Acc;
Id : Name_Id;
begin
- Def := Get_Type_Definition (Decl);
-
- if Get_Kind (Def) in Iir_Kinds_Subtype_Definition then
- -- Also elaborate the base type, iff DEF and its BASE_TYPE have
- -- been declared by the same type declarator. This avoids several
- -- elaboration of the same type.
- Def := Get_Base_Type (Def);
-
- -- Consistency check.
- pragma Assert (Get_Type_Declarator (Def) = Decl);
- elsif Get_Kind (Def) = Iir_Kind_Incomplete_Type_Definition then
- return;
- end if;
-
- if Get_Kind (Def) = Iir_Kind_Protected_Type_Declaration then
- Translate_Protected_Type_Subprograms (Def);
- end if;
+ case Get_Kind (Def) is
+ when Iir_Kind_Incomplete_Type_Definition =>
+ return;
+ when Iir_Kind_Protected_Type_Declaration =>
+ Translate_Protected_Type_Subprograms_Spec (Def);
+ return;
+ when Iir_Kind_Record_Type_Definition
+ | Iir_Kind_Array_Type_Definition =>
+ null;
+ when Iir_Kind_Integer_Type_Definition
+ | Iir_Kind_Enumeration_Type_Definition
+ | Iir_Kind_Floating_Type_Definition
+ | Iir_Kind_Physical_Type_Definition
+ | Iir_Kind_File_Type_Definition
+ | Iir_Kind_Access_Type_Definition =>
+ -- Never complex.
+ return;
+ when others =>
+ raise Internal_Error;
+ end case;
Tinfo := Get_Info (Def);
if not Is_Complex_Type (Tinfo)
@@ -2380,32 +2384,36 @@ package body Trans.Chap3 is
return;
end if;
- -- Declare subprograms.
- Id := Get_Identifier (Decl);
- Create_Builder_Subprogram_Decl (Tinfo, Id, Mode_Value);
- if Get_Has_Signal_Flag (Def) then
- Create_Builder_Subprogram_Decl (Tinfo, Id, Mode_Signal);
+ if Kind in Subprg_Translate_Spec then
+ -- Declare subprograms.
+ Id := Get_Identifier (Decl);
+ Create_Builder_Subprogram_Decl (Tinfo, Id, Mode_Value);
+ if Get_Has_Signal_Flag (Def) then
+ Create_Builder_Subprogram_Decl (Tinfo, Id, Mode_Signal);
+ end if;
end if;
- if Global_Storage = O_Storage_External then
- return;
- end if;
+ if Kind in Subprg_Translate_Body then
+ if Global_Storage = O_Storage_External then
+ return;
+ end if;
- -- Define subprograms.
- case Get_Kind (Def) is
- when Iir_Kind_Array_Type_Definition =>
- Create_Array_Type_Builder (Def, Mode_Value);
- if Get_Has_Signal_Flag (Def) then
- Create_Array_Type_Builder (Def, Mode_Signal);
- end if;
- when Iir_Kind_Record_Type_Definition =>
- Create_Record_Type_Builder (Def, Mode_Value);
- if Get_Has_Signal_Flag (Def) then
- Create_Record_Type_Builder (Def, Mode_Signal);
- end if;
- when others =>
- Error_Kind ("translate_type_subprograms", Def);
- end case;
+ -- Define subprograms.
+ case Get_Kind (Def) is
+ when Iir_Kind_Array_Type_Definition =>
+ Create_Array_Type_Builder (Def, Mode_Value);
+ if Get_Has_Signal_Flag (Def) then
+ Create_Array_Type_Builder (Def, Mode_Signal);
+ end if;
+ when Iir_Kind_Record_Type_Definition =>
+ Create_Record_Type_Builder (Def, Mode_Value);
+ if Get_Has_Signal_Flag (Def) then
+ Create_Record_Type_Builder (Def, Mode_Signal);
+ end if;
+ when others =>
+ Error_Kind ("translate_type_subprograms", Def);
+ end case;
+ end if;
end Translate_Type_Subprograms;
-- Initialize the objects related to a type (type range and type
diff --git a/src/vhdl/translate/trans-chap3.ads b/src/vhdl/translate/trans-chap3.ads
index ec0921b01..70a6fa35d 100644
--- a/src/vhdl/translate/trans-chap3.ads
+++ b/src/vhdl/translate/trans-chap3.ads
@@ -44,7 +44,8 @@ package Trans.Chap3 is
procedure Translate_Anonymous_Type_Definition (Def : Iir);
-- Translate subprograms for types.
- procedure Translate_Type_Subprograms (Decl : Iir);
+ procedure Translate_Type_Subprograms
+ (Decl : Iir; Kind : Subprg_Translate_Kind);
procedure Create_Type_Definition_Type_Range (Def : Iir);
function Create_Static_Composite_Subtype_Bounds (Def : Iir) return O_Cnode;
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb
index 7d20e51fe..97bef532e 100644
--- a/src/vhdl/translate/trans-chap4.adb
+++ b/src/vhdl/translate/trans-chap4.adb
@@ -2321,7 +2321,8 @@ package body Trans.Chap4 is
Create_Union_Scope (State_Scope.all, Scope_Type);
end Translate_Statements_Chain_State_Declaration;
- procedure Translate_Declaration_Chain_Subprograms (Parent : Iir)
+ procedure Translate_Declaration_Chain_Subprograms
+ (Parent : Iir; What : Subprg_Translate_Kind)
is
El : Iir;
Infos : Chap7.Implicit_Subprogram_Infos;
@@ -2341,51 +2342,68 @@ package body Trans.Chap4 is
| Iir_Predefined_Record_Equality =>
-- Used implicitly in case statement or other
-- predefined equality.
- Chap7.Translate_Implicit_Subprogram_Spec
- (El, Infos);
- Chap7.Translate_Implicit_Subprogram_Body (El);
+ if What in Subprg_Translate_Spec then
+ Chap7.Translate_Implicit_Subprogram_Spec
+ (El, Infos);
+ end if;
+ if What in Subprg_Translate_Body then
+ Chap7.Translate_Implicit_Subprogram_Body (El);
+ end if;
when others =>
null;
end case;
else
- Chap7.Translate_Implicit_Subprogram_Spec (El, Infos);
- Chap7.Translate_Implicit_Subprogram_Body (El);
+ if What in Subprg_Translate_Spec then
+ Chap7.Translate_Implicit_Subprogram_Spec
+ (El, Infos);
+ end if;
+ if What in Subprg_Translate_Body then
+ Chap7.Translate_Implicit_Subprogram_Body (El);
+ end if;
end if;
else
-- Translate only if used.
- if Get_Info (El) /= null then
+ if What in Subprg_Translate_Spec
+ and then Get_Info (El) /= null
+ then
Chap2.Translate_Subprogram_Declaration (El);
Translate_Resolution_Function (El);
end if;
end if;
when Iir_Kind_Function_Body
- | Iir_Kind_Procedure_Body =>
- -- Do not translate body if generating only specs (for
- -- subprograms in an entity).
- if Global_Storage /= O_Storage_External
- and then
- (not Flag_Discard_Unused
- or else
- Get_Use_Flag (Get_Subprogram_Specification (El)))
- then
- Chap2.Translate_Subprogram_Body (El);
- Translate_Resolution_Function_Body
- (Get_Subprogram_Specification (El));
+ | Iir_Kind_Procedure_Body =>
+ if What in Subprg_Translate_Body then
+ -- Do not translate body if generating only specs (for
+ -- subprograms in an entity).
+ if Global_Storage /= O_Storage_External
+ and then
+ (not Flag_Discard_Unused
+ or else
+ Get_Use_Flag (Get_Subprogram_Specification (El)))
+ then
+ Chap2.Translate_Subprogram_Body (El);
+ Translate_Resolution_Function_Body
+ (Get_Subprogram_Specification (El));
+ end if;
end if;
when Iir_Kind_Type_Declaration
| Iir_Kind_Anonymous_Type_Declaration =>
- Chap3.Translate_Type_Subprograms (El);
+ Chap3.Translate_Type_Subprograms (El, What);
Chap7.Init_Implicit_Subprogram_Infos (Infos);
when Iir_Kind_Protected_Type_Body =>
- Chap3.Translate_Protected_Type_Body (El);
- Chap3.Translate_Protected_Type_Body_Subprograms (El);
+ if What in Subprg_Translate_Spec then
+ Chap3.Translate_Protected_Type_Body (El);
+ end if;
+ if What in Subprg_Translate_Body then
+ Chap3.Translate_Protected_Type_Body_Subprograms (El);
+ end if;
when Iir_Kind_Package_Declaration
| Iir_Kind_Package_Body =>
declare
Mark : Id_Mark_Type;
begin
Push_Identifier_Prefix (Mark, Get_Identifier (El));
- Translate_Declaration_Chain_Subprograms (El);
+ Translate_Declaration_Chain_Subprograms (El, What);
Pop_Identifier_Prefix (Mark);
end;
when Iir_Kind_Package_Instantiation_Declaration =>
@@ -2397,11 +2415,11 @@ package body Trans.Chap4 is
Mark : Id_Mark_Type;
begin
Push_Identifier_Prefix (Mark, Get_Identifier (El));
- Translate_Declaration_Chain_Subprograms (El);
+ Translate_Declaration_Chain_Subprograms (El, What);
if Is_Valid (Bod)
and then Global_Storage /= O_Storage_External
then
- Translate_Declaration_Chain_Subprograms (Bod);
+ Translate_Declaration_Chain_Subprograms (Bod, What);
end if;
Pop_Identifier_Prefix (Mark);
end;
diff --git a/src/vhdl/translate/trans-chap4.ads b/src/vhdl/translate/trans-chap4.ads
index cfc1917fe..6ada12419 100644
--- a/src/vhdl/translate/trans-chap4.ads
+++ b/src/vhdl/translate/trans-chap4.ads
@@ -36,7 +36,8 @@ package Trans.Chap4 is
(Stmts : Iir; State_Scope : Var_Scope_Acc);
-- Translate subprograms in declaration chain of PARENT.
- procedure Translate_Declaration_Chain_Subprograms (Parent : Iir);
+ procedure Translate_Declaration_Chain_Subprograms
+ (Parent : Iir; What : Subprg_Translate_Kind);
-- Create subprograms for type/function conversion of signal
-- associations.
diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb
index 1b8f55a43..bbad1754a 100644
--- a/src/vhdl/translate/trans-chap9.adb
+++ b/src/vhdl/translate/trans-chap9.adb
@@ -996,7 +996,8 @@ package body Trans.Chap9 is
Stmt : Iir;
Mark : Id_Mark_Type;
begin
- Chap4.Translate_Declaration_Chain_Subprograms (Block);
+ Chap4.Translate_Declaration_Chain_Subprograms
+ (Block, Subprg_Translate_Spec_And_Body);
Stmt := Get_Concurrent_Statement_Chain (Block);
while Stmt /= Null_Iir loop
@@ -1008,7 +1009,8 @@ package body Trans.Chap9 is
Chap9.Set_Direct_Drivers (Stmt);
end if;
- Chap4.Translate_Declaration_Chain_Subprograms (Stmt);
+ Chap4.Translate_Declaration_Chain_Subprograms
+ (Stmt, Subprg_Translate_Spec_And_Body);
Translate_Process_Statement (Stmt, Base_Info);
if Flag_Direct_Drivers then
diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads
index 80392c86e..598e662f4 100644
--- a/src/vhdl/translate/trans.ads
+++ b/src/vhdl/translate/trans.ads
@@ -171,6 +171,16 @@ package Trans is
type Allocation_Kind is
(Alloc_Stack, Alloc_Return, Alloc_Heap, Alloc_System);
+ -- Sometimes useful to factorize code. Defines what has to be translated.
+ type Subprg_Translate_Kind is
+ (Subprg_Translate_Only_Spec,
+ Subprg_Translate_Spec_And_Body,
+ Subprg_Translate_Only_Body);
+ subtype Subprg_Translate_Spec is Subprg_Translate_Kind range
+ Subprg_Translate_Only_Spec .. Subprg_Translate_Spec_And_Body;
+ subtype Subprg_Translate_Body is Subprg_Translate_Kind range
+ Subprg_Translate_Spec_And_Body .. Subprg_Translate_Only_Body;
+
-- Return the value of field FIELD of lnode L that is contains
-- a pointer to a record.
-- This is equivalent to: