aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--src/vhdl/translate/trans-chap2.adb123
-rw-r--r--src/vhdl/translate/trans-chap3.adb37
-rw-r--r--src/vhdl/translate/trans-chap3.ads3
-rw-r--r--src/vhdl/translate/trans-chap4.adb37
-rw-r--r--src/vhdl/translate/trans.adb15
-rw-r--r--src/vhdl/translate/trans.ads9
6 files changed, 123 insertions, 101 deletions
diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb
index df3298347..d24700f3e 100644
--- a/src/vhdl/translate/trans-chap2.adb
+++ b/src/vhdl/translate/trans-chap2.adb
@@ -426,6 +426,7 @@ package body Trans.Chap2 is
Frame_Ptr_Type : O_Tnode;
Upframe_Field : O_Fnode;
+ Upframe_Scope : Var_Scope_Acc;
Frame : O_Dnode;
Frame_Ptr : O_Dnode;
@@ -457,7 +458,7 @@ package body Trans.Chap2 is
-- Unnest subprograms.
-- Create an instance for the local declarations.
Push_Instance_Factory (Info.Subprg_Frame_Scope'Access);
- Add_Subprg_Instance_Field (Upframe_Field);
+ Add_Subprg_Instance_Field (Upframe_Field, Upframe_Scope);
if Info.Subprg_Params_Ptr /= O_Tnode_Null then
-- Field for the parameters structure
@@ -526,14 +527,14 @@ package body Trans.Chap2 is
Wki_Upframe, Prev_Subprg_Instances);
-- Link to previous frame
Subprgs.Start_Prev_Subprg_Instance_Use_Via_Field
- (Prev_Subprg_Instances, Upframe_Field);
+ (Upframe_Scope, Upframe_Field);
Chap4.Translate_Declaration_Chain_Subprograms
(Subprg, Subprg_Translate_Spec_And_Body);
-- Link to previous frame
Subprgs.Finish_Prev_Subprg_Instance_Use_Via_Field
- (Prev_Subprg_Instances, Upframe_Field);
+ (Upframe_Scope, Upframe_Field);
-- Local frame
Subprgs.Pop_Subprg_Instance (Wki_Upframe, Prev_Subprg_Instances);
end if;
@@ -796,24 +797,18 @@ package body Trans.Chap2 is
Chap2.Declare_Inst_Type_And_Ptr
(Info.Package_Body_Scope'Access, Info.Package_Body_Ptr_Type);
- if not Get_Need_Body (Decl)
- and then Get_Package_Body (Decl) = Null_Iir
- then
- -- Generic package without a body.
- -- Create an empty body instance.
- Push_Package_Instance_Factory (Decl);
- Pop_Package_Instance_Factory (Decl);
-
- Set_Scope_Via_Field (Info.Package_Spec_Scope,
- Info.Package_Spec_Field,
- Info.Package_Body_Scope'Access);
- end if;
-
-- Each subprogram has a body instance argument (because subprogram
-- bodys can access to body declarations).
Subprgs.Push_Subprg_Instance
(Info.Package_Body_Scope'Access, Info.Package_Body_Ptr_Type,
Wki_Instance, Prev_Subprg_Instance);
+
+ if not Is_Nested then
+ -- For nested package, this will be translated when translating
+ -- subprograms.
+ Chap4.Translate_Declaration_Chain_Subprograms
+ (Decl, Subprg_Translate_Only_Spec);
+ end if;
else
if Header /= Null_Iir then
Chap4.Translate_Generic_Chain (Header);
@@ -823,64 +818,74 @@ package body Trans.Chap2 is
Info.Package_Elab_Var := Create_Var
(Create_Var_Identifier ("ELABORATED"), Ghdl_Bool_Type);
end if;
- end if;
- -- Translate subprograms declarations.
- if not Is_Nested then
- -- For nested package, this will be translated when translating
- -- subprograms.
- Chap4.Translate_Declaration_Chain_Subprograms
- (Decl, Subprg_Translate_Spec_And_Body);
+ -- Translate subprograms declarations.
+ if not Is_Nested then
+ -- For nested package, this will be translated when translating
+ -- subprograms.
+ Chap4.Translate_Declaration_Chain_Subprograms
+ (Decl, Subprg_Translate_Spec_And_Body);
+ end if;
end if;
- -- Declare elaborator for the body.
if not Is_Nested then
+ -- Declare elaborator for the spec.
+ Start_Procedure_Decl
+ (Interface_List, Create_Identifier ("ELAB_SPEC"), Global_Storage);
+ Subprgs.Add_Subprg_Instance_Interfaces
+ (Interface_List, Info.Package_Elab_Spec_Instance);
+ Finish_Subprogram_Decl
+ (Interface_List, Info.Package_Elab_Spec_Subprg);
+
+ -- Declare elaborator for the body.
Start_Procedure_Decl
(Interface_List, Create_Identifier ("ELAB_BODY"), Global_Storage);
Subprgs.Add_Subprg_Instance_Interfaces
(Interface_List, Info.Package_Elab_Body_Instance);
Finish_Subprogram_Decl
(Interface_List, Info.Package_Elab_Body_Subprg);
+
+ if Flag_Rti then
+ -- Generate RTI.
+ Rtis.Generate_Unit (Decl);
+ end if;
end if;
if Is_Uninstantiated then
- Subprgs.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance);
-
if not Get_Need_Body (Decl)
and then Get_Package_Body (Decl) = Null_Iir
then
- Clear_Scope (Info.Package_Spec_Scope);
- end if;
+ -- Generic package without a body.
+ -- Create an empty body instance.
+ Push_Package_Instance_Factory (Decl);
+ Pop_Package_Instance_Factory (Decl);
- -- The spec elaborator has a spec instance argument.
- Subprgs.Push_Subprg_Instance
- (Info.Package_Spec_Scope'Access, Info.Package_Spec_Ptr_Type,
- Wki_Instance, Prev_Subprg_Instance);
- end if;
+ Set_Scope_Via_Field (Info.Package_Spec_Scope,
+ Info.Package_Spec_Field,
+ Info.Package_Body_Scope'Access);
- if not Is_Nested then
- -- Declare elaborator for the spec.
- Start_Procedure_Decl
- (Interface_List, Create_Identifier ("ELAB_SPEC"), Global_Storage);
- Subprgs.Add_Subprg_Instance_Interfaces
- (Interface_List, Info.Package_Elab_Spec_Instance);
- Finish_Subprogram_Decl
- (Interface_List, Info.Package_Elab_Spec_Subprg);
+ if not Is_Nested
+ and then Global_Storage /= O_Storage_External
+ then
+ -- For nested package, this will be translated when translating
+ -- subprograms.
+ Chap4.Translate_Declaration_Chain_Subprograms
+ (Decl, Subprg_Translate_Only_Body);
- if Flag_Rti then
- -- Generate RTI.
- Rtis.Generate_Unit (Decl);
+ -- Create elaboration procedure for the spec
+ Elab_Package (Decl, Header);
+ end if;
end if;
- if Global_Storage /= O_Storage_External then
+ Subprgs.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance);
+ else
+ if not Is_Nested
+ and then Global_Storage /= O_Storage_External
+ then
-- Create elaboration procedure for the spec
Elab_Package (Decl, Header);
end if;
end if;
-
- if Is_Uninstantiated then
- Subprgs.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance);
- end if;
Save_Local_Identifier (Info.Package_Local_Id);
if Is_Nested then
@@ -971,8 +976,12 @@ package body Trans.Chap2 is
end if;
if Is_Spec_Decl and then Is_Uninstantiated_Package (Spec) then
- Clear_Scope (Info.Package_Spec_Scope);
Subprgs.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance);
+ if not Is_Nested then
+ Chap4.Translate_Declaration_Chain_Subprograms
+ (Spec, Subprg_Translate_Only_Body);
+ Elab_Package (Spec, Get_Package_Header (Spec));
+ end if;
end if;
if not Is_Nested then
@@ -1055,12 +1064,6 @@ package body Trans.Chap2 is
Push_Local_Factory;
Subprgs.Start_Subprg_Instance_Use (Info.Package_Elab_Body_Instance);
- if Is_Spec_Decl and then Is_Uninstantiated_Package (Spec) then
- Set_Scope_Via_Field (Info.Package_Spec_Scope,
- Info.Package_Spec_Field,
- Info.Package_Body_Scope'Access);
- end if;
-
-- If the package was already elaborated, return now,
-- else mark the package as elaborated.
Start_If_Stmt (If_Blk, New_Value (Get_Var (Info.Package_Elab_Var)));
@@ -1082,10 +1085,6 @@ package body Trans.Chap2 is
Close_Temp;
end if;
- if Is_Spec_Decl and then Is_Uninstantiated_Package (Spec) then
- Clear_Scope (Info.Package_Spec_Scope);
- end if;
-
Subprgs.Finish_Subprg_Instance_Use (Info.Package_Elab_Body_Instance);
Pop_Local_Factory;
Finish_Subprogram_Body;
@@ -1542,13 +1541,9 @@ package body Trans.Chap2 is
Set_Scope_Via_Var (Pkg_Info.Package_Body_Scope,
Info.Package_Instance_Body_Var);
- Set_Scope_Via_Field (Pkg_Info.Package_Spec_Scope,
- Pkg_Info.Package_Spec_Field,
- Pkg_Info.Package_Body_Scope'Access);
Chap5.Elab_Generic_Map_Aspect
(Get_Package_Header (Spec), Inst,
(Pkg_Info.Package_Body_Scope'Access, Pkg_Info.Package_Body_Scope));
- Clear_Scope (Pkg_Info.Package_Spec_Scope);
-- Call the elaborator of the generic. The generic must be
-- temporary associated with the instance variable.
diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb
index 39c170d2d..ecc5906a8 100644
--- a/src/vhdl/translate/trans-chap3.adb
+++ b/src/vhdl/translate/trans-chap3.adb
@@ -1609,7 +1609,8 @@ package body Trans.Chap3 is
-- Create the object type
Push_Instance_Factory (Info.B.Prot_Scope'Unrestricted_Access);
-- First, the previous instance.
- Subprgs.Add_Subprg_Instance_Field (Info.B.Prot_Subprg_Instance_Field);
+ Subprgs.Add_Subprg_Instance_Field
+ (Info.B.Prot_Subprg_Instance_Field, Info.B.Prot_Prev_Scope);
-- Then the object lock
Info.B.Prot_Lock_Field := Add_Instance_Factory_Field
(Get_Identifier ("LOCK"), Ghdl_Ptr_Type);
@@ -1638,13 +1639,12 @@ package body Trans.Chap3 is
New_Procedure_Call (Assoc);
end Call_Ghdl_Protected_Procedure;
- procedure Translate_Protected_Type_Body_Subprograms (Bod : Iir)
+ procedure Translate_Protected_Type_Body_Subprograms_Spec (Bod : Iir)
is
Mark : Id_Mark_Type;
Decl : constant Iir := Get_Protected_Type_Declaration (Bod);
Info : constant Type_Info_Acc := Get_Info (Decl);
Prev_Subprg_Instance : Subprgs.Subprg_Instance_Stack;
- Final : Boolean;
begin
Push_Identifier_Prefix (Mark, Get_Identifier (Bod));
@@ -1653,23 +1653,32 @@ package body Trans.Chap3 is
Info.Ortho_Ptr_Type (Mode_Value),
Wki_Obj,
Prev_Subprg_Instance);
+
+ -- Environment is referenced through the object.
Subprgs.Start_Prev_Subprg_Instance_Use_Via_Field
- (Prev_Subprg_Instance, Info.B.Prot_Subprg_Instance_Field);
+ (Info.B.Prot_Prev_Scope, Info.B.Prot_Subprg_Instance_Field);
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);
Subprgs.Pop_Subprg_Instance (Wki_Obj, Prev_Subprg_Instance);
+ Subprgs.Finish_Prev_Subprg_Instance_Use_Via_Field
+ (Info.B.Prot_Prev_Scope, Info.B.Prot_Subprg_Instance_Field);
+
Pop_Identifier_Prefix (Mark);
+ end Translate_Protected_Type_Body_Subprograms_Spec;
- if Global_Storage = O_Storage_External then
- return;
- end if;
+ procedure Translate_Protected_Type_Body_Subprograms_Body (Bod : Iir)
+ is
+ Decl : constant Iir := Get_Protected_Type_Declaration (Bod);
+ Info : constant Type_Info_Acc := Get_Info (Decl);
+ Final : Boolean;
+ begin
+ pragma Assert (Global_Storage /= O_Storage_External);
-- Init subprogram
+ -- Contrary to other subprograms, no object is passed to it.
declare
Var_Obj : O_Dnode;
begin
@@ -1709,6 +1718,9 @@ package body Trans.Chap3 is
Finish_Subprogram_Body;
end;
+-- Chap4.Translate_Declaration_Chain_Subprograms
+-- (Bod, Subprg_Translate_Only_Body);
+
-- Fini subprogram
begin
Start_Subprogram_Body (Info.B.Prot_Final_Subprg);
@@ -1725,7 +1737,8 @@ package body Trans.Chap3 is
Subprgs.Finish_Subprg_Instance_Use (Info.B.Prot_Final_Instance);
Finish_Subprogram_Body;
end;
- end Translate_Protected_Type_Body_Subprograms;
+
+ end Translate_Protected_Type_Body_Subprograms_Body;
---------------
-- Scalars --
@@ -2360,7 +2373,9 @@ package body Trans.Chap3 is
when Iir_Kind_Incomplete_Type_Definition =>
return;
when Iir_Kind_Protected_Type_Declaration =>
- Translate_Protected_Type_Subprograms_Spec (Def);
+ if Kind in Subprg_Translate_Spec then
+ Translate_Protected_Type_Subprograms_Spec (Def);
+ end if;
return;
when Iir_Kind_Record_Type_Definition
| Iir_Kind_Array_Type_Definition =>
diff --git a/src/vhdl/translate/trans-chap3.ads b/src/vhdl/translate/trans-chap3.ads
index 70a6fa35d..91c13e9ff 100644
--- a/src/vhdl/translate/trans-chap3.ads
+++ b/src/vhdl/translate/trans-chap3.ads
@@ -58,7 +58,8 @@ package Trans.Chap3 is
procedure Call_Ghdl_Protected_Procedure (Type_Def : Iir; Proc : O_Dnode);
procedure Translate_Protected_Type_Body (Bod : Iir);
- procedure Translate_Protected_Type_Body_Subprograms (Bod : Iir);
+ procedure Translate_Protected_Type_Body_Subprograms_Spec (Bod : Iir);
+ procedure Translate_Protected_Type_Body_Subprograms_Body (Bod : Iir);
-- Translate_type_definition_Elab do 4 and 6.
-- It generates code to do type elaboration.
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb
index 97bef532e..88ab87206 100644
--- a/src/vhdl/translate/trans-chap4.adb
+++ b/src/vhdl/translate/trans-chap4.adb
@@ -2324,6 +2324,14 @@ package body Trans.Chap4 is
procedure Translate_Declaration_Chain_Subprograms
(Parent : Iir; What : Subprg_Translate_Kind)
is
+ -- True iff specs must be translated.
+ Do_Specs : constant Boolean := What in Subprg_Translate_Spec;
+
+ -- True iff bodies must be translated.
+ Do_Bodies : constant Boolean :=
+ (What in Subprg_Translate_Body
+ and then Global_Storage /= O_Storage_External);
+
El : Iir;
Infos : Chap7.Implicit_Subprogram_Infos;
begin
@@ -2342,44 +2350,40 @@ package body Trans.Chap4 is
| Iir_Predefined_Record_Equality =>
-- Used implicitly in case statement or other
-- predefined equality.
- if What in Subprg_Translate_Spec then
+ if Do_Specs then
Chap7.Translate_Implicit_Subprogram_Spec
(El, Infos);
end if;
- if What in Subprg_Translate_Body then
+ if Do_Bodies then
Chap7.Translate_Implicit_Subprogram_Body (El);
end if;
when others =>
null;
end case;
else
- if What in Subprg_Translate_Spec then
+ if Do_Specs then
Chap7.Translate_Implicit_Subprogram_Spec
(El, Infos);
end if;
- if What in Subprg_Translate_Body then
+ if Do_Bodies then
Chap7.Translate_Implicit_Subprogram_Body (El);
end if;
end if;
else
-- Translate only if used.
- if What in Subprg_Translate_Spec
- and then Get_Info (El) /= null
- then
+ if Do_Specs 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 =>
- if What in Subprg_Translate_Body then
+ if Do_Bodies 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)))
+ if not Flag_Discard_Unused
+ or else
+ Get_Use_Flag (Get_Subprogram_Specification (El))
then
Chap2.Translate_Subprogram_Body (El);
Translate_Resolution_Function_Body
@@ -2391,11 +2395,12 @@ package body Trans.Chap4 is
Chap3.Translate_Type_Subprograms (El, What);
Chap7.Init_Implicit_Subprogram_Infos (Infos);
when Iir_Kind_Protected_Type_Body =>
- if What in Subprg_Translate_Spec then
+ if Do_Specs then
Chap3.Translate_Protected_Type_Body (El);
end if;
- if What in Subprg_Translate_Body then
- Chap3.Translate_Protected_Type_Body_Subprograms (El);
+ if Do_Bodies then
+ Chap3.Translate_Protected_Type_Body_Subprograms_Spec (El);
+ Chap3.Translate_Protected_Type_Body_Subprograms_Body (El);
end if;
when Iir_Kind_Package_Declaration
| Iir_Kind_Package_Body =>
diff --git a/src/vhdl/translate/trans.adb b/src/vhdl/translate/trans.adb
index d41458d08..1f9d177a4 100644
--- a/src/vhdl/translate/trans.adb
+++ b/src/vhdl/translate/trans.adb
@@ -76,14 +76,17 @@ package body Trans is
end if;
end Add_Subprg_Instance_Interfaces;
- procedure Add_Subprg_Instance_Field (Field : out O_Fnode) is
+ procedure Add_Subprg_Instance_Field
+ (Field : out O_Fnode; Prev_Scope : out Var_Scope_Acc) is
begin
if Has_Current_Subprg_Instance then
Field := Add_Instance_Factory_Field
(Current_Subprg_Instance.Ident,
Current_Subprg_Instance.Ptr_Type);
+ Prev_Scope := Current_Subprg_Instance.Scope;
else
Field := O_Fnode_Null;
+ Prev_Scope := null;
end if;
end Add_Subprg_Instance_Field;
@@ -113,7 +116,7 @@ package body Trans is
(Var : O_Dnode; Field : O_Fnode; Vars : Subprg_Instance_Type)
is
begin
- if Has_Subprg_Instance (Vars) then
+ if Has_Subprg_Instance (Vars) and then Field /= O_Fnode_Null then
New_Assign_Stmt (New_Selected_Acc_Value (New_Obj (Var), Field),
New_Obj_Value (Vars.Inter));
end if;
@@ -134,19 +137,19 @@ package body Trans is
end Finish_Subprg_Instance_Use;
procedure Start_Prev_Subprg_Instance_Use_Via_Field
- (Prev : Subprg_Instance_Stack; Field : O_Fnode) is
+ (Prev_Scope : Var_Scope_Acc; Field : O_Fnode) is
begin
if Field /= O_Fnode_Null then
- Set_Scope_Via_Field_Ptr (Prev.Scope.all, Field,
+ Set_Scope_Via_Field_Ptr (Prev_Scope.all, Field,
Current_Subprg_Instance.Scope);
end if;
end Start_Prev_Subprg_Instance_Use_Via_Field;
procedure Finish_Prev_Subprg_Instance_Use_Via_Field
- (Prev : Subprg_Instance_Stack; Field : O_Fnode) is
+ (Prev_Scope : Var_Scope_Acc; Field : O_Fnode) is
begin
if Field /= O_Fnode_Null then
- Clear_Scope (Prev.Scope.all);
+ Clear_Scope (Prev_Scope.all);
end if;
end Finish_Prev_Subprg_Instance_Use_Via_Field;
diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads
index 598e662f4..a93f38198 100644
--- a/src/vhdl/translate/trans.ads
+++ b/src/vhdl/translate/trans.ads
@@ -602,7 +602,8 @@ package Trans is
-- Add a field in the current factory that reference the current
-- instance.
- procedure Add_Subprg_Instance_Field (Field : out O_Fnode);
+ procedure Add_Subprg_Instance_Field
+ (Field : out O_Fnode; Prev_Scope : out Var_Scope_Acc);
-- Associate values to the instance interface during invocation of a
-- subprogram.
@@ -628,9 +629,9 @@ package Trans is
-- Call Push_Scope to reference instance from FIELD.
procedure Start_Prev_Subprg_Instance_Use_Via_Field
- (Prev : Subprg_Instance_Stack; Field : O_Fnode);
+ (Prev_Scope : Var_Scope_Acc; Field : O_Fnode);
procedure Finish_Prev_Subprg_Instance_Use_Via_Field
- (Prev : Subprg_Instance_Stack; Field : O_Fnode);
+ (Prev_Scope : Var_Scope_Acc; Field : O_Fnode);
-- Same as above, but for IIR.
procedure Create_Subprg_Instance (Interfaces : in out O_Inter_List;
@@ -754,6 +755,7 @@ package Trans is
when Kind_Type_Protected =>
Prot_Scope : aliased Var_Scope_Type;
+ Prot_Prev_Scope : Var_Scope_Acc;
-- Init procedure for the protected type.
Prot_Init_Subprg : O_Dnode;
@@ -851,6 +853,7 @@ package Trans is
(Kind => Kind_Type_Protected,
Rti_Max_Depth => 0,
Prot_Scope => Null_Var_Scope,
+ Prot_Prev_Scope => null,
Prot_Init_Subprg => O_Dnode_Null,
Prot_Init_Instance => Subprgs.Null_Subprg_Instance,
Prot_Final_Subprg => O_Dnode_Null,