aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2015-01-03 11:59:43 +0100
committerTristan Gingold <tgingold@free.fr>2015-01-03 11:59:43 +0100
commit3fea917ef9a145d448ab2dd5d83d7ac7de280602 (patch)
treea83cb707f28c353b6bedde63b500dc1562d8adf3
parent4e27c73749284b46b899851f3b1ef00fe5187b47 (diff)
downloadghdl-3fea917ef9a145d448ab2dd5d83d7ac7de280602.tar.gz
ghdl-3fea917ef9a145d448ab2dd5d83d7ac7de280602.tar.bz2
ghdl-3fea917ef9a145d448ab2dd5d83d7ac7de280602.zip
Initial rework for vhdl 2008 generate statements.
-rw-r--r--src/ghdldrv/ghdlprint.adb3
-rw-r--r--src/vhdl/canon.adb117
-rw-r--r--src/vhdl/configuration.adb17
-rw-r--r--src/vhdl/disp_vhdl.adb76
-rw-r--r--src/vhdl/errorout.adb7
-rw-r--r--src/vhdl/evaluation.adb21
-rw-r--r--src/vhdl/iirs.adb123
-rw-r--r--src/vhdl/iirs.ads120
-rw-r--r--src/vhdl/iirs_utils.adb27
-rw-r--r--src/vhdl/nodes_meta.adb338
-rw-r--r--src/vhdl/nodes_meta.ads18
-rw-r--r--src/vhdl/parse.adb207
-rw-r--r--src/vhdl/sem.adb203
-rw-r--r--src/vhdl/sem_decls.adb8
-rw-r--r--src/vhdl/sem_names.adb31
-rw-r--r--src/vhdl/sem_scopes.adb2
-rw-r--r--src/vhdl/sem_specs.adb11
-rw-r--r--src/vhdl/sem_stmts.adb105
-rw-r--r--src/vhdl/translate/trans-chap1.adb312
-rw-r--r--src/vhdl/translate/trans-chap9.adb168
-rw-r--r--src/vhdl/translate/trans-rtis.adb112
21 files changed, 1306 insertions, 720 deletions
diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb
index f685e79e4..c852cc0ae 100644
--- a/src/ghdldrv/ghdlprint.adb
+++ b/src/ghdldrv/ghdlprint.adb
@@ -1682,7 +1682,8 @@ package body Ghdlprint is
C := 'm';
when Iir_Kind_Component_Instantiation_Statement =>
C := 'I';
- when Iir_Kind_Generate_Statement =>
+ when Iir_Kind_If_Generate_Statement
+ | Iir_Kind_For_Generate_Statement =>
C := 'G';
when others =>
C := '?';
diff --git a/src/vhdl/canon.adb b/src/vhdl/canon.adb
index dc3e1af52..ad8071937 100644
--- a/src/vhdl/canon.adb
+++ b/src/vhdl/canon.adb
@@ -21,7 +21,6 @@ with Types; use Types;
with Name_Table;
with Sem;
with Iir_Chains; use Iir_Chains;
-with Flags; use Flags;
with PSL.Nodes;
with PSL.Rewrites;
with PSL.Build;
@@ -38,6 +37,8 @@ package body Canon is
Parent : Iir;
Decl_Parent : Iir);
+ procedure Canon_Concurrent_Stmts (Top : Iir_Design_Unit; Parent : Iir);
+
-- Canon on expressions, mainly for function calls.
procedure Canon_Expression (Expr: Iir);
@@ -1446,6 +1447,13 @@ package body Canon is
end loop;
end Canon_Selected_Concurrent_Signal_Assignment;
+ procedure Canon_Generate_Statement_Body
+ (Top : Iir_Design_Unit; Bod : Iir) is
+ begin
+ Canon_Declarations (Top, Bod, Bod);
+ Canon_Concurrent_Stmts (Top, Bod);
+ end Canon_Generate_Statement_Body;
+
procedure Canon_Concurrent_Stmts (Top : Iir_Design_Unit; Parent : Iir)
is
-- Current element in the chain of concurrent statements.
@@ -1651,20 +1659,31 @@ package body Canon is
Canon_Concurrent_Stmts (Top, El);
end;
- when Iir_Kind_Generate_Statement =>
+ when Iir_Kind_If_Generate_Statement =>
declare
- Scheme : Iir;
+ Clause : Iir;
+ Cond : Iir;
begin
- Scheme := Get_Generation_Scheme (El);
- if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
- Canon_Declaration (Top, Scheme, Null_Iir, Null_Iir);
- elsif Canon_Flag_Expressions then
- Canon_Expression (Scheme);
- end if;
- Canon_Declarations (Top, El, El);
- Canon_Concurrent_Stmts (Top, El);
+ Clause := El;
+ while Clause /= Null_Iir loop
+ if Canon_Flag_Expressions then
+ Cond := Get_Condition (El);
+ if Cond /= Null_Iir then
+ Canon_Expression (Cond);
+ end if;
+ end if;
+ Canon_Generate_Statement_Body
+ (Top, Get_Generate_Statement_Body (Clause));
+ Clause := Get_Generate_Else_Clause (Clause);
+ end loop;
end;
+ when Iir_Kind_For_Generate_Statement =>
+ Canon_Declaration
+ (Top, Get_Parameter_Specification (El), Null_Iir, Null_Iir);
+ Canon_Generate_Statement_Body
+ (Top, Get_Generate_Statement_Body (El));
+
when Iir_Kind_Psl_Assert_Statement
| Iir_Kind_Psl_Cover_Statement =>
declare
@@ -2084,15 +2103,6 @@ package body Canon is
end if;
end if;
end if;
- when Iir_Kind_Generate_Statement =>
- if False
- and then Vhdl_Std = Vhdl_87
- and then
- Get_Kind (Conf) = Iir_Kind_Configuration_Specification
- then
- Canon_Component_Specification_All_Others
- (Conf, El, Spec, List, Comp);
- end if;
when others =>
null;
end case;
@@ -2381,6 +2391,26 @@ package body Canon is
El : Iir;
Sub_Blk : Iir;
Last_Item : Iir;
+
+ procedure Create_Default_Block_Configuration (Targ : Iir)
+ is
+ Res : Iir;
+ Spec : Iir;
+ begin
+ Res := Create_Iir (Iir_Kind_Block_Configuration);
+ Location_Copy (Res, Targ);
+ Set_Parent (Res, Conf);
+ if True then
+ -- For debugging. Display as user block configuration.
+ Spec := Build_Simple_Name (Targ, Targ);
+ else
+ -- To reduce size, it is possible to refer directly to the block
+ -- itself, without using a name.
+ Spec := El;
+ end if;
+ Set_Block_Specification (Res, Spec);
+ Append (Last_Item, Conf, Res);
+ end Create_Default_Block_Configuration;
begin
-- Note: the only allowed declarations are use clauses, which are not
-- canonicalized.
@@ -2423,7 +2453,7 @@ package body Canon is
Set_Prev_Block_Configuration
(El, Get_Generate_Block_Configuration (Sub_Blk));
Set_Generate_Block_Configuration (Sub_Blk, El);
- when Iir_Kind_Generate_Statement =>
+ when Iir_Kind_Generate_Statement_Body =>
Set_Generate_Block_Configuration (Sub_Blk, El);
when others =>
Error_Kind ("canon_block_configuration(0)", Sub_Blk);
@@ -2495,40 +2525,37 @@ package body Canon is
end if;
end;
when Iir_Kind_Block_Statement =>
+ if Get_Block_Block_Configuration (El) = Null_Iir then
+ Create_Default_Block_Configuration (El);
+ end if;
+ when Iir_Kind_If_Generate_Statement =>
declare
- Res : Iir_Block_Configuration;
+ Bod : constant Iir := Get_Generate_Statement_Body (El);
+ Blk_Config : constant Iir_Block_Configuration :=
+ Get_Generate_Block_Configuration (Bod);
begin
- if Get_Block_Block_Configuration (El) = Null_Iir then
- Res := Create_Iir (Iir_Kind_Block_Configuration);
- Location_Copy (Res, El);
- Set_Parent (Res, Conf);
- Set_Block_Specification (Res, El);
- Append (Last_Item, Conf, Res);
+ if Blk_Config = Null_Iir then
+ Create_Default_Block_Configuration (Bod);
end if;
end;
- when Iir_Kind_Generate_Statement =>
+ when Iir_Kind_For_Generate_Statement =>
declare
+ Bod : constant Iir := Get_Generate_Statement_Body (El);
+ Blk_Config : constant Iir_Block_Configuration :=
+ Get_Generate_Block_Configuration (Bod);
Res : Iir_Block_Configuration;
- Scheme : Iir;
- Blk_Config : Iir_Block_Configuration;
Blk_Spec : Iir;
begin
- Scheme := Get_Generation_Scheme (El);
- Blk_Config := Get_Generate_Block_Configuration (El);
if Blk_Config = Null_Iir then
- -- No block configuration for the (implicit) internal
- -- block. Create one.
- Res := Create_Iir (Iir_Kind_Block_Configuration);
- Location_Copy (Res, El);
- Set_Parent (Res, Conf);
- Set_Block_Specification (Res, El);
- Append (Last_Item, Conf, Res);
- elsif Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
+ Create_Default_Block_Configuration (Bod);
+ else
Blk_Spec := Strip_Denoting_Name
(Get_Block_Specification (Blk_Config));
- if Get_Kind (Blk_Spec) /= Iir_Kind_Generate_Statement then
- -- There are partial configurations.
- -- Create a default block configuration.
+ if Get_Kind (Blk_Spec) /= Iir_Kind_For_Generate_Statement
+ then
+ -- There are generate specification with range or
+ -- expression. Create a default block configuration
+ -- for the (possible) non-covered values.
Res := Create_Iir (Iir_Kind_Block_Configuration);
Location_Copy (Res, El);
Set_Parent (Res, Conf);
@@ -2536,7 +2563,7 @@ package body Canon is
Location_Copy (Blk_Spec, Res);
Set_Index_List (Blk_Spec, Iir_List_Others);
Set_Base_Name (Blk_Spec, El);
- Set_Prefix (Blk_Spec, Build_Simple_Name (El, Res));
+ Set_Prefix (Blk_Spec, Build_Simple_Name (Bod, Res));
Set_Block_Specification (Res, Blk_Spec);
Append (Last_Item, Conf, Res);
end if;
diff --git a/src/vhdl/configuration.adb b/src/vhdl/configuration.adb
index 30d9eb116..07dce428f 100644
--- a/src/vhdl/configuration.adb
+++ b/src/vhdl/configuration.adb
@@ -215,9 +215,22 @@ package body Configuration is
-- Entity or configuration instantiation.
Add_Design_Aspect (Get_Instantiated_Unit (Stmt), True);
end if;
- when Iir_Kind_Generate_Statement
- | Iir_Kind_Block_Statement =>
+ when Iir_Kind_Block_Statement =>
Add_Design_Concurrent_Stmts (Stmt);
+ when Iir_Kind_For_Generate_Statement =>
+ Add_Design_Concurrent_Stmts
+ (Get_Generate_Statement_Body (Stmt));
+ when Iir_Kind_If_Generate_Statement =>
+ declare
+ Clause : Iir;
+ begin
+ Clause := Stmt;
+ while Clause /= Null_Iir loop
+ Add_Design_Concurrent_Stmts
+ (Get_Generate_Statement_Body (Clause));
+ Clause := Get_Generate_Else_Clause (Clause);
+ end loop;
+ end;
when Iir_Kind_Process_Statement
| Iir_Kind_Sensitized_Process_Statement
| Iir_Kind_Psl_Assert_Statement
diff --git a/src/vhdl/disp_vhdl.adb b/src/vhdl/disp_vhdl.adb
index b8ca9f400..6550d1e38 100644
--- a/src/vhdl/disp_vhdl.adb
+++ b/src/vhdl/disp_vhdl.adb
@@ -222,7 +222,8 @@ package body Disp_Vhdl is
| Iir_Kind_Simple_Name =>
Disp_Identifier (Decl);
when Iir_Kind_Block_Statement
- | Iir_Kind_Generate_Statement =>
+ | Iir_Kind_If_Generate_Statement
+ | Iir_Kind_For_Generate_Statement =>
declare
Ident : constant Name_Id := Get_Label (Decl);
begin
@@ -2797,32 +2798,58 @@ package body Disp_Vhdl is
Disp_End (Block, "block");
end Disp_Block_Statement;
- procedure Disp_Generate_Statement (Stmt : Iir_Generate_Statement)
+ procedure Disp_Generate_Statement_Body (Parent : Iir; Indent : Count)
is
- Indent : Count;
- Scheme : Iir;
+ Bod : constant Iir := Get_Generate_Statement_Body (Parent);
begin
- Indent := Col;
- Disp_Label (Stmt);
- Scheme := Get_Generation_Scheme (Stmt);
- case Get_Kind (Scheme) is
- when Iir_Kind_Iterator_Declaration =>
- Put ("for ");
- Disp_Parameter_Specification (Scheme);
- when others =>
- Put ("if ");
- Disp_Expression (Scheme);
- end case;
- Put_Line (" generate");
- Disp_Declaration_Chain (Stmt, Indent);
- if Get_Has_Begin (Stmt) then
+ Disp_Declaration_Chain (Bod, Indent);
+ if Get_Has_Begin (Bod) then
Set_Col (Indent);
Put_Line ("begin");
end if;
- Disp_Concurrent_Statement_Chain (Stmt, Indent + Indentation);
+ Disp_Concurrent_Statement_Chain (Bod, Indent + Indentation);
+ end Disp_Generate_Statement_Body;
+
+ procedure Disp_For_Generate_Statement (Stmt : Iir)
+ is
+ Indent : constant Count := Col;
+ begin
+ Disp_Label (Stmt);
+ Put ("for ");
+ Disp_Parameter_Specification (Get_Parameter_Specification (Stmt));
+ Put_Line (" generate");
+ Disp_Generate_Statement_Body (Stmt, Indent);
+ Set_Col (Indent);
+ Disp_End (Stmt, "generate");
+ end Disp_For_Generate_Statement;
+
+ procedure Disp_If_Generate_Statement (Stmt : Iir)
+ is
+ Indent : constant Count := Col;
+ Clause : Iir;
+ Cond : Iir;
+ begin
+ Disp_Label (Stmt);
+ Put ("if ");
+ Disp_Expression (Get_Condition (Stmt));
+ Clause := Stmt;
+ loop
+ Put_Line (" generate");
+ Disp_Generate_Statement_Body (Clause, Indent);
+ Clause := Get_Generate_Else_Clause (Stmt);
+ exit when Clause = Null_Iir;
+ Cond := Get_Condition (Clause);
+ Set_Col (Indent);
+ if Cond = Null_Iir then
+ Put ("else");
+ else
+ Put ("elsif ");
+ Disp_Expression (Cond);
+ end if;
+ end loop;
Set_Col (Indent);
Disp_End (Stmt, "generate");
- end Disp_Generate_Statement;
+ end Disp_If_Generate_Statement;
procedure Disp_Psl_Default_Clock (Stmt : Iir) is
begin
@@ -2914,8 +2941,10 @@ package body Disp_Vhdl is
Disp_Procedure_Call (Get_Procedure_Call (Stmt));
when Iir_Kind_Block_Statement =>
Disp_Block_Statement (Stmt);
- when Iir_Kind_Generate_Statement =>
- Disp_Generate_Statement (Stmt);
+ when Iir_Kind_If_Generate_Statement =>
+ Disp_If_Generate_Statement (Stmt);
+ when Iir_Kind_For_Generate_Statement =>
+ Disp_For_Generate_Statement (Stmt);
when Iir_Kind_Psl_Default_Clock =>
Disp_Psl_Default_Clock (Stmt);
when Iir_Kind_Psl_Assert_Statement =>
@@ -3047,7 +3076,8 @@ package body Disp_Vhdl is
Spec := Get_Block_Specification (Block);
case Get_Kind (Spec) is
when Iir_Kind_Block_Statement
- | Iir_Kind_Generate_Statement
+ | Iir_Kind_If_Generate_Statement
+ | Iir_Kind_For_Generate_Statement
| Iir_Kind_Architecture_Body =>
Disp_Name_Of (Spec);
when Iir_Kind_Indexed_Name =>
diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb
index c059c5273..0923c5981 100644
--- a/src/vhdl/errorout.adb
+++ b/src/vhdl/errorout.adb
@@ -662,7 +662,12 @@ package body Errorout is
when Iir_Kind_Concurrent_Procedure_Call_Statement =>
return "concurrent procedure call";
- when Iir_Kind_Generate_Statement =>
+ when Iir_Kind_For_Generate_Statement =>
+ return "for generate statement";
+ when Iir_Kind_If_Generate_Statement
+ | Iir_Kind_If_Generate_Else_Clause =>
+ return "if generate statement";
+ when Iir_Kind_Generate_Statement_Body =>
return "generate statement";
when Iir_Kind_Simple_Simultaneous_Statement =>
diff --git a/src/vhdl/evaluation.adb b/src/vhdl/evaluation.adb
index d6ddfc7e2..bf0e7d3c6 100644
--- a/src/vhdl/evaluation.adb
+++ b/src/vhdl/evaluation.adb
@@ -2895,19 +2895,14 @@ package body Evaluation is
when Iir_Kind_Procedure_Body =>
Path_Add_Element (Get_Subprogram_Specification (El),
Is_Instance);
- when Iir_Kind_Generate_Statement =>
- declare
- Scheme : Iir;
- begin
- Scheme := Get_Generation_Scheme (El);
- if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
- Path_Instance := El;
- else
- Path_Add_Element (Get_Parent (El), Is_Instance);
- Path_Add_Name (El);
- Path_Add (":");
- end if;
- end;
+ when Iir_Kind_For_Generate_Statement =>
+ Path_Instance := El;
+ when Iir_Kind_If_Generate_Statement =>
+ Path_Add_Element (Get_Parent (El), Is_Instance);
+ Path_Add_Name (El);
+ Path_Add (":");
+ when Iir_Kind_Generate_Statement_Body =>
+ Path_Add_Element (Get_Parent (El), Is_Instance);
when Iir_Kinds_Sequential_Statement =>
Path_Add_Element (Get_Parent (El), Is_Instance);
when others =>
diff --git a/src/vhdl/iirs.adb b/src/vhdl/iirs.adb
index 6864213b6..933dac697 100644
--- a/src/vhdl/iirs.adb
+++ b/src/vhdl/iirs.adb
@@ -374,6 +374,10 @@ package body Iirs is
| Iir_Kind_Concurrent_Assertion_Statement
| Iir_Kind_Psl_Default_Clock
| Iir_Kind_Concurrent_Procedure_Call_Statement
+ | Iir_Kind_If_Generate_Statement
+ | Iir_Kind_For_Generate_Statement
+ | Iir_Kind_Generate_Statement_Body
+ | Iir_Kind_If_Generate_Else_Clause
| Iir_Kind_Signal_Assignment_Statement
| Iir_Kind_Null_Statement
| Iir_Kind_Assertion_Statement
@@ -469,7 +473,6 @@ package body Iirs is
| Iir_Kind_Psl_Assert_Statement
| Iir_Kind_Psl_Cover_Statement
| Iir_Kind_Block_Statement
- | Iir_Kind_Generate_Statement
| Iir_Kind_Component_Instantiation_Statement
| Iir_Kind_Simple_Simultaneous_Statement
| Iir_Kind_Wait_Statement =>
@@ -899,6 +902,34 @@ package body Iirs is
Set_Field4 (Target, Iir_List_To_Iir (List));
end Set_Simple_Aggregate_List;
+ function Get_String8_Id (Lit : Iir) return String8_Id is
+ begin
+ pragma Assert (Lit /= Null_Iir);
+ pragma Assert (Has_String8_Id (Get_Kind (Lit)));
+ return Iir_To_String8_Id (Get_Field5 (Lit));
+ end Get_String8_Id;
+
+ procedure Set_String8_Id (Lit : Iir; Id : String8_Id) is
+ begin
+ pragma Assert (Lit /= Null_Iir);
+ pragma Assert (Has_String8_Id (Get_Kind (Lit)));
+ Set_Field5 (Lit, String8_Id_To_Iir (Id));
+ end Set_String8_Id;
+
+ function Get_String_Length (Lit : Iir) return Int32 is
+ begin
+ pragma Assert (Lit /= Null_Iir);
+ pragma Assert (Has_String_Length (Get_Kind (Lit)));
+ return Iir_To_Int32 (Get_Field4 (Lit));
+ end Get_String_Length;
+
+ procedure Set_String_Length (Lit : Iir; Len : Int32) is
+ begin
+ pragma Assert (Lit /= Null_Iir);
+ pragma Assert (Has_String_Length (Get_Kind (Lit)));
+ Set_Field4 (Lit, Int32_To_Iir (Len));
+ end Set_String_Length;
+
function Get_Bit_String_Base (Lit : Iir) return Base_Type is
begin
pragma Assert (Lit /= Null_Iir);
@@ -3266,29 +3297,57 @@ package body Iirs is
begin
pragma Assert (Target /= Null_Iir);
pragma Assert (Has_Generate_Block_Configuration (Get_Kind (Target)));
- return Get_Field7 (Target);
+ return Get_Field2 (Target);
end Get_Generate_Block_Configuration;
procedure Set_Generate_Block_Configuration (Target : Iir; Conf : Iir) is
begin
pragma Assert (Target /= Null_Iir);
pragma Assert (Has_Generate_Block_Configuration (Get_Kind (Target)));
- Set_Field7 (Target, Conf);
+ Set_Field2 (Target, Conf);
end Set_Generate_Block_Configuration;
- function Get_Generation_Scheme (Target : Iir) return Iir is
+ function Get_Generate_Statement_Body (Target : Iir) return Iir is
begin
pragma Assert (Target /= Null_Iir);
- pragma Assert (Has_Generation_Scheme (Get_Kind (Target)));
- return Get_Field6 (Target);
- end Get_Generation_Scheme;
+ pragma Assert (Has_Generate_Statement_Body (Get_Kind (Target)));
+ return Get_Field4 (Target);
+ end Get_Generate_Statement_Body;
+
+ procedure Set_Generate_Statement_Body (Target : Iir; Bod : Iir) is
+ begin
+ pragma Assert (Target /= Null_Iir);
+ pragma Assert (Has_Generate_Statement_Body (Get_Kind (Target)));
+ Set_Field4 (Target, Bod);
+ end Set_Generate_Statement_Body;
+
+ function Get_Alternative_Label (Target : Iir) return Name_Id is
+ begin
+ pragma Assert (Target /= Null_Iir);
+ pragma Assert (Has_Alternative_Label (Get_Kind (Target)));
+ return Iir_To_Name_Id (Get_Field3 (Target));
+ end Get_Alternative_Label;
+
+ procedure Set_Alternative_Label (Target : Iir; Label : Name_Id) is
+ begin
+ pragma Assert (Target /= Null_Iir);
+ pragma Assert (Has_Alternative_Label (Get_Kind (Target)));
+ Set_Field3 (Target, Name_Id_To_Iir (Label));
+ end Set_Alternative_Label;
+
+ function Get_Generate_Else_Clause (Target : Iir) return Iir is
+ begin
+ pragma Assert (Target /= Null_Iir);
+ pragma Assert (Has_Generate_Else_Clause (Get_Kind (Target)));
+ return Get_Field5 (Target);
+ end Get_Generate_Else_Clause;
- procedure Set_Generation_Scheme (Target : Iir; Scheme : Iir) is
+ procedure Set_Generate_Else_Clause (Target : Iir; Clause : Iir) is
begin
pragma Assert (Target /= Null_Iir);
- pragma Assert (Has_Generation_Scheme (Get_Kind (Target)));
- Set_Field6 (Target, Scheme);
- end Set_Generation_Scheme;
+ pragma Assert (Has_Generate_Else_Clause (Get_Kind (Target)));
+ Set_Field5 (Target, Clause);
+ end Set_Generate_Else_Clause;
function Get_Condition (Target : Iir) return Iir is
begin
@@ -4253,34 +4312,6 @@ package body Iirs is
Set_Field6 (Target, Location_Type_To_Iir (Loc));
end Set_End_Location;
- function Get_String8_Id (Lit : Iir) return String8_Id is
- begin
- pragma Assert (Lit /= Null_Iir);
- pragma Assert (Has_String8_Id (Get_Kind (Lit)));
- return Iir_To_String8_Id (Get_Field5 (Lit));
- end Get_String8_Id;
-
- procedure Set_String8_Id (Lit : Iir; Id : String8_Id) is
- begin
- pragma Assert (Lit /= Null_Iir);
- pragma Assert (Has_String8_Id (Get_Kind (Lit)));
- Set_Field5 (Lit, String8_Id_To_Iir (Id));
- end Set_String8_Id;
-
- function Get_String_Length (Lit : Iir) return Int32 is
- begin
- pragma Assert (Lit /= Null_Iir);
- pragma Assert (Has_String_Length (Get_Kind (Lit)));
- return Iir_To_Int32 (Get_Field4 (Lit));
- end Get_String_Length;
-
- procedure Set_String_Length (Lit : Iir; Len : Int32) is
- begin
- pragma Assert (Lit /= Null_Iir);
- pragma Assert (Has_String_Length (Get_Kind (Lit)));
- Set_Field4 (Lit, Int32_To_Iir (Len));
- end Set_String_Length;
-
function Get_Use_Flag (Decl : Iir) return Boolean is
begin
pragma Assert (Decl /= Null_Iir);
@@ -4351,6 +4382,20 @@ package body Iirs is
Set_Flag10 (Decl, Flag);
end Set_Has_Begin;
+ function Get_Has_End (Decl : Iir) return Boolean is
+ begin
+ pragma Assert (Decl /= Null_Iir);
+ pragma Assert (Has_Has_End (Get_Kind (Decl)));
+ return Get_Flag11 (Decl);
+ end Get_Has_End;
+
+ procedure Set_Has_End (Decl : Iir; Flag : Boolean) is
+ begin
+ pragma Assert (Decl /= Null_Iir);
+ pragma Assert (Has_Has_End (Get_Kind (Decl)));
+ Set_Flag11 (Decl, Flag);
+ end Set_Has_End;
+
function Get_Has_Is (Decl : Iir) return Boolean is
begin
pragma Assert (Decl /= Null_Iir);
diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads
index 0387f2783..9aff3cca4 100644
--- a/src/vhdl/iirs.ads
+++ b/src/vhdl/iirs.ads
@@ -501,19 +501,22 @@ package Iirs is
--
-- Get/Set_Parent (Field0)
--
+ -- Only use_clause are allowed here.
-- Get/Set_Declaration_Chain (Field1)
--
-- Get/Set_Chain (Field2)
--
-- Get/Set_Configuration_Item_Chain (Field3)
--
- -- Note: for default block configurations of iterative generate statement,
- -- the block specification is an indexed_name, whose index_list is others.
- -- Get/Set_Block_Specification (Field5)
- --
-- Single linked list of block configuration that apply to the same
-- for scheme generate block.
-- Get/Set_Prev_Block_Configuration (Field4)
+ --
+ -- Note: for default block configurations of iterative generate statement,
+ -- the block specification is an indexed_name, whose index_list is others.
+ -- The name designates either a block statement or a generate statement
+ -- body.
+ -- Get/Set_Block_Specification (Field5)
-- Iir_Kind_Binding_Indication (Medium)
--
@@ -2511,36 +2514,89 @@ package Iirs is
--
-- Get/Set_End_Has_Identifier (Flag9)
- -- Iir_Kind_Generate_Statement (Medium)
+ -- Iir_Kind_Generate_Statement_Body (Short)
+ -- LRM08 11.8 Generate statements
+ --
+ -- generate_statement_body ::=
+ -- [ block_declarative_part
+ -- BEGIN ]
+ -- { concurrent_statement }
+ -- [ END [ alternative_label ] ; ]
--
-- Get/Set_Parent (Field0)
--
-- Get/Set_Declaration_Chain (Field1)
--
- -- Get/Set_Chain (Field2)
+ -- The block configuration for this statement body.
+ -- Get/Set_Generate_Block_Configuration (Field2)
--
- -- Get/Set_Label (Field3)
+ -- Get/Set_Alternative_Label (Field3)
-- Get/Set_Identifier (Alias Field3)
--
-- Get/Set_Attribute_Value_Chain (Field4)
--
-- Get/Set_Concurrent_Statement_Chain (Field5)
--
- -- The generation scheme.
- -- A (boolean) expression for a conditionnal elaboration (if).
- -- A (iterator) declaration for an iterative elaboration (for).
- -- Get/Set_Generation_Scheme (Field6)
+ -- Get/Set_End_Has_Identifier (Flag9)
--
- -- The block configuration for this statement.
- -- Get/Set_Generate_Block_Configuration (Field7)
+ -- Get/Set_Has_Begin (Flag10)
+ --
+ -- Get/Set_Has_End (Flag11)
+
+ -- Iir_Kind_For_Generate_Statement (Short)
+ --
+ -- Get/Set_Parent (Field0)
+ --
+ -- The parameters specification is represented by an Iterator_Declaration.
+ -- Get/Set_Parameter_Specification (Field1)
+ --
+ -- Get/Set_Chain (Field2)
+ --
+ -- Get/Set_Label (Field3)
+ -- Get/Set_Identifier (Alias Field3)
+ --
+ -- Get/Set_Generate_Statement_Body (Field4)
--
-- Get/Set_Visible_Flag (Flag4)
--
-- Get/Set_End_Has_Reserved_Id (Flag8)
--
-- Get/Set_End_Has_Identifier (Flag9)
+
+ -- Iir_Kind_If_Generate_Else_Clause (Short)
--
- -- Get/Set_Has_Begin (Flag10)
+ -- Get/Set_Parent (Field0)
+ --
+ -- Null_Iir for the else clause.
+ -- Get/Set_Condition (Field1)
+ --
+ -- Get/Set_Generate_Statement_Body (Field4)
+ --
+ -- Get/Set_Generate_Else_Clause (Field5)
+ --
+ -- Get/Set_Visible_Flag (Flag4)
+
+ -- Iir_Kind_If_Generate_Statement (Short)
+ --
+ -- Get/Set_Parent (Field0)
+ --
+ -- Null_Iir for the else clause.
+ -- Get/Set_Condition (Field1)
+ --
+ -- Get/Set_Chain (Field2)
+ --
+ -- Get/Set_Label (Field3)
+ -- Get/Set_Identifier (Alias Field3)
+ --
+ -- Get/Set_Generate_Statement_Body (Field4)
+ --
+ -- Get/Set_Generate_Else_Clause (Field5)
+ --
+ -- Get/Set_Visible_Flag (Flag4)
+ --
+ -- Get/Set_End_Has_Reserved_Id (Flag8)
+ --
+ -- Get/Set_End_Has_Identifier (Flag9)
-- Iir_Kind_Simple_Simultaneous_Statement (Medium)
--
@@ -2578,12 +2634,12 @@ package Iirs is
-- Only for Iir_Kind_If_Statement:
-- Get/Set_Label (Field3)
--
- -- Must be an Iir_kind_elsif node, or NULL for no more elsif clauses.
- -- Get/Set_Else_Clause (Field4)
- --
-- Only for Iir_Kind_If_Statement:
-- Get/Set_Identifier (Alias Field3)
--
+ -- Must be an Iir_kind_elsif node, or NULL for no more elsif clauses.
+ -- Get/Set_Else_Clause (Field4)
+ --
-- Get/Set_Sequential_Statement_Chain (Field5)
--
-- Only for Iir_Kind_If_Statement:
@@ -3540,11 +3596,15 @@ package Iirs is
Iir_Kind_Psl_Cover_Statement,
Iir_Kind_Concurrent_Procedure_Call_Statement,
Iir_Kind_Block_Statement,
- Iir_Kind_Generate_Statement,
+ Iir_Kind_If_Generate_Statement,
+ Iir_Kind_For_Generate_Statement,
Iir_Kind_Component_Instantiation_Statement,
Iir_Kind_Simple_Simultaneous_Statement,
+ Iir_Kind_Generate_Statement_Body,
+ Iir_Kind_If_Generate_Else_Clause,
+
-- Iir_Kind_Sequential_Statement
Iir_Kind_Signal_Assignment_Statement,
Iir_Kind_Null_Statement,
@@ -4406,7 +4466,8 @@ package Iirs is
--Iir_Kind_Psl_Cover_Statement
--Iir_Kind_Concurrent_Procedure_Call_Statement
--Iir_Kind_Block_Statement
- --Iir_Kind_Generate_Statement
+ --Iir_Kind_If_Generate_Statement
+ --Iir_Kind_For_Generate_Statement
Iir_Kind_Component_Instantiation_Statement;
subtype Iir_Kinds_Concurrent_Signal_Assignment is Iir_Kind range
@@ -5915,13 +5976,21 @@ package Iirs is
-- Get/Set the block_configuration (there may be several
-- block_configuration through the use of prev_configuration singly linked
-- list) that apply to this generate statement.
- -- Field: Field7
+ -- Field: Field2
function Get_Generate_Block_Configuration (Target : Iir) return Iir;
procedure Set_Generate_Block_Configuration (Target : Iir; Conf : Iir);
- -- Field: Field6
- function Get_Generation_Scheme (Target : Iir) return Iir;
- procedure Set_Generation_Scheme (Target : Iir; Scheme : Iir);
+ -- Field: Field4
+ function Get_Generate_Statement_Body (Target : Iir) return Iir;
+ procedure Set_Generate_Statement_Body (Target : Iir; Bod : Iir);
+
+ -- Field: Field3 (uc)
+ function Get_Alternative_Label (Target : Iir) return Name_Id;
+ procedure Set_Alternative_Label (Target : Iir; Label : Name_Id);
+
+ -- Field: Field5
+ function Get_Generate_Else_Clause (Target : Iir) return Iir;
+ procedure Set_Generate_Else_Clause (Target : Iir; Clause : Iir);
-- Condition of a conditionam_waveform, if_statement, elsif,
-- while_loop_statement, next_statement or exit_statement.
@@ -6294,6 +6363,11 @@ package Iirs is
function Get_Has_Begin (Decl : Iir) return Boolean;
procedure Set_Has_Begin (Decl : Iir; Flag : Boolean);
+ -- Layout flag: true if 'end' is present (only for generate body).
+ -- Field: Flag11
+ function Get_Has_End (Decl : Iir) return Boolean;
+ procedure Set_Has_End (Decl : Iir; Flag : Boolean);
+
-- Layout flag: true if 'is' is present.
-- Field: Flag7
function Get_Has_Is (Decl : Iir) return Boolean;
diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb
index 99737c428..db100e438 100644
--- a/src/vhdl/iirs_utils.adb
+++ b/src/vhdl/iirs_utils.adb
@@ -349,7 +349,7 @@ package body Iirs_Utils is
else
Set_Component_Configuration (El, Null_Iir);
end if;
- when Iir_Kind_Generate_Statement =>
+ when Iir_Kind_For_Generate_Statement =>
Set_Generate_Block_Configuration (El, Null_Iir);
-- Clear inside a generate statement.
Clear_Instantiation_Configuration_Vhdl87 (El, True, Full);
@@ -368,15 +368,31 @@ package body Iirs_Utils is
begin
if False and then Flags.Vhdl_Std = Vhdl_87 then
Clear_Instantiation_Configuration_Vhdl87
- (Parent, Get_Kind (Parent) = Iir_Kind_Generate_Statement, Full);
+ (Parent, Get_Kind (Parent) = Iir_Kind_For_Generate_Statement, Full);
else
El := Get_Concurrent_Statement_Chain (Parent);
while El /= Null_Iir loop
case Get_Kind (El) is
when Iir_Kind_Component_Instantiation_Statement =>
Set_Component_Configuration (El, Null_Iir);
- when Iir_Kind_Generate_Statement =>
- Set_Generate_Block_Configuration (El, Null_Iir);
+ when Iir_Kind_For_Generate_Statement =>
+ declare
+ Bod : constant Iir := Get_Generate_Statement_Body (El);
+ begin
+ Set_Generate_Block_Configuration (Bod, Null_Iir);
+ end;
+ when Iir_Kind_If_Generate_Statement =>
+ declare
+ Clause : Iir;
+ Bod : Iir;
+ begin
+ Clause := El;
+ while Clause /= Null_Iir loop
+ Bod := Get_Generate_Statement_Body (Clause);
+ Set_Generate_Block_Configuration (Bod, Null_Iir);
+ Clause := Get_Generate_Else_Clause (Clause);
+ end loop;
+ end;
when Iir_Kind_Block_Statement =>
Set_Block_Block_Configuration (El, Null_Iir);
when others =>
@@ -809,7 +825,8 @@ package body Iirs_Utils is
return Res;
when Iir_Kind_Block_Statement
| Iir_Kind_Architecture_Body
- | Iir_Kind_Generate_Statement =>
+ | Iir_Kind_For_Generate_Statement
+ | Iir_Kind_If_Generate_Statement =>
return Block_Spec;
when Iir_Kind_Indexed_Name
| Iir_Kind_Selected_Name
diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb
index 62a893563..8de6dde87 100644
--- a/src/vhdl/nodes_meta.adb
+++ b/src/vhdl/nodes_meta.adb
@@ -48,6 +48,8 @@ package body Nodes_Meta is
Field_Physical_Unit_Value => Type_Iir,
Field_Fp_Value => Type_Iir_Fp64,
Field_Simple_Aggregate_List => Type_Iir_List,
+ Field_String8_Id => Type_String8_Id,
+ Field_String_Length => Type_Int32,
Field_Bit_String_Base => Type_Base_Type,
Field_Has_Signed => Type_Boolean,
Field_Has_Sign => Type_Boolean,
@@ -217,7 +219,9 @@ package body Nodes_Meta is
Field_Block_Header => Type_Iir,
Field_Uninstantiated_Package_Name => Type_Iir,
Field_Generate_Block_Configuration => Type_Iir,
- Field_Generation_Scheme => Type_Iir,
+ Field_Generate_Statement_Body => Type_Iir,
+ Field_Alternative_Label => Type_Name_Id,
+ Field_Generate_Else_Clause => Type_Iir,
Field_Condition => Type_Iir,
Field_Else_Clause => Type_Iir,
Field_Parameter_Specification => Type_Iir,
@@ -286,13 +290,12 @@ package body Nodes_Meta is
Field_Protected_Type_Body => Type_Iir,
Field_Protected_Type_Declaration => Type_Iir,
Field_End_Location => Type_Location_Type,
- Field_String8_Id => Type_String8_Id,
- Field_String_Length => Type_Int32,
Field_Use_Flag => Type_Boolean,
Field_End_Has_Reserved_Id => Type_Boolean,
Field_End_Has_Identifier => Type_Boolean,
Field_End_Has_Postponed => Type_Boolean,
Field_Has_Begin => Type_Boolean,
+ Field_Has_End => Type_Boolean,
Field_Has_Is => Type_Boolean,
Field_Has_Pure => Type_Boolean,
Field_Has_Body => Type_Boolean,
@@ -374,6 +377,10 @@ package body Nodes_Meta is
return "fp_value";
when Field_Simple_Aggregate_List =>
return "simple_aggregate_list";
+ when Field_String8_Id =>
+ return "string8_id";
+ when Field_String_Length =>
+ return "string_length";
when Field_Bit_String_Base =>
return "bit_string_base";
when Field_Has_Signed =>
@@ -712,8 +719,12 @@ package body Nodes_Meta is
return "uninstantiated_package_name";
when Field_Generate_Block_Configuration =>
return "generate_block_configuration";
- when Field_Generation_Scheme =>
- return "generation_scheme";
+ when Field_Generate_Statement_Body =>
+ return "generate_statement_body";
+ when Field_Alternative_Label =>
+ return "alternative_label";
+ when Field_Generate_Else_Clause =>
+ return "generate_else_clause";
when Field_Condition =>
return "condition";
when Field_Else_Clause =>
@@ -850,10 +861,6 @@ package body Nodes_Meta is
return "protected_type_declaration";
when Field_End_Location =>
return "end_location";
- when Field_String8_Id =>
- return "string8_id";
- when Field_String_Length =>
- return "string_length";
when Field_Use_Flag =>
return "use_flag";
when Field_End_Has_Reserved_Id =>
@@ -864,6 +871,8 @@ package body Nodes_Meta is
return "end_has_postponed";
when Field_Has_Begin =>
return "has_begin";
+ when Field_Has_End =>
+ return "has_end";
when Field_Has_Is =>
return "has_is";
when Field_Has_Pure =>
@@ -1244,12 +1253,18 @@ package body Nodes_Meta is
return "concurrent_procedure_call_statement";
when Iir_Kind_Block_Statement =>
return "block_statement";
- when Iir_Kind_Generate_Statement =>
- return "generate_statement";
+ when Iir_Kind_If_Generate_Statement =>
+ return "if_generate_statement";
+ when Iir_Kind_For_Generate_Statement =>
+ return "for_generate_statement";
when Iir_Kind_Component_Instantiation_Statement =>
return "component_instantiation_statement";
when Iir_Kind_Simple_Simultaneous_Statement =>
return "simple_simultaneous_statement";
+ when Iir_Kind_Generate_Statement_Body =>
+ return "generate_statement_body";
+ when Iir_Kind_If_Generate_Else_Clause =>
+ return "if_generate_else_clause";
when Iir_Kind_Signal_Assignment_Statement =>
return "signal_assignment_statement";
when Iir_Kind_Null_Statement =>
@@ -1434,6 +1449,10 @@ package body Nodes_Meta is
return Attr_None;
when Field_Simple_Aggregate_List =>
return Attr_None;
+ when Field_String8_Id =>
+ return Attr_None;
+ when Field_String_Length =>
+ return Attr_None;
when Field_Bit_String_Base =>
return Attr_None;
when Field_Has_Signed =>
@@ -1772,7 +1791,11 @@ package body Nodes_Meta is
return Attr_None;
when Field_Generate_Block_Configuration =>
return Attr_None;
- when Field_Generation_Scheme =>
+ when Field_Generate_Statement_Body =>
+ return Attr_None;
+ when Field_Alternative_Label =>
+ return Attr_None;
+ when Field_Generate_Else_Clause =>
return Attr_None;
when Field_Condition =>
return Attr_None;
@@ -1910,10 +1933,6 @@ package body Nodes_Meta is
return Attr_None;
when Field_End_Location =>
return Attr_None;
- when Field_String8_Id =>
- return Attr_None;
- when Field_String_Length =>
- return Attr_None;
when Field_Use_Flag =>
return Attr_None;
when Field_End_Has_Reserved_Id =>
@@ -1924,6 +1943,8 @@ package body Nodes_Meta is
return Attr_None;
when Field_Has_Begin =>
return Attr_None;
+ when Field_Has_End =>
+ return Attr_None;
when Field_Has_Is =>
return Attr_None;
when Field_Has_Pure =>
@@ -3353,18 +3374,24 @@ package body Nodes_Meta is
Field_Block_Header,
Field_Guard_Decl,
Field_Parent,
- -- Iir_Kind_Generate_Statement
+ -- Iir_Kind_If_Generate_Statement
Field_Label,
- Field_Has_Begin,
Field_Visible_Flag,
Field_End_Has_Reserved_Id,
Field_End_Has_Identifier,
- Field_Declaration_Chain,
+ Field_Condition,
Field_Chain,
- Field_Attribute_Value_Chain,
- Field_Concurrent_Statement_Chain,
- Field_Generation_Scheme,
- Field_Generate_Block_Configuration,
+ Field_Generate_Statement_Body,
+ Field_Generate_Else_Clause,
+ Field_Parent,
+ -- Iir_Kind_For_Generate_Statement
+ Field_Label,
+ Field_Visible_Flag,
+ Field_End_Has_Reserved_Id,
+ Field_End_Has_Identifier,
+ Field_Parameter_Specification,
+ Field_Chain,
+ Field_Generate_Statement_Body,
Field_Parent,
-- Iir_Kind_Component_Instantiation_Statement
Field_Label,
@@ -3385,6 +3412,22 @@ package body Nodes_Meta is
Field_Simultaneous_Right,
Field_Tolerance,
Field_Parent,
+ -- Iir_Kind_Generate_Statement_Body
+ Field_Alternative_Label,
+ Field_Has_Begin,
+ Field_Has_End,
+ Field_End_Has_Identifier,
+ Field_Declaration_Chain,
+ Field_Generate_Block_Configuration,
+ Field_Attribute_Value_Chain,
+ Field_Concurrent_Statement_Chain,
+ Field_Parent,
+ -- Iir_Kind_If_Generate_Else_Clause
+ Field_Visible_Flag,
+ Field_Condition,
+ Field_Generate_Statement_Body,
+ Field_Generate_Else_Clause,
+ Field_Parent,
-- Iir_Kind_Signal_Assignment_Statement
Field_Label,
Field_Delay_Mechanism,
@@ -3972,69 +4015,72 @@ package body Nodes_Meta is
Iir_Kind_Psl_Cover_Statement => 1204,
Iir_Kind_Concurrent_Procedure_Call_Statement => 1210,
Iir_Kind_Block_Statement => 1223,
- Iir_Kind_Generate_Statement => 1235,
- Iir_Kind_Component_Instantiation_Statement => 1245,
- Iir_Kind_Simple_Simultaneous_Statement => 1252,
- Iir_Kind_Signal_Assignment_Statement => 1261,
- Iir_Kind_Null_Statement => 1265,
- Iir_Kind_Assertion_Statement => 1272,
- Iir_Kind_Report_Statement => 1278,
- Iir_Kind_Wait_Statement => 1285,
- Iir_Kind_Variable_Assignment_Statement => 1291,
- Iir_Kind_Return_Statement => 1297,
- Iir_Kind_For_Loop_Statement => 1305,
- Iir_Kind_While_Loop_Statement => 1312,
- Iir_Kind_Next_Statement => 1318,
- Iir_Kind_Exit_Statement => 1324,
- Iir_Kind_Case_Statement => 1331,
- Iir_Kind_Procedure_Call_Statement => 1336,
- Iir_Kind_If_Statement => 1344,
- Iir_Kind_Elsif => 1349,
- Iir_Kind_Character_Literal => 1356,
- Iir_Kind_Simple_Name => 1363,
- Iir_Kind_Selected_Name => 1371,
- Iir_Kind_Operator_Symbol => 1376,
- Iir_Kind_Selected_By_All_Name => 1381,
- Iir_Kind_Parenthesis_Name => 1385,
- Iir_Kind_Base_Attribute => 1387,
- Iir_Kind_Left_Type_Attribute => 1392,
- Iir_Kind_Right_Type_Attribute => 1397,
- Iir_Kind_High_Type_Attribute => 1402,
- Iir_Kind_Low_Type_Attribute => 1407,
- Iir_Kind_Ascending_Type_Attribute => 1412,
- Iir_Kind_Image_Attribute => 1418,
- Iir_Kind_Value_Attribute => 1424,
- Iir_Kind_Pos_Attribute => 1430,
- Iir_Kind_Val_Attribute => 1436,
- Iir_Kind_Succ_Attribute => 1442,
- Iir_Kind_Pred_Attribute => 1448,
- Iir_Kind_Leftof_Attribute => 1454,
- Iir_Kind_Rightof_Attribute => 1460,
- Iir_Kind_Delayed_Attribute => 1468,
- Iir_Kind_Stable_Attribute => 1476,
- Iir_Kind_Quiet_Attribute => 1484,
- Iir_Kind_Transaction_Attribute => 1492,
- Iir_Kind_Event_Attribute => 1496,
- Iir_Kind_Active_Attribute => 1500,
- Iir_Kind_Last_Event_Attribute => 1504,
- Iir_Kind_Last_Active_Attribute => 1508,
- Iir_Kind_Last_Value_Attribute => 1512,
- Iir_Kind_Driving_Attribute => 1516,
- Iir_Kind_Driving_Value_Attribute => 1520,
- Iir_Kind_Behavior_Attribute => 1520,
- Iir_Kind_Structure_Attribute => 1520,
- Iir_Kind_Simple_Name_Attribute => 1527,
- Iir_Kind_Instance_Name_Attribute => 1532,
- Iir_Kind_Path_Name_Attribute => 1537,
- Iir_Kind_Left_Array_Attribute => 1544,
- Iir_Kind_Right_Array_Attribute => 1551,
- Iir_Kind_High_Array_Attribute => 1558,
- Iir_Kind_Low_Array_Attribute => 1565,
- Iir_Kind_Length_Array_Attribute => 1572,
- Iir_Kind_Ascending_Array_Attribute => 1579,
- Iir_Kind_Range_Array_Attribute => 1586,
- Iir_Kind_Reverse_Range_Array_Attribute => 1593,
- Iir_Kind_Attribute_Name => 1601
+ Iir_Kind_If_Generate_Statement => 1232,
+ Iir_Kind_For_Generate_Statement => 1240,
+ Iir_Kind_Component_Instantiation_Statement => 1250,
+ Iir_Kind_Simple_Simultaneous_Statement => 1257,
+ Iir_Kind_Generate_Statement_Body => 1266,
+ Iir_Kind_If_Generate_Else_Clause => 1271,
+ Iir_Kind_Signal_Assignment_Statement => 1280,
+ Iir_Kind_Null_Statement => 1284,
+ Iir_Kind_Assertion_Statement => 1291,
+ Iir_Kind_Report_Statement => 1297,
+ Iir_Kind_Wait_Statement => 1304,
+ Iir_Kind_Variable_Assignment_Statement => 1310,
+ Iir_Kind_Return_Statement => 1316,
+ Iir_Kind_For_Loop_Statement => 1324,
+ Iir_Kind_While_Loop_Statement => 1331,
+ Iir_Kind_Next_Statement => 1337,
+ Iir_Kind_Exit_Statement => 1343,
+ Iir_Kind_Case_Statement => 1350,
+ Iir_Kind_Procedure_Call_Statement => 1355,
+ Iir_Kind_If_Statement => 1363,
+ Iir_Kind_Elsif => 1368,
+ Iir_Kind_Character_Literal => 1375,
+ Iir_Kind_Simple_Name => 1382,
+ Iir_Kind_Selected_Name => 1390,
+ Iir_Kind_Operator_Symbol => 1395,
+ Iir_Kind_Selected_By_All_Name => 1400,
+ Iir_Kind_Parenthesis_Name => 1404,
+ Iir_Kind_Base_Attribute => 1406,
+ Iir_Kind_Left_Type_Attribute => 1411,
+ Iir_Kind_Right_Type_Attribute => 1416,
+ Iir_Kind_High_Type_Attribute => 1421,
+ Iir_Kind_Low_Type_Attribute => 1426,
+ Iir_Kind_Ascending_Type_Attribute => 1431,
+ Iir_Kind_Image_Attribute => 1437,
+ Iir_Kind_Value_Attribute => 1443,
+ Iir_Kind_Pos_Attribute => 1449,
+ Iir_Kind_Val_Attribute => 1455,
+ Iir_Kind_Succ_Attribute => 1461,
+ Iir_Kind_Pred_Attribute => 1467,
+ Iir_Kind_Leftof_Attribute => 1473,
+ Iir_Kind_Rightof_Attribute => 1479,
+ Iir_Kind_Delayed_Attribute => 1487,
+ Iir_Kind_Stable_Attribute => 1495,
+ Iir_Kind_Quiet_Attribute => 1503,
+ Iir_Kind_Transaction_Attribute => 1511,
+ Iir_Kind_Event_Attribute => 1515,
+ Iir_Kind_Active_Attribute => 1519,
+ Iir_Kind_Last_Event_Attribute => 1523,
+ Iir_Kind_Last_Active_Attribute => 1527,
+ Iir_Kind_Last_Value_Attribute => 1531,
+ Iir_Kind_Driving_Attribute => 1535,
+ Iir_Kind_Driving_Value_Attribute => 1539,
+ Iir_Kind_Behavior_Attribute => 1539,
+ Iir_Kind_Structure_Attribute => 1539,
+ Iir_Kind_Simple_Name_Attribute => 1546,
+ Iir_Kind_Instance_Name_Attribute => 1551,
+ Iir_Kind_Path_Name_Attribute => 1556,
+ Iir_Kind_Left_Array_Attribute => 1563,
+ Iir_Kind_Right_Array_Attribute => 1570,
+ Iir_Kind_High_Array_Attribute => 1577,
+ Iir_Kind_Low_Array_Attribute => 1584,
+ Iir_Kind_Length_Array_Attribute => 1591,
+ Iir_Kind_Ascending_Array_Attribute => 1598,
+ Iir_Kind_Range_Array_Attribute => 1605,
+ Iir_Kind_Reverse_Range_Array_Attribute => 1612,
+ Iir_Kind_Attribute_Name => 1620
);
function Get_Fields (K : Iir_Kind) return Fields_Array
@@ -4158,6 +4204,8 @@ package body Nodes_Meta is
return Get_End_Has_Postponed (N);
when Field_Has_Begin =>
return Get_Has_Begin (N);
+ when Field_Has_End =>
+ return Get_Has_End (N);
when Field_Has_Is =>
return Get_Has_Is (N);
when Field_Has_Pure =>
@@ -4260,6 +4308,8 @@ package body Nodes_Meta is
Set_End_Has_Postponed (N, V);
when Field_Has_Begin =>
Set_Has_Begin (N, V);
+ when Field_Has_End =>
+ Set_Has_End (N, V);
when Field_Has_Is =>
Set_Has_Is (N, V);
when Field_Has_Pure =>
@@ -4576,8 +4626,10 @@ package body Nodes_Meta is
return Get_Uninstantiated_Package_Name (N);
when Field_Generate_Block_Configuration =>
return Get_Generate_Block_Configuration (N);
- when Field_Generation_Scheme =>
- return Get_Generation_Scheme (N);
+ when Field_Generate_Statement_Body =>
+ return Get_Generate_Statement_Body (N);
+ when Field_Generate_Else_Clause =>
+ return Get_Generate_Else_Clause (N);
when Field_Condition =>
return Get_Condition (N);
when Field_Else_Clause =>
@@ -4932,8 +4984,10 @@ package body Nodes_Meta is
Set_Uninstantiated_Package_Name (N, V);
when Field_Generate_Block_Configuration =>
Set_Generate_Block_Configuration (N, V);
- when Field_Generation_Scheme =>
- Set_Generation_Scheme (N, V);
+ when Field_Generate_Statement_Body =>
+ Set_Generate_Statement_Body (N, V);
+ when Field_Generate_Else_Clause =>
+ Set_Generate_Else_Clause (N, V);
when Field_Condition =>
Set_Condition (N, V);
when Field_Else_Clause =>
@@ -5558,6 +5612,8 @@ package body Nodes_Meta is
return Get_Identifier (N);
when Field_Label =>
return Get_Label (N);
+ when Field_Alternative_Label =>
+ return Get_Alternative_Label (N);
when Field_Simple_Name_Identifier =>
return Get_Simple_Name_Identifier (N);
when others =>
@@ -5580,6 +5636,8 @@ package body Nodes_Meta is
Set_Identifier (N, V);
when Field_Label =>
Set_Label (N, V);
+ when Field_Alternative_Label =>
+ Set_Alternative_Label (N, V);
when Field_Simple_Name_Identifier =>
Set_Simple_Name_Identifier (N, V);
when others =>
@@ -5949,6 +6007,16 @@ package body Nodes_Meta is
return K = Iir_Kind_Simple_Aggregate;
end Has_Simple_Aggregate_List;
+ function Has_String8_Id (K : Iir_Kind) return Boolean is
+ begin
+ return K = Iir_Kind_String_Literal8;
+ end Has_String8_Id;
+
+ function Has_String_Length (K : Iir_Kind) return Boolean is
+ begin
+ return K = Iir_Kind_String_Literal8;
+ end Has_String_Length;
+
function Has_Bit_String_Base (K : Iir_Kind) return Boolean is
begin
return K = Iir_Kind_String_Literal8;
@@ -6232,7 +6300,7 @@ package body Nodes_Meta is
| Iir_Kind_Sensitized_Process_Statement
| Iir_Kind_Process_Statement
| Iir_Kind_Block_Statement
- | Iir_Kind_Generate_Statement =>
+ | Iir_Kind_Generate_Statement_Body =>
return True;
when others =>
return False;
@@ -6299,7 +6367,7 @@ package body Nodes_Meta is
when Iir_Kind_Entity_Declaration
| Iir_Kind_Architecture_Body
| Iir_Kind_Block_Statement
- | Iir_Kind_Generate_Statement =>
+ | Iir_Kind_Generate_Statement_Body =>
return True;
when others =>
return False;
@@ -6375,7 +6443,8 @@ package body Nodes_Meta is
| Iir_Kind_Psl_Cover_Statement
| Iir_Kind_Concurrent_Procedure_Call_Statement
| Iir_Kind_Block_Statement
- | Iir_Kind_Generate_Statement
+ | Iir_Kind_If_Generate_Statement
+ | Iir_Kind_For_Generate_Statement
| Iir_Kind_Component_Instantiation_Statement
| Iir_Kind_Simple_Simultaneous_Statement
| Iir_Kind_Signal_Assignment_Statement
@@ -6922,7 +6991,7 @@ package body Nodes_Meta is
| Iir_Kind_Sensitized_Process_Statement
| Iir_Kind_Process_Statement
| Iir_Kind_Block_Statement
- | Iir_Kind_Generate_Statement =>
+ | Iir_Kind_Generate_Statement_Body =>
return True;
when others =>
return False;
@@ -7079,9 +7148,11 @@ package body Nodes_Meta is
| Iir_Kind_Psl_Cover_Statement
| Iir_Kind_Concurrent_Procedure_Call_Statement
| Iir_Kind_Block_Statement
- | Iir_Kind_Generate_Statement
+ | Iir_Kind_If_Generate_Statement
+ | Iir_Kind_For_Generate_Statement
| Iir_Kind_Component_Instantiation_Statement
| Iir_Kind_Simple_Simultaneous_Statement
+ | Iir_Kind_Generate_Statement_Body
| Iir_Kind_Signal_Assignment_Statement
| Iir_Kind_Null_Statement
| Iir_Kind_Assertion_Statement
@@ -7120,7 +7191,8 @@ package body Nodes_Meta is
| Iir_Kind_Psl_Cover_Statement
| Iir_Kind_Concurrent_Procedure_Call_Statement
| Iir_Kind_Block_Statement
- | Iir_Kind_Generate_Statement
+ | Iir_Kind_If_Generate_Statement
+ | Iir_Kind_For_Generate_Statement
| Iir_Kind_Component_Instantiation_Statement
| Iir_Kind_Simple_Simultaneous_Statement
| Iir_Kind_Signal_Assignment_Statement
@@ -7193,9 +7265,11 @@ package body Nodes_Meta is
| Iir_Kind_Psl_Cover_Statement
| Iir_Kind_Concurrent_Procedure_Call_Statement
| Iir_Kind_Block_Statement
- | Iir_Kind_Generate_Statement
+ | Iir_Kind_If_Generate_Statement
+ | Iir_Kind_For_Generate_Statement
| Iir_Kind_Component_Instantiation_Statement
| Iir_Kind_Simple_Simultaneous_Statement
+ | Iir_Kind_If_Generate_Else_Clause
| Iir_Kind_Signal_Assignment_Statement
| Iir_Kind_Null_Statement
| Iir_Kind_Assertion_Statement
@@ -7973,18 +8047,43 @@ package body Nodes_Meta is
function Has_Generate_Block_Configuration (K : Iir_Kind) return Boolean is
begin
- return K = Iir_Kind_Generate_Statement;
+ return K = Iir_Kind_Generate_Statement_Body;
end Has_Generate_Block_Configuration;
- function Has_Generation_Scheme (K : Iir_Kind) return Boolean is
+ function Has_Generate_Statement_Body (K : Iir_Kind) return Boolean is
begin
- return K = Iir_Kind_Generate_Statement;
- end Has_Generation_Scheme;
+ case K is
+ when Iir_Kind_If_Generate_Statement
+ | Iir_Kind_For_Generate_Statement
+ | Iir_Kind_If_Generate_Else_Clause =>
+ return True;
+ when others =>
+ return False;
+ end case;
+ end Has_Generate_Statement_Body;
+
+ function Has_Alternative_Label (K : Iir_Kind) return Boolean is
+ begin
+ return K = Iir_Kind_Generate_Statement_Body;
+ end Has_Alternative_Label;
+
+ function Has_Generate_Else_Clause (K : Iir_Kind) return Boolean is
+ begin
+ case K is
+ when Iir_Kind_If_Generate_Statement
+ | Iir_Kind_If_Generate_Else_Clause =>
+ return True;
+ when others =>
+ return False;
+ end case;
+ end Has_Generate_Else_Clause;
function Has_Condition (K : Iir_Kind) return Boolean is
begin
case K is
when Iir_Kind_Conditional_Waveform
+ | Iir_Kind_If_Generate_Statement
+ | Iir_Kind_If_Generate_Else_Clause
| Iir_Kind_While_Loop_Statement
| Iir_Kind_Next_Statement
| Iir_Kind_Exit_Statement
@@ -8009,7 +8108,13 @@ package body Nodes_Meta is
function Has_Parameter_Specification (K : Iir_Kind) return Boolean is
begin
- return K = Iir_Kind_For_Loop_Statement;
+ case K is
+ when Iir_Kind_For_Generate_Statement
+ | Iir_Kind_For_Loop_Statement =>
+ return True;
+ when others =>
+ return False;
+ end case;
end Has_Parameter_Specification;
function Has_Parent (K : Iir_Kind) return Boolean is
@@ -8080,9 +8185,12 @@ package body Nodes_Meta is
| Iir_Kind_Psl_Cover_Statement
| Iir_Kind_Concurrent_Procedure_Call_Statement
| Iir_Kind_Block_Statement
- | Iir_Kind_Generate_Statement
+ | Iir_Kind_If_Generate_Statement
+ | Iir_Kind_For_Generate_Statement
| Iir_Kind_Component_Instantiation_Statement
| Iir_Kind_Simple_Simultaneous_Statement
+ | Iir_Kind_Generate_Statement_Body
+ | Iir_Kind_If_Generate_Else_Clause
| Iir_Kind_Signal_Assignment_Statement
| Iir_Kind_Null_Statement
| Iir_Kind_Assertion_Statement
@@ -8978,16 +9086,6 @@ package body Nodes_Meta is
return K = Iir_Kind_Design_Unit;
end Has_End_Location;
- function Has_String8_Id (K : Iir_Kind) return Boolean is
- begin
- return K = Iir_Kind_String_Literal8;
- end Has_String8_Id;
-
- function Has_String_Length (K : Iir_Kind) return Boolean is
- begin
- return K = Iir_Kind_String_Literal8;
- end Has_String_Length;
-
function Has_Use_Flag (K : Iir_Kind) return Boolean is
begin
case K is
@@ -9043,7 +9141,8 @@ package body Nodes_Meta is
| Iir_Kind_Sensitized_Process_Statement
| Iir_Kind_Process_Statement
| Iir_Kind_Block_Statement
- | Iir_Kind_Generate_Statement =>
+ | Iir_Kind_If_Generate_Statement
+ | Iir_Kind_For_Generate_Statement =>
return True;
when others =>
return False;
@@ -9069,7 +9168,9 @@ package body Nodes_Meta is
| Iir_Kind_Sensitized_Process_Statement
| Iir_Kind_Process_Statement
| Iir_Kind_Block_Statement
- | Iir_Kind_Generate_Statement
+ | Iir_Kind_If_Generate_Statement
+ | Iir_Kind_For_Generate_Statement
+ | Iir_Kind_Generate_Statement_Body
| Iir_Kind_For_Loop_Statement
| Iir_Kind_While_Loop_Statement
| Iir_Kind_Case_Statement
@@ -9096,13 +9197,18 @@ package body Nodes_Meta is
begin
case K is
when Iir_Kind_Entity_Declaration
- | Iir_Kind_Generate_Statement =>
+ | Iir_Kind_Generate_Statement_Body =>
return True;
when others =>
return False;
end case;
end Has_Has_Begin;
+ function Has_Has_End (K : Iir_Kind) return Boolean is
+ begin
+ return K = Iir_Kind_Generate_Statement_Body;
+ end Has_Has_End;
+
function Has_Has_Is (K : Iir_Kind) return Boolean is
begin
case K is
diff --git a/src/vhdl/nodes_meta.ads b/src/vhdl/nodes_meta.ads
index a04a31114..a0b0180a4 100644
--- a/src/vhdl/nodes_meta.ads
+++ b/src/vhdl/nodes_meta.ads
@@ -87,6 +87,8 @@ package Nodes_Meta is
Field_Physical_Unit_Value,
Field_Fp_Value,
Field_Simple_Aggregate_List,
+ Field_String8_Id,
+ Field_String_Length,
Field_Bit_String_Base,
Field_Has_Signed,
Field_Has_Sign,
@@ -256,7 +258,9 @@ package Nodes_Meta is
Field_Block_Header,
Field_Uninstantiated_Package_Name,
Field_Generate_Block_Configuration,
- Field_Generation_Scheme,
+ Field_Generate_Statement_Body,
+ Field_Alternative_Label,
+ Field_Generate_Else_Clause,
Field_Condition,
Field_Else_Clause,
Field_Parameter_Specification,
@@ -325,13 +329,12 @@ package Nodes_Meta is
Field_Protected_Type_Body,
Field_Protected_Type_Declaration,
Field_End_Location,
- Field_String8_Id,
- Field_String_Length,
Field_Use_Flag,
Field_End_Has_Reserved_Id,
Field_End_Has_Identifier,
Field_End_Has_Postponed,
Field_Has_Begin,
+ Field_Has_End,
Field_Has_Is,
Field_Has_Pure,
Field_Has_Body,
@@ -550,6 +553,8 @@ package Nodes_Meta is
function Has_Physical_Unit_Value (K : Iir_Kind) return Boolean;
function Has_Fp_Value (K : Iir_Kind) return Boolean;
function Has_Simple_Aggregate_List (K : Iir_Kind) return Boolean;
+ function Has_String8_Id (K : Iir_Kind) return Boolean;
+ function Has_String_Length (K : Iir_Kind) return Boolean;
function Has_Bit_String_Base (K : Iir_Kind) return Boolean;
function Has_Has_Signed (K : Iir_Kind) return Boolean;
function Has_Has_Sign (K : Iir_Kind) return Boolean;
@@ -724,7 +729,9 @@ package Nodes_Meta is
function Has_Block_Header (K : Iir_Kind) return Boolean;
function Has_Uninstantiated_Package_Name (K : Iir_Kind) return Boolean;
function Has_Generate_Block_Configuration (K : Iir_Kind) return Boolean;
- function Has_Generation_Scheme (K : Iir_Kind) return Boolean;
+ function Has_Generate_Statement_Body (K : Iir_Kind) return Boolean;
+ function Has_Alternative_Label (K : Iir_Kind) return Boolean;
+ function Has_Generate_Else_Clause (K : Iir_Kind) return Boolean;
function Has_Condition (K : Iir_Kind) return Boolean;
function Has_Else_Clause (K : Iir_Kind) return Boolean;
function Has_Parameter_Specification (K : Iir_Kind) return Boolean;
@@ -796,13 +803,12 @@ package Nodes_Meta is
function Has_Protected_Type_Body (K : Iir_Kind) return Boolean;
function Has_Protected_Type_Declaration (K : Iir_Kind) return Boolean;
function Has_End_Location (K : Iir_Kind) return Boolean;
- function Has_String8_Id (K : Iir_Kind) return Boolean;
- function Has_String_Length (K : Iir_Kind) return Boolean;
function Has_Use_Flag (K : Iir_Kind) return Boolean;
function Has_End_Has_Reserved_Id (K : Iir_Kind) return Boolean;
function Has_End_Has_Identifier (K : Iir_Kind) return Boolean;
function Has_End_Has_Postponed (K : Iir_Kind) return Boolean;
function Has_Has_Begin (K : Iir_Kind) return Boolean;
+ function Has_Has_End (K : Iir_Kind) return Boolean;
function Has_Has_Is (K : Iir_Kind) return Boolean;
function Has_Has_Pure (K : Iir_Kind) return Boolean;
function Has_Has_Body (K : Iir_Kind) return Boolean;
diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb
index 7d8e3a724..0ebe63226 100644
--- a/src/vhdl/parse.adb
+++ b/src/vhdl/parse.adb
@@ -153,6 +153,8 @@ package body Parse is
Xrefs.Xref_End (Get_Token_Location, Decl);
end if;
end if;
+
+ -- Skip identifier (the label).
Scan;
end Check_End_Name;
@@ -899,6 +901,7 @@ package body Parse is
raise Parse_Error;
end case;
+ -- Skip identifier or string.
Scan;
return Parse_Name_Suffix (Res, Allow_Indexes);
@@ -6079,47 +6082,30 @@ package body Parse is
return Res;
end Parse_Block_Statement;
- -- precond : IF or FOR
- -- postcond: ';'
- --
- -- [ LRM93 9.7 ]
- -- generate_statement ::=
- -- GENERATE_label : generation_scheme GENERATE
- -- [ { block_declarative_item }
- -- BEGIN ]
- -- { concurrent_statement }
- -- END GENERATE [ GENERATE_label ] ;
- --
- -- [ LRM93 9.7 ]
- -- generation_scheme ::=
- -- FOR GENERATE_parameter_specification
- -- | IF condition
- --
- -- FIXME: block_declarative item.
- function Parse_Generate_Statement (Label : Name_Id; Loc : Location_Type)
- return Iir_Generate_Statement
+ -- Precond : next token
+ -- Postcond: next token after 'end'
+ --
+ -- [ LRM08 11.8 ] Generate statements
+ -- generate_statement_body ::=
+ -- [ block_declarative_part
+ -- BEGIN ]
+ -- { concurrent_statement }
+ -- [ END [ alternative_label ] ; ]
+ --
+ -- This corresponds to the following part of LRM93 9.7:
+ -- [ { block_declarative_item }
+ -- BEGIN ]
+ -- { concurrent_statement }
+ -- Note there is no END. This part is followed by:
+ -- END GENERATE [ /generate/_label ] ;
+ function Parse_Generate_Statement_Body (Parent : Iir) return Iir
is
- Res : Iir_Generate_Statement;
+ Bod : Iir;
begin
- if Label = Null_Identifier then
- Error_Msg_Parse ("a generate statement must have a label");
- end if;
- Res := Create_Iir (Iir_Kind_Generate_Statement);
- Set_Location (Res, Loc);
- Set_Label (Res, Label);
- case Current_Token is
- when Tok_For =>
- Scan;
- Set_Generation_Scheme (Res, Parse_Parameter_Specification (Res));
- when Tok_If =>
- Scan;
- Set_Generation_Scheme (Res, Parse_Expression);
- when others =>
- raise Internal_Error;
- end case;
- Expect (Tok_Generate);
+ Bod := Create_Iir (Iir_Kind_Generate_Statement_Body);
+ Set_Location (Bod);
+ Set_Parent (Bod, Parent);
- Scan;
-- Check for a block declarative item.
case Current_Token is
when
@@ -6163,20 +6149,86 @@ package body Parse is
Error_Msg_Parse
("declarations not allowed in a generate in vhdl87");
end if;
- Parse_Declarative_Part (Res);
+ Parse_Declarative_Part (Bod);
Expect (Tok_Begin);
- Set_Has_Begin (Res, True);
+ Set_Has_Begin (Bod, True);
+
+ -- Skip 'begin'
Scan;
when others =>
null;
end case;
- Parse_Concurrent_Statements (Res);
+ Parse_Concurrent_Statements (Bod);
Expect (Tok_End);
-- Skip 'end'
- Scan_Expect (Tok_Generate);
+ Scan;
+
+ if Vhdl_Std >= Vhdl_08 and then Current_Token /= Tok_Generate then
+ -- This is the 'end' of the generate_statement_body.
+ Check_End_Name (Null_Identifier, Bod);
+ Scan_Semi_Colon ("generate statement body");
+
+ Expect (Tok_End);
+
+ -- Skip 'end'
+ Scan;
+ end if;
+
+ return Bod;
+ end Parse_Generate_Statement_Body;
+
+ -- precond : FOR
+ -- postcond: ';'
+ --
+ -- [ LRM93 9.7 ]
+ -- generate_statement ::=
+ -- GENERATE_label : generation_scheme GENERATE
+ -- [ { block_declarative_item }
+ -- BEGIN ]
+ -- { concurrent_statement }
+ -- END GENERATE [ GENERATE_label ] ;
+ --
+ -- [ LRM93 9.7 ]
+ -- generation_scheme ::=
+ -- FOR GENERATE_parameter_specification
+ -- | IF condition
+ --
+ -- [ LRM08 11.8 ]
+ -- for_generate_statement ::=
+ -- /generate/_label :
+ -- FOR /generate/_parameter_specification GENERATE
+ -- generate_statement_body
+ -- END GENERATE [ /generate/_label ] ;
+ --
+ -- FIXME: block_declarative item.
+ function Parse_For_Generate_Statement (Label : Name_Id; Loc : Location_Type)
+ return Iir
+ is
+ Res : Iir;
+ begin
+ if Label = Null_Identifier then
+ Error_Msg_Parse ("a generate statement must have a label");
+ end if;
+ Res := Create_Iir (Iir_Kind_For_Generate_Statement);
+ Set_Location (Res, Loc);
+ Set_Label (Res, Label);
+
+ -- Skip 'for'
+ Scan;
+
+ Set_Parameter_Specification (Res, Parse_Parameter_Specification (Res));
+
+ -- Skip 'generate'
+ Expect (Tok_Generate);
+ Scan;
+
+ Set_Generate_Statement_Body
+ (Res, Parse_Generate_Statement_Body (Res));
+
+ Expect (Tok_Generate);
Set_End_Has_Reserved_Id (Res, True);
-- Skip 'generate'
@@ -6188,7 +6240,62 @@ package body Parse is
Check_End_Name (Res);
Expect (Tok_Semi_Colon);
return Res;
- end Parse_Generate_Statement;
+ end Parse_For_Generate_Statement;
+
+ -- precond : IF
+ -- postcond: ';'
+ --
+ -- [ LRM93 9.7 ]
+ -- generate_statement ::=
+ -- GENERATE_label : generation_scheme GENERATE
+ -- [ { block_declarative_item }
+ -- BEGIN ]
+ -- { concurrent_statement }
+ -- END GENERATE [ GENERATE_label ] ;
+ --
+ -- [ LRM93 9.7 ]
+ -- generation_scheme ::=
+ -- FOR GENERATE_parameter_specification
+ -- | IF condition
+ --
+ -- FIXME: block_declarative item.
+ function Parse_If_Generate_Statement (Label : Name_Id; Loc : Location_Type)
+ return Iir_Generate_Statement
+ is
+ Res : Iir_Generate_Statement;
+ begin
+ if Label = Null_Identifier then
+ Error_Msg_Parse ("a generate statement must have a label");
+ end if;
+ Res := Create_Iir (Iir_Kind_If_Generate_Statement);
+ Set_Location (Res, Loc);
+ Set_Label (Res, Label);
+
+ -- Skip 'if'.
+ Scan;
+
+ Set_Condition (Res, Parse_Expression);
+
+ -- Skip 'generate'
+ Expect (Tok_Generate);
+ Scan;
+
+ Set_Generate_Statement_Body
+ (Res, Parse_Generate_Statement_Body (Res));
+
+ Expect (Tok_Generate);
+ Set_End_Has_Reserved_Id (Res, True);
+
+ -- Skip 'generate'
+ Scan;
+
+ -- LRM93 9.7
+ -- If a label appears at the end of a generate statement, it must repeat
+ -- the generate label.
+ Check_End_Name (Res);
+ Expect (Tok_Semi_Colon);
+ return Res;
+ end Parse_If_Generate_Statement;
-- precond : first token
-- postcond: END
@@ -6438,14 +6545,12 @@ package body Parse is
when Tok_Block =>
Postponed_Not_Allowed;
Stmt := Parse_Block_Statement (Label, Loc);
- when Tok_If
- | Tok_For =>
- if Postponed then
- Error_Msg_Parse
- ("'postponed' not allowed before a generate statement");
- Postponed := False;
- end if;
- Stmt := Parse_Generate_Statement (Label, Loc);
+ when Tok_If =>
+ Postponed_Not_Allowed;
+ Stmt := Parse_If_Generate_Statement (Label, Loc);
+ when Tok_For =>
+ Postponed_Not_Allowed;
+ Stmt := Parse_For_Generate_Statement (Label, Loc);
when Tok_Eof =>
Error_Msg_Parse ("unexpected end of file, 'END;' expected");
return;
diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb
index a8cbbd4f3..2ecee9321 100644
--- a/src/vhdl/sem.adb
+++ b/src/vhdl/sem.adb
@@ -669,6 +669,107 @@ package body Sem is
Close_Declarative_Region;
end Sem_Configuration_Declaration;
+ -- Analyze the block specification of a block statement or of a generate
+ -- statement. Return the corresponding block statement, generate
+ -- statement body, or Null_Iir in case of error.
+ function Sem_Block_Specification_Of_Statement
+ (Block_Conf : Iir_Block_Configuration; Father : Iir) return Iir
+ is
+ Block_Spec : Iir;
+ Block_Name : Iir;
+ Block_Stmts : Iir;
+ Prev : Iir_Block_Configuration;
+ Block : Iir;
+ Res : Iir;
+ begin
+ Block_Spec := Get_Block_Specification (Block_Conf);
+ case Get_Kind (Block_Spec) is
+ when Iir_Kind_Simple_Name =>
+ Block_Name := Block_Spec;
+ when Iir_Kind_Parenthesis_Name
+ | Iir_Kind_Slice_Name =>
+ Block_Name := Get_Prefix (Block_Spec);
+ when others =>
+ Error_Msg_Sem ("label expected", Block_Spec);
+ return Null_Iir;
+ end case;
+
+ -- Analyze the label.
+ Block_Name := Sem_Denoting_Name (Block_Name);
+ Block := Get_Named_Entity (Block_Name);
+ case Get_Kind (Block) is
+ when Iir_Kind_Block_Statement =>
+ if Get_Kind (Block_Spec) /= Iir_Kind_Simple_Name then
+ Error_Msg_Sem ("label does not denote a generate statement",
+ Block_Spec);
+ end if;
+ Prev := Get_Block_Block_Configuration (Block);
+ if Prev /= Null_Iir then
+ Error_Msg_Sem
+ (Disp_Node (Block) & " was already configured at "
+ & Disp_Location (Prev),
+ Block_Conf);
+ return Null_Iir;
+ end if;
+ Set_Block_Block_Configuration (Block, Block_Conf);
+ Res := Block;
+ when Iir_Kind_For_Generate_Statement
+ | Iir_Kind_If_Generate_Statement =>
+ if Get_Kind (Block_Spec) /= Iir_Kind_Simple_Name
+ and then
+ Get_Kind (Block) /= Iir_Kind_For_Generate_Statement
+ then
+ -- LRM93 1.3
+ -- If the block specification of a block configuration
+ -- contains a generate statement label, and if this
+ -- label contains an index specification, then it is
+ -- an error if the generate statement denoted by the
+ -- label does not have a generation scheme including
+ -- the reserved word for.
+ Error_Msg_Sem ("generate statement does not has a for",
+ Block_Spec);
+ return Null_Iir;
+ end if;
+
+ Res := Get_Generate_Statement_Body (Block);
+ Set_Named_Entity (Block_Name, Res);
+ Set_Prev_Block_Configuration
+ (Block_Conf, Get_Generate_Block_Configuration (Res));
+ Set_Generate_Block_Configuration (Res, Block_Conf);
+ when others =>
+ Error_Msg_Sem ("block statement label expected", Block_Conf);
+ return Null_Iir;
+ end case;
+
+ -- LRM93 1.3.1 / LRM08 3.4.2 Block configuration
+ -- [...], and the label must denote a block statement or generate
+ -- statement that is contained immediatly within the block denoted by
+ -- the block specification of the containing block configuration.
+ Block_Stmts := Get_Concurrent_Statement_Chain
+ (Get_Block_From_Block_Specification
+ (Get_Block_Specification (Father)));
+ if not Is_In_Chain (Block_Stmts, Block) then
+ Error_Msg_Sem ("label does not denotes an inner block statement",
+ Block_Conf);
+ return Null_Iir;
+ end if;
+
+ case Get_Kind (Block_Spec) is
+ when Iir_Kind_Simple_Name =>
+ Set_Block_Specification (Block_Conf, Block_Name);
+ when Iir_Kind_Parenthesis_Name =>
+ Block_Spec := Sem_Index_Specification
+ (Block_Spec, Get_Type (Get_Parameter_Specification (Block)));
+ if Block_Spec /= Null_Iir then
+ Set_Prefix (Block_Spec, Block_Name);
+ Set_Block_Specification (Block_Conf, Block_Spec);
+ end if;
+ when others =>
+ raise Internal_Error;
+ end case;
+ return Res;
+ end Sem_Block_Specification_Of_Statement;
+
-- LRM 1.3.1 Block Configuration.
-- FATHER is the block_configuration, configuration_declaration,
-- component_configuration containing the block_configuration BLOCK_CONF.
@@ -784,7 +885,7 @@ package body Sem is
end;
when Iir_Kind_Block_Configuration =>
- -- LRM93 1.3.1
+ -- LRM93 1.3.1 / LRM08 3.4.2 Block configuration
-- If a block configuration appears immediately within another
-- block configuration, then the block specification of the
-- contained block configuration must be a block statement or
@@ -792,102 +893,10 @@ package body Sem is
-- statement or generate statement that is contained immediatly
-- within the block denoted by the block specification of the
-- containing block configuration.
- declare
- Block_Spec : Iir;
- Block_Name : Iir;
- Block_Stmts : Iir;
- Block_Spec_Kind : Iir_Kind;
- Prev : Iir_Block_Configuration;
- begin
- Block_Spec := Get_Block_Specification (Block_Conf);
- -- Remember the kind of BLOCK_SPEC, since the node can be free
- -- by find_declaration if it is a simple name.
- Block_Spec_Kind := Get_Kind (Block_Spec);
- case Block_Spec_Kind is
- when Iir_Kind_Simple_Name =>
- Block_Name := Block_Spec;
- when Iir_Kind_Parenthesis_Name =>
- Block_Name := Get_Prefix (Block_Spec);
- when Iir_Kind_Slice_Name =>
- Block_Name := Get_Prefix (Block_Spec);
- when others =>
- Error_Msg_Sem ("label expected", Block_Spec);
- return;
- end case;
- Block_Name := Sem_Denoting_Name (Block_Name);
- Block := Get_Named_Entity (Block_Name);
- case Get_Kind (Block) is
- when Iir_Kind_Block_Statement =>
- if Block_Spec_Kind /= Iir_Kind_Simple_Name then
- Error_Msg_Sem
- ("label does not denote a generate statement",
- Block_Spec);
- end if;
- Prev := Get_Block_Block_Configuration (Block);
- if Prev /= Null_Iir then
- Error_Msg_Sem
- (Disp_Node (Block) & " was already configured at "
- & Disp_Location (Prev),
- Block_Conf);
- return;
- end if;
- Set_Block_Block_Configuration (Block, Block_Conf);
- when Iir_Kind_Generate_Statement =>
- if Block_Spec_Kind /= Iir_Kind_Simple_Name
- and then Get_Kind (Get_Generation_Scheme (Block))
- /= Iir_Kind_Iterator_Declaration
- then
- -- LRM93 1.3
- -- If the block specification of a block configuration
- -- contains a generate statement label, and if this
- -- label contains an index specification, then it is
- -- an error if the generate statement denoted by the
- -- label does not have a generation scheme including
- -- the reserved word for.
- Error_Msg_Sem ("generate statement does not has a for",
- Block_Spec);
- return;
- end if;
- Set_Prev_Block_Configuration
- (Block_Conf, Get_Generate_Block_Configuration (Block));
- Set_Generate_Block_Configuration (Block, Block_Conf);
- when others =>
- Error_Msg_Sem ("block statement label expected",
- Block_Conf);
- return;
- end case;
- Block_Stmts := Get_Concurrent_Statement_Chain
- (Get_Block_From_Block_Specification
- (Get_Block_Specification (Father)));
- if not Is_In_Chain (Block_Stmts, Block) then
- Error_Msg_Sem
- ("label does not denotes an inner block statement",
- Block_Conf);
- return;
- end if;
-
- if Block_Spec_Kind = Iir_Kind_Parenthesis_Name then
- Block_Spec := Sem_Index_Specification
- (Block_Spec, Get_Type (Get_Generation_Scheme (Block)));
- if Block_Spec /= Null_Iir then
- Set_Prefix (Block_Spec, Block_Name);
- Set_Block_Specification (Block_Conf, Block_Spec);
- Block_Spec_Kind := Get_Kind (Block_Spec);
- end if;
- end if;
-
- case Block_Spec_Kind is
- when Iir_Kind_Simple_Name =>
- Set_Block_Specification (Block_Conf, Block_Name);
- when Iir_Kind_Indexed_Name
- | Iir_Kind_Slice_Name =>
- null;
- when Iir_Kind_Parenthesis_Name =>
- null;
- when others =>
- raise Internal_Error;
- end case;
- end;
+ Block := Sem_Block_Specification_Of_Statement (Block_Conf, Father);
+ if Block = Null_Iir then
+ return;
+ end if;
when others =>
Error_Kind ("sem_block_configuration", Father);
diff --git a/src/vhdl/sem_decls.adb b/src/vhdl/sem_decls.adb
index 64fd897e6..da7b1b2be 100644
--- a/src/vhdl/sem_decls.adb
+++ b/src/vhdl/sem_decls.adb
@@ -1702,7 +1702,7 @@ package body Sem_Decls is
| Iir_Kind_Package_Declaration
| Iir_Kind_Package_Body
| Iir_Kind_Block_Statement
- | Iir_Kind_Generate_Statement =>
+ | Iir_Kind_Generate_Statement_Body =>
if not Get_Shared_Flag (Decl) then
Error_Msg_Sem
("non shared variable declaration not allowed here",
@@ -2890,11 +2890,13 @@ package body Sem_Decls is
-- May be used in architecture.
null;
when Iir_Kind_Architecture_Body
- | Iir_Kind_Block_Statement
- | Iir_Kind_Generate_Statement =>
+ | Iir_Kind_Block_Statement =>
-- Might be used in a configuration.
-- FIXME: create a second level of warning.
null;
+ when Iir_Kind_Generate_Statement_Body =>
+ -- Might be used in a configuration.
+ null;
when Iir_Kind_Package_Body
| Iir_Kind_Protected_Type_Body =>
-- Check only for declarations of the body.
diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb
index 472276956..933401725 100644
--- a/src/vhdl/sem_names.adb
+++ b/src/vhdl/sem_names.adb
@@ -324,7 +324,8 @@ package body Sem_Names is
Iterator_Decl_Chain (Get_Port_Chain (Decl), Id);
when Iir_Kind_Architecture_Body =>
null;
- when Iir_Kind_Generate_Statement =>
+ when Iir_Kind_If_Generate_Statement
+ | Iir_Kind_For_Generate_Statement =>
null;
when Iir_Kind_Package_Declaration =>
null;
@@ -358,10 +359,30 @@ package body Sem_Names is
(Get_Sequential_Statement_Chain (Decl_Body), Id);
when Iir_Kind_Architecture_Body
| Iir_Kind_Entity_Declaration
- | Iir_Kind_Generate_Statement
| Iir_Kind_Block_Statement =>
Iterator_Decl_Chain (Get_Declaration_Chain (Decl), Id);
Iterator_Decl_Chain (Get_Concurrent_Statement_Chain (Decl), Id);
+ when Iir_Kind_For_Generate_Statement =>
+ declare
+ Bod : constant Iir := Get_Generate_Block_Configuration (Decl);
+ begin
+ Iterator_Decl_Chain (Get_Declaration_Chain (Bod), Id);
+ Iterator_Decl_Chain (Get_Concurrent_Statement_Chain (Bod), Id);
+ end;
+ when Iir_Kind_If_Generate_Statement =>
+ declare
+ Bod : constant Iir := Get_Generate_Statement_Body (Decl);
+ begin
+ if Get_Alternative_Label (Bod) = Null_Identifier then
+ Iterator_Decl_Chain
+ (Get_Declaration_Chain (Bod), Id);
+ Iterator_Decl_Chain
+ (Get_Concurrent_Statement_Chain (Bod), Id);
+ else
+ -- Error in LRM08
+ raise Internal_Error;
+ end if;
+ end;
when Iir_Kind_Package_Declaration
| Iir_Kind_Package_Instantiation_Declaration =>
Iterator_Decl_Chain (Get_Declaration_Chain (Decl), Id);
@@ -1294,7 +1315,8 @@ package body Sem_Names is
| Iir_Kind_Package_Declaration
| Iir_Kind_Package_Body
| Iir_Kind_Block_Statement
- | Iir_Kind_Generate_Statement
+ | Iir_Kind_If_Generate_Statement
+ | Iir_Kind_For_Generate_Statement
| Iir_Kinds_Process_Statement
| Iir_Kind_Protected_Type_Body =>
-- The procedure is impure.
@@ -1850,7 +1872,8 @@ package body Sem_Names is
| Iir_Kind_Entity_Declaration
| Iir_Kind_Package_Declaration
| Iir_Kind_Package_Instantiation_Declaration
- | Iir_Kind_Generate_Statement
+ | Iir_Kind_If_Generate_Statement
+ | Iir_Kind_For_Generate_Statement
| Iir_Kind_Block_Statement
| Iir_Kind_For_Loop_Statement =>
-- LRM93 §6.3
diff --git a/src/vhdl/sem_scopes.adb b/src/vhdl/sem_scopes.adb
index 490ce602e..f77e6e827 100644
--- a/src/vhdl/sem_scopes.adb
+++ b/src/vhdl/sem_scopes.adb
@@ -1160,7 +1160,7 @@ package body Sem_Scopes is
when Iir_Kind_Architecture_Body =>
Add_Context_Clauses (Get_Design_Unit (Decl));
when Iir_Kind_Block_Statement
- | Iir_Kind_Generate_Statement =>
+ | Iir_Kind_Generate_Statement_Body =>
-- FIXME: formal, iterator ?
null;
when others =>
diff --git a/src/vhdl/sem_specs.adb b/src/vhdl/sem_specs.adb
index d2ace1580..47807a068 100644
--- a/src/vhdl/sem_specs.adb
+++ b/src/vhdl/sem_specs.adb
@@ -74,7 +74,8 @@ package body Sem_Specs is
| Iir_Kind_Concurrent_Assertion_Statement
| Iir_Kind_Component_Instantiation_Statement
| Iir_Kind_Block_Statement
- | Iir_Kind_Generate_Statement
+ | Iir_Kind_If_Generate_Statement
+ | Iir_Kind_For_Generate_Statement
| Iir_Kind_If_Statement
| Iir_Kind_For_Loop_Statement
| Iir_Kind_While_Loop_Statement
@@ -530,7 +531,8 @@ package body Sem_Specs is
end loop;
end;
- when Iir_Kind_Generate_Statement =>
+ when Iir_Kind_If_Generate_Statement
+ | Iir_Kind_For_Generate_Statement =>
-- INT-1991/issue 27
-- Generate statements represent declarative region and
-- have implicit declarative parts.
@@ -619,7 +621,7 @@ package body Sem_Specs is
case Get_Kind (Scope) is
when Iir_Kind_Entity_Declaration
| Iir_Kind_Architecture_Body
- | Iir_Kind_Generate_Statement =>
+ | Iir_Kind_Generate_Statement_Body =>
Sem_Named_Entity_Chain (Get_Declaration_Chain (Scope));
Sem_Named_Entity_Chain (Get_Concurrent_Statement_Chain (Scope));
when Iir_Kind_Block_Statement =>
@@ -1283,7 +1285,8 @@ package body Sem_Specs is
(El, Spec, Primary_Entity_Aspect);
Res := True;
end if;
- when Iir_Kind_Generate_Statement =>
+ when Iir_Kind_For_Generate_Statement
+ | Iir_Kind_If_Generate_Statement =>
if False and then Flags.Vhdl_Std = Vhdl_87 then
Res := Res
or Apply_Component_Specification (El, Check_Applied);
diff --git a/src/vhdl/sem_stmts.adb b/src/vhdl/sem_stmts.adb
index c220791bb..b64e9ac90 100644
--- a/src/vhdl/sem_stmts.adb
+++ b/src/vhdl/sem_stmts.adb
@@ -1511,46 +1511,68 @@ package body Sem_Stmts is
Close_Declarative_Region;
end Sem_Block_Statement;
- procedure Sem_Generate_Statement (Stmt : Iir_Generate_Statement)
+ procedure Sem_Generate_Statement_Body (Parent : Iir)
is
- Scheme : Iir;
+ Bod : constant Iir := Get_Generate_Statement_Body (Parent);
+ begin
+ Sem_Block (Bod, True); -- Flags.Vhdl_Std /= Vhdl_87);
+ end Sem_Generate_Statement_Body;
+
+ procedure Sem_For_Generate_Statement (Stmt : Iir)
+ is
+ Param : Iir;
begin
-- LRM93 10.1 Declarative region.
-- 12. A generate statement.
Open_Declarative_Region;
- Scheme := Get_Generation_Scheme (Stmt);
- if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
- Sem_Scopes.Add_Name (Scheme);
- -- LRM93 §7.4.2 (Globally Static Primaries)
- -- 4. a generate parameter;
- Sem_Iterator (Scheme, Globally);
- Set_Visible_Flag (Scheme, True);
- -- LRM93 §9.7
- -- The discrete range in a generation scheme of the first form must
- -- be a static discrete range;
- if Get_Type (Scheme) /= Null_Iir
- and then Get_Type_Staticness (Get_Type (Scheme)) < Globally
- then
- Error_Msg_Sem ("range must be a static discrete range", Stmt);
- end if;
+ Param := Get_Parameter_Specification (Stmt);
+ Sem_Scopes.Add_Name (Param);
+ -- LRM93 7.4.2 (Globally Static Primaries)
+ -- 4. a generate parameter;
+ Sem_Iterator (Param, Globally);
+ Set_Visible_Flag (Param, True);
+ -- LRM93 9.7
+ -- The discrete range in a generation scheme of the first form must
+ -- be a static discrete range;
+ if Get_Type (Param) /= Null_Iir
+ and then Get_Type_Staticness (Get_Type (Param)) < Globally
+ then
+ Error_Msg_Sem ("range must be a static discrete range", Stmt);
+ end if;
+
+ -- In the same declarative region.
+ Sem_Generate_Statement_Body (Stmt);
+
+ Close_Declarative_Region;
+ end Sem_For_Generate_Statement;
+
+ procedure Sem_If_Generate_Statement (Stmt : Iir)
+ is
+ Condition : Iir;
+ begin
+ -- LRM93 10.1 Declarative region.
+ -- 12. A generate statement.
+ Open_Declarative_Region;
+
+ Condition := Get_Condition (Stmt);
+ Condition := Sem_Condition (Condition);
+ -- LRM93 9.7
+ -- the condition in a generation scheme of the second form must be
+ -- a static expression.
+ if Condition /= Null_Iir
+ and then Get_Expr_Staticness (Condition) < Globally
+ then
+ Error_Msg_Sem ("condition must be a static expression", Condition);
else
- Scheme := Sem_Condition (Scheme);
- -- LRM93 §9.7
- -- the condition in a generation scheme of the second form must be
- -- a static expression.
- if Scheme /= Null_Iir
- and then Get_Expr_Staticness (Scheme) < Globally
- then
- Error_Msg_Sem ("condition must be a static expression", Stmt);
- else
- Set_Generation_Scheme (Stmt, Scheme);
- end if;
+ Set_Condition (Stmt, Condition);
end if;
- Sem_Block (Stmt, True); -- Flags.Vhdl_Std /= Vhdl_87);
+ -- In the same declarative region.
+ Sem_Generate_Statement_Body (Stmt);
+
Close_Declarative_Region;
- end Sem_Generate_Statement;
+ end Sem_If_Generate_Statement;
procedure Sem_Process_Statement (Proc: Iir) is
begin
@@ -1786,6 +1808,14 @@ package body Sem_Stmts is
Is_Passive : constant Boolean :=
Get_Kind (Parent) = Iir_Kind_Entity_Declaration;
El: Iir;
+
+ procedure No_Generate_Statement is
+ begin
+ if Is_Passive then
+ Error_Msg_Sem ("generate statement forbidden in entity", El);
+ end if;
+ end No_Generate_Statement;
+
Prev_El : Iir;
Prev_Concurrent_Statement : Iir;
Prev_Psl_Default_Clock : Iir;
@@ -1826,11 +1856,12 @@ package body Sem_Stmts is
Error_Msg_Sem ("block forbidden in entity", El);
end if;
Sem_Block_Statement (El);
- when Iir_Kind_Generate_Statement =>
- if Is_Passive then
- Error_Msg_Sem ("generate statement forbidden in entity", El);
- end if;
- Sem_Generate_Statement (El);
+ when Iir_Kind_If_Generate_Statement =>
+ No_Generate_Statement;
+ Sem_If_Generate_Statement (El);
+ when Iir_Kind_For_Generate_Statement =>
+ No_Generate_Statement;
+ Sem_For_Generate_Statement (El);
when Iir_Kind_Concurrent_Procedure_Call_Statement =>
declare
Next_El : Iir;
@@ -1898,7 +1929,9 @@ package body Sem_Stmts is
-- implicit declarative part.
if False
and then Flags.Vhdl_Std = Vhdl_87
- and then Get_Kind (Stmt) = Iir_Kind_Generate_Statement
+ and then
+ (Get_Kind (Stmt) = Iir_Kind_For_Generate_Statement
+ or else Get_Kind (Stmt) = Iir_Kind_If_Generate_Statement)
then
Sem_Labels_Chain (Stmt);
end if;
diff --git a/src/vhdl/translate/trans-chap1.adb b/src/vhdl/translate/trans-chap1.adb
index 40d6fce45..ae2b10699 100644
--- a/src/vhdl/translate/trans-chap1.adb
+++ b/src/vhdl/translate/trans-chap1.adb
@@ -448,7 +448,7 @@ package body Trans.Chap1 is
begin
Push_Identifier_Prefix (Mark, Get_Identifier (Blk));
case Get_Kind (Blk) is
- when Iir_Kind_Generate_Statement =>
+ when Iir_Kind_Generate_Statement_Body =>
Set_Scope_Via_Field_Ptr
(Base_Info.Block_Scope,
Blk_Info.Block_Origin_Field,
@@ -531,17 +531,19 @@ package body Trans.Chap1 is
Base_Block : Iir;
Base_Info : Block_Info_Acc);
- procedure Translate_Generate_Block_Configuration_Calls
+ procedure Translate_For_Generate_Block_Configuration_Calls
(Block_Config : Iir_Block_Configuration;
Parent_Info : Block_Info_Acc)
is
Spec : constant Iir := Get_Block_Specification (Block_Config);
- Block : constant Iir := Get_Block_From_Block_Specification (Spec);
- Info : constant Block_Info_Acc := Get_Info (Block);
- Scheme : constant Iir := Get_Generation_Scheme (Block);
+ Bod : constant Iir := Get_Block_From_Block_Specification (Spec);
+ Block : constant Iir := Get_Parent (Bod);
+ Info : constant Block_Info_Acc := Get_Info (Bod);
- Type_Info : Type_Info_Acc;
- Iter_Type : Iir;
+ Iter : constant Iir := Get_Parameter_Specification (Block);
+ Iter_Type : constant Iir := Get_Type (Iter);
+ Type_Info : constant Type_Info_Acc :=
+ Get_Info (Get_Base_Type (Iter_Type));
-- Generate a call for a iterative generate block whose index is
-- INDEX.
@@ -578,7 +580,7 @@ package body Trans.Chap1 is
Info.Block_Configured_Field),
New_Lit (Ghdl_Bool_True_Node));
Set_Scope_Via_Param_Ptr (Info.Block_Scope, Var_Inst);
- Translate_Block_Configuration_Calls (Block_Config, Block, Info);
+ Translate_Block_Configuration_Calls (Block_Config, Bod, Info);
Clear_Scope (Info.Block_Scope);
if Fails then
@@ -620,135 +622,137 @@ package body Trans.Chap1 is
Finish_Declare_Stmt;
end Apply_To_All_Others_Blocks;
begin
- if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
- Iter_Type := Get_Type (Scheme);
- Type_Info := Get_Info (Get_Base_Type (Iter_Type));
- case Get_Kind (Spec) is
- when Iir_Kind_Generate_Statement
- | Iir_Kind_Simple_Name =>
- Apply_To_All_Others_Blocks (True);
- when Iir_Kind_Indexed_Name =>
- declare
- Index_List : constant Iir_List := Get_Index_List (Spec);
- Rng : Mnode;
- begin
- if Index_List = Iir_List_Others then
- Apply_To_All_Others_Blocks (False);
- else
- Open_Temp;
- Rng := Stabilize (Chap3.Type_To_Range (Iter_Type));
- Gen_Subblock_Call
- (Chap6.Translate_Index_To_Offset
- (Rng,
- Chap7.Translate_Expression
- (Get_Nth_Element (Index_List, 0), Iter_Type),
- Scheme, Iter_Type, Spec),
- True);
- Close_Temp;
- end if;
- end;
- when Iir_Kind_Slice_Name =>
- declare
- Rng : Mnode;
- Slice : O_Dnode;
- Left, Right : O_Dnode;
- Index : O_Dnode;
- High : O_Dnode;
- If_Blk : O_If_Block;
- Label : O_Snode;
- begin
+ case Get_Kind (Spec) is
+ when Iir_Kind_For_Generate_Statement
+ | Iir_Kind_Simple_Name =>
+ Apply_To_All_Others_Blocks (True);
+ when Iir_Kind_Indexed_Name =>
+ declare
+ Index_List : constant Iir_List := Get_Index_List (Spec);
+ Rng : Mnode;
+ begin
+ if Index_List = Iir_List_Others then
+ Apply_To_All_Others_Blocks (False);
+ else
Open_Temp;
Rng := Stabilize (Chap3.Type_To_Range (Iter_Type));
- Slice := Create_Temp (Type_Info.T.Range_Type);
- Chap7.Translate_Discrete_Range
- (Dv2M (Slice, Type_Info, Mode_Value,
- Type_Info.T.Range_Type, Type_Info.T.Range_Ptr_Type),
- Get_Suffix (Spec));
- Left := Create_Temp_Init
- (Ghdl_Index_Type,
- Chap6.Translate_Index_To_Offset
- (Rng,
- New_Value (New_Selected_Element
- (New_Obj (Slice), Type_Info.T.Range_Left)),
- Spec, Iter_Type, Spec));
- Right := Create_Temp_Init
- (Ghdl_Index_Type,
- Chap6.Translate_Index_To_Offset
+ Gen_Subblock_Call
+ (Chap6.Translate_Index_To_Offset
(Rng,
- New_Value (New_Selected_Element
- (New_Obj (Slice),
- Type_Info.T.Range_Right)),
- Spec, Iter_Type, Spec));
- Index := Create_Temp (Ghdl_Index_Type);
- High := Create_Temp (Ghdl_Index_Type);
- Start_If_Stmt
- (If_Blk,
- New_Compare_Op (ON_Eq,
- M2E (Chap3.Range_To_Dir (Rng)),
- New_Value
- (New_Selected_Element
- (New_Obj (Slice),
- Type_Info.T.Range_Dir)),
- Ghdl_Bool_Type));
- -- Same direction, so left to right.
- New_Assign_Stmt (New_Obj (Index),
- New_Value (New_Obj (Left)));
- New_Assign_Stmt (New_Obj (High),
- New_Value (New_Obj (Right)));
- New_Else_Stmt (If_Blk);
- -- Opposite direction, so right to left.
- New_Assign_Stmt (New_Obj (Index),
- New_Value (New_Obj (Right)));
- New_Assign_Stmt (New_Obj (High),
- New_Value (New_Obj (Left)));
- Finish_If_Stmt (If_Blk);
-
- -- Loop.
- Start_Loop_Stmt (Label);
- Gen_Exit_When
- (Label, New_Compare_Op (ON_Gt,
- New_Value (New_Obj (Index)),
- New_Value (New_Obj (High)),
- Ghdl_Bool_Type));
- Open_Temp;
- Gen_Subblock_Call (New_Value (New_Obj (Index)), True);
- Close_Temp;
- Inc_Var (Index);
- Finish_Loop_Stmt (Label);
+ Chap7.Translate_Expression
+ (Get_Nth_Element (Index_List, 0), Iter_Type),
+ Iter, Iter_Type, Spec),
+ True);
Close_Temp;
- end;
- when others =>
- Error_Kind
- ("translate_generate_block_configuration_calls", Spec);
- end case;
- else
- -- Conditional generate statement.
- declare
- Var : O_Dnode;
- If_Blk : O_If_Block;
- begin
- -- Configure the block only if it was created.
- Open_Temp;
- Var := Create_Temp_Init
- (Info.Block_Decls_Ptr_Type,
- New_Value (New_Selected_Element
- (Get_Instance_Ref (Parent_Info.Block_Scope),
- Info.Block_Parent_Field)));
- Start_If_Stmt
- (If_Blk,
- New_Compare_Op
- (ON_Neq,
- New_Obj_Value (Var),
- New_Lit (New_Null_Access (Info.Block_Decls_Ptr_Type)),
- Ghdl_Bool_Type));
- Set_Scope_Via_Param_Ptr (Info.Block_Scope, Var);
- Translate_Block_Configuration_Calls (Block_Config, Block, Info);
- Clear_Scope (Info.Block_Scope);
- Finish_If_Stmt (If_Blk);
- Close_Temp;
- end;
- end if;
- end Translate_Generate_Block_Configuration_Calls;
+ end if;
+ end;
+ when Iir_Kind_Slice_Name =>
+ declare
+ Rng : Mnode;
+ Slice : O_Dnode;
+ Left, Right : O_Dnode;
+ Index : O_Dnode;
+ High : O_Dnode;
+ If_Blk : O_If_Block;
+ Label : O_Snode;
+ begin
+ Open_Temp;
+ Rng := Stabilize (Chap3.Type_To_Range (Iter_Type));
+ Slice := Create_Temp (Type_Info.T.Range_Type);
+ Chap7.Translate_Discrete_Range
+ (Dv2M (Slice, Type_Info, Mode_Value,
+ Type_Info.T.Range_Type, Type_Info.T.Range_Ptr_Type),
+ Get_Suffix (Spec));
+ Left := Create_Temp_Init
+ (Ghdl_Index_Type,
+ Chap6.Translate_Index_To_Offset
+ (Rng,
+ New_Value (New_Selected_Element
+ (New_Obj (Slice), Type_Info.T.Range_Left)),
+ Spec, Iter_Type, Spec));
+ Right := Create_Temp_Init
+ (Ghdl_Index_Type,
+ Chap6.Translate_Index_To_Offset
+ (Rng,
+ New_Value (New_Selected_Element
+ (New_Obj (Slice),
+ Type_Info.T.Range_Right)),
+ Spec, Iter_Type, Spec));
+ Index := Create_Temp (Ghdl_Index_Type);
+ High := Create_Temp (Ghdl_Index_Type);
+ Start_If_Stmt
+ (If_Blk,
+ New_Compare_Op (ON_Eq,
+ M2E (Chap3.Range_To_Dir (Rng)),
+ New_Value
+ (New_Selected_Element
+ (New_Obj (Slice),
+ Type_Info.T.Range_Dir)),
+ Ghdl_Bool_Type));
+ -- Same direction, so left to right.
+ New_Assign_Stmt (New_Obj (Index),
+ New_Value (New_Obj (Left)));
+ New_Assign_Stmt (New_Obj (High),
+ New_Value (New_Obj (Right)));
+ New_Else_Stmt (If_Blk);
+ -- Opposite direction, so right to left.
+ New_Assign_Stmt (New_Obj (Index),
+ New_Value (New_Obj (Right)));
+ New_Assign_Stmt (New_Obj (High),
+ New_Value (New_Obj (Left)));
+ Finish_If_Stmt (If_Blk);
+
+ -- Loop.
+ Start_Loop_Stmt (Label);
+ Gen_Exit_When
+ (Label, New_Compare_Op (ON_Gt,
+ New_Value (New_Obj (Index)),
+ New_Value (New_Obj (High)),
+ Ghdl_Bool_Type));
+ Open_Temp;
+ Gen_Subblock_Call (New_Value (New_Obj (Index)), True);
+ Close_Temp;
+ Inc_Var (Index);
+ Finish_Loop_Stmt (Label);
+ Close_Temp;
+ end;
+ when others =>
+ Error_Kind
+ ("translate_for_generate_block_configuration_calls", Spec);
+ end case;
+ end Translate_For_Generate_Block_Configuration_Calls;
+
+ procedure Translate_If_Generate_Block_Configuration_Calls
+ (Block_Config : Iir_Block_Configuration;
+ Parent_Info : Block_Info_Acc)
+ is
+ Spec : constant Iir := Get_Block_Specification (Block_Config);
+ Block : constant Iir := Get_Block_From_Block_Specification (Spec);
+ Info : constant Block_Info_Acc := Get_Info (Block);
+ Var : O_Dnode;
+ If_Blk : O_If_Block;
+
+ begin
+ -- Configure the block only if it was created.
+ Open_Temp;
+ Var := Create_Temp_Init
+ (Info.Block_Decls_Ptr_Type,
+ New_Value (New_Selected_Element
+ (Get_Instance_Ref (Parent_Info.Block_Scope),
+ Info.Block_Parent_Field)));
+ Start_If_Stmt
+ (If_Blk,
+ New_Compare_Op
+ (ON_Neq,
+ New_Obj_Value (Var),
+ New_Lit (New_Null_Access (Info.Block_Decls_Ptr_Type)),
+ Ghdl_Bool_Type));
+ Set_Scope_Via_Param_Ptr (Info.Block_Scope, Var);
+ Translate_Block_Configuration_Calls (Block_Config, Block, Info);
+ Clear_Scope (Info.Block_Scope);
+ Finish_If_Stmt (If_Blk);
+ Close_Temp;
+ end Translate_If_Generate_Block_Configuration_Calls;
procedure Translate_Block_Configuration_Calls
(Block_Config : Iir_Block_Configuration;
@@ -766,16 +770,40 @@ package body Trans.Chap1 is
(El, Base_Block, Base_Info);
when Iir_Kind_Block_Configuration =>
declare
- Block : constant Iir := Strip_Denoting_Name
- (Get_Block_Specification (El));
+ Block : Iir;
begin
- if Get_Kind (Block) = Iir_Kind_Block_Statement then
- Translate_Block_Configuration_Calls
- (El, Base_Block, Get_Info (Block));
- else
- Translate_Generate_Block_Configuration_Calls
- (El, Base_Info);
- end if;
+ Block := Get_Block_Specification (El);
+ case Get_Kind (Block) is
+ when Iir_Kind_Indexed_Name
+ | Iir_Kind_Slice_Name =>
+ Block := Get_Named_Entity (Get_Prefix (Block));
+ when Iir_Kinds_Denoting_Name =>
+ Block := Get_Named_Entity (Block);
+ when others =>
+ null;
+ end case;
+
+ case Get_Kind (Block) is
+ when Iir_Kind_Block_Statement =>
+ Translate_Block_Configuration_Calls
+ (El, Base_Block, Get_Info (Block));
+ when Iir_Kind_Generate_Statement_Body =>
+ case Get_Kind (Get_Parent (Block)) is
+ when Iir_Kind_If_Generate_Statement =>
+ Translate_If_Generate_Block_Configuration_Calls
+ (El, Base_Info);
+ when Iir_Kind_For_Generate_Statement =>
+ Translate_For_Generate_Block_Configuration_Calls
+ (El, Base_Info);
+ when others =>
+ Error_Kind
+ ("translate_block_configuration_calls(3)",
+ Get_Parent (Block));
+ end case;
+ when others =>
+ Error_Kind
+ ("translate_block_configuration_calls(4)", Block);
+ end case;
end;
when others =>
Error_Kind ("translate_block_configuration_calls(2)", El);
diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb
index ed3699908..e2a81c360 100644
--- a/src/vhdl/translate/trans-chap9.adb
+++ b/src/vhdl/translate/trans-chap9.adb
@@ -634,7 +634,7 @@ package body Trans.Chap9 is
end Translate_Psl_Directive_Statement;
-- Create the instance for block BLOCK.
- -- BLOCK can be either an entity, an architecture or a block statement.
+ -- ORIGIN can be either an entity, an architecture or a block statement.
procedure Translate_Block_Declarations (Block : Iir; Origin : Iir)
is
El : Iir;
@@ -691,23 +691,21 @@ package body Trans.Chap9 is
(Create_Identifier_Without_Prefix (El),
Info.Block_Scope);
end;
- when Iir_Kind_Generate_Statement =>
+ when Iir_Kind_For_Generate_Statement =>
declare
- Scheme : constant Iir := Get_Generation_Scheme (El);
+ Bod : constant Iir := Get_Generate_Statement_Body (El);
+ Param : constant Iir := Get_Parameter_Specification (El);
Info : Block_Info_Acc;
Mark : Id_Mark_Type;
- Iter_Type : Iir;
+ Iter_Type : constant Iir := Get_Type (Param);
It_Info : Ortho_Info_Acc;
begin
Push_Identifier_Prefix (Mark, Get_Identifier (El));
- if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
- Iter_Type := Get_Type (Scheme);
- Chap3.Translate_Object_Subtype (Scheme, True);
- end if;
+ Chap3.Translate_Object_Subtype (Param, True);
- Info := Add_Info (El, Kind_Block);
- Chap1.Start_Block_Decl (El);
+ Info := Add_Info (Bod, Kind_Block);
+ Chap1.Start_Block_Decl (Bod);
Push_Instance_Factory (Info.Block_Scope'Access);
-- Add a parent field in the current instance.
@@ -715,43 +713,68 @@ package body Trans.Chap9 is
(Get_Identifier ("ORIGIN"),
Get_Info (Origin).Block_Decls_Ptr_Type);
+ -- Flag (if block was configured).
+ Info.Block_Configured_Field :=
+ Add_Instance_Factory_Field
+ (Get_Identifier ("CONFIGURED"), Ghdl_Bool_Type);
+
-- Iterator.
- if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
- Info.Block_Configured_Field :=
- Add_Instance_Factory_Field
- (Get_Identifier ("CONFIGURED"), Ghdl_Bool_Type);
- It_Info := Add_Info (Scheme, Kind_Iterator);
- It_Info.Iterator_Var := Create_Var
- (Create_Var_Identifier (Scheme),
- Get_Info (Get_Base_Type (Iter_Type)).Ortho_Type
- (Mode_Value));
- end if;
+ It_Info := Add_Info (Param, Kind_Iterator);
+ It_Info.Iterator_Var := Create_Var
+ (Create_Var_Identifier (Param),
+ Get_Info (Get_Base_Type (Iter_Type)).Ortho_Type
+ (Mode_Value));
- Chap9.Translate_Block_Declarations (El, El);
+ Chap9.Translate_Block_Declarations (Bod, Bod);
Pop_Instance_Factory (Info.Block_Scope'Access);
- if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
- -- Create array type of block_decls_type
- Info.Block_Decls_Array_Type := New_Array_Type
- (Get_Scope_Type (Info.Block_Scope), Ghdl_Index_Type);
- New_Type_Decl (Create_Identifier ("INSTARRTYPE"),
- Info.Block_Decls_Array_Type);
- -- Create access to the array type.
- Info.Block_Decls_Array_Ptr_Type := New_Access_Type
- (Info.Block_Decls_Array_Type);
- New_Type_Decl (Create_Identifier ("INSTARRPTR"),
- Info.Block_Decls_Array_Ptr_Type);
- -- Add a field in parent record
- Info.Block_Parent_Field := Add_Instance_Factory_Field
- (Create_Identifier_Without_Prefix (El),
- Info.Block_Decls_Array_Ptr_Type);
- else
- -- Create an access field in the parent record.
- Info.Block_Parent_Field := Add_Instance_Factory_Field
- (Create_Identifier_Without_Prefix (El),
- Info.Block_Decls_Ptr_Type);
- end if;
+ -- Create array type of block_decls_type
+ Info.Block_Decls_Array_Type := New_Array_Type
+ (Get_Scope_Type (Info.Block_Scope), Ghdl_Index_Type);
+ New_Type_Decl (Create_Identifier ("INSTARRTYPE"),
+ Info.Block_Decls_Array_Type);
+ -- Create access to the array type.
+ Info.Block_Decls_Array_Ptr_Type := New_Access_Type
+ (Info.Block_Decls_Array_Type);
+ New_Type_Decl (Create_Identifier ("INSTARRPTR"),
+ Info.Block_Decls_Array_Ptr_Type);
+
+ -- Add a field in the parent instance (Pop_Instance_Factory
+ -- has already been called). This is a pointer INSTARRPTR
+ -- to an array INSTARRTYPE of instace. The size of each
+ -- element is stored in the RTI.
+ Info.Block_Parent_Field := Add_Instance_Factory_Field
+ (Create_Identifier_Without_Prefix (El),
+ Info.Block_Decls_Array_Ptr_Type);
+
+ Pop_Identifier_Prefix (Mark);
+ end;
+ when Iir_Kind_If_Generate_Statement =>
+ declare
+ Bod : constant Iir := Get_Generate_Statement_Body (El);
+ Info : Block_Info_Acc;
+ Mark : Id_Mark_Type;
+ begin
+ Push_Identifier_Prefix (Mark, Get_Identifier (El));
+
+ Info := Add_Info (Bod, Kind_Block);
+ Chap1.Start_Block_Decl (Bod);
+ Push_Instance_Factory (Info.Block_Scope'Access);
+
+ -- Add a parent field in the current instance.
+ Info.Block_Origin_Field := Add_Instance_Factory_Field
+ (Get_Identifier ("ORIGIN"),
+ Get_Info (Origin).Block_Decls_Ptr_Type);
+
+ Chap9.Translate_Block_Declarations (Bod, Bod);
+
+ Pop_Instance_Factory (Info.Block_Scope'Access);
+
+ -- Create an access field in the parent record.
+ Info.Block_Parent_Field := Add_Instance_Factory_Field
+ (Create_Identifier_Without_Prefix (El),
+ Info.Block_Decls_Ptr_Type);
Pop_Identifier_Prefix (Mark);
end;
@@ -765,7 +788,7 @@ package body Trans.Chap9 is
procedure Translate_Component_Instantiation_Subprogram
(Stmt : Iir; Base : Block_Info_Acc)
is
- procedure Set_Component_Link (Ref_Scope : Var_Scope_Type;
+ procedure Set_Component_Link (Ref_Scope : Var_Scope_Type;
Comp_Field : O_Fnode)
is
begin
@@ -892,9 +915,11 @@ package body Trans.Chap9 is
end if;
Translate_Block_Subprograms (Stmt, Base_Block);
end;
- when Iir_Kind_Generate_Statement =>
+ when Iir_Kind_For_Generate_Statement
+ | Iir_Kind_If_Generate_Statement =>
declare
- Info : constant Block_Info_Acc := Get_Info (Stmt);
+ Bod : constant Iir := Get_Generate_Statement_Body (Stmt);
+ Info : constant Block_Info_Acc := Get_Info (Bod);
Prev_Subprg_Instance : Subprgs.Subprg_Instance_Stack;
begin
Subprgs.Push_Subprg_Instance (Info.Block_Scope'Access,
@@ -904,7 +929,7 @@ package body Trans.Chap9 is
Set_Scope_Via_Field_Ptr (Base_Info.Block_Scope,
Info.Block_Origin_Field,
Info.Block_Scope'Access);
- Translate_Block_Subprograms (Stmt, Stmt);
+ Translate_Block_Subprograms (Bod, Bod);
Clear_Scope (Base_Info.Block_Scope);
Subprgs.Pop_Subprg_Instance
(Wki_Instance, Prev_Subprg_Instance);
@@ -1493,11 +1518,12 @@ package body Trans.Chap9 is
end;
end Translate_Entity_Instantiation;
- procedure Elab_Conditionnal_Generate_Statement
+ procedure Elab_If_Generate_Statement
(Stmt : Iir_Generate_Statement; Parent : Iir; Base_Block : Iir)
is
- Scheme : constant Iir := Get_Generation_Scheme (Stmt);
- Info : constant Block_Info_Acc := Get_Info (Stmt);
+ Condition : constant Iir := Get_Condition (Stmt);
+ Bod : constant Iir := Get_Generate_Statement_Body (Stmt);
+ Info : constant Block_Info_Acc := Get_Info (Bod);
Parent_Info : constant Block_Info_Acc := Get_Info (Parent);
Var : O_Dnode;
Blk : O_If_Block;
@@ -1506,7 +1532,7 @@ package body Trans.Chap9 is
Open_Temp;
Var := Create_Temp (Info.Block_Decls_Ptr_Type);
- Start_If_Stmt (Blk, Chap7.Translate_Expression (Scheme));
+ Start_If_Stmt (Blk, Chap7.Translate_Expression (Condition));
New_Assign_Stmt
(New_Obj (Var),
Gen_Alloc (Alloc_System,
@@ -1536,20 +1562,21 @@ package body Trans.Chap9 is
Get_Instance_Access (Base_Block));
-- Elaborate block
Set_Scope_Via_Param_Ptr (Info.Block_Scope, Var);
- Elab_Block_Declarations (Stmt, Stmt);
+ Elab_Block_Declarations (Bod, Bod);
Clear_Scope (Info.Block_Scope);
Finish_If_Stmt (Blk);
Close_Temp;
- end Elab_Conditionnal_Generate_Statement;
+ end Elab_If_Generate_Statement;
- procedure Elab_Iterative_Generate_Statement
+ procedure Elab_For_Generate_Statement
(Stmt : Iir_Generate_Statement; Parent : Iir; Base_Block : Iir)
is
- Scheme : constant Iir := Get_Generation_Scheme (Stmt);
- Iter_Type : constant Iir := Get_Type (Scheme);
+ Iter : constant Iir := Get_Parameter_Specification (Stmt);
+ Iter_Type : constant Iir := Get_Type (Iter);
Iter_Base_Type : constant Iir := Get_Base_Type (Iter_Type);
Iter_Type_Info : constant Type_Info_Acc := Get_Info (Iter_Base_Type);
- Info : constant Block_Info_Acc := Get_Info (Stmt);
+ Bod : constant Iir := Get_Generate_Statement_Body (Stmt);
+ Info : constant Block_Info_Acc := Get_Info (Bod);
Parent_Info : constant Block_Info_Acc := Get_Info (Parent);
-- Base_Info : constant Block_Info_Acc := Get_Info (Base_Block);
Var_Inst : O_Dnode;
@@ -1644,7 +1671,7 @@ package body Trans.Chap9 is
Finish_If_Stmt (If_Blk);
New_Assign_Stmt
- (Get_Var (Get_Info (Scheme).Iterator_Var),
+ (Get_Var (Get_Info (Iter).Iterator_Var),
New_Dyadic_Op
(ON_Add_Ov,
New_Obj_Value (Val),
@@ -1653,7 +1680,7 @@ package body Trans.Chap9 is
end;
-- Elaboration.
- Elab_Block_Declarations (Stmt, Stmt);
+ Elab_Block_Declarations (Bod, Bod);
-- Clear_Scope (Base_Info.Block_Scope);
Clear_Scope (Info.Block_Scope);
@@ -1661,7 +1688,7 @@ package body Trans.Chap9 is
Inc_Var (Var_I);
Finish_Loop_Stmt (Label);
Close_Temp;
- end Elab_Iterative_Generate_Statement;
+ end Elab_For_Generate_Statement;
type Merge_Signals_Data is record
Sig : Iir;
@@ -1887,7 +1914,7 @@ package body Trans.Chap9 is
Merge_Signals_Rti_Of_Port_Chain (Get_Port_Chain (Header));
end if;
end;
- when Iir_Kind_Generate_Statement =>
+ when Iir_Kind_Generate_Statement_Body =>
null;
when others =>
Error_Kind ("elab_block_declarations", Block);
@@ -1928,21 +1955,20 @@ package body Trans.Chap9 is
Elab_Block_Declarations (Stmt, Base_Block);
Pop_Identifier_Prefix (Mark);
end;
- when Iir_Kind_Generate_Statement =>
+ when Iir_Kind_If_Generate_Statement =>
declare
Mark : Id_Mark_Type;
begin
Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
-
- if Get_Kind (Get_Generation_Scheme (Stmt))
- = Iir_Kind_Iterator_Declaration
- then
- Elab_Iterative_Generate_Statement
- (Stmt, Block, Base_Block);
- else
- Elab_Conditionnal_Generate_Statement
- (Stmt, Block, Base_Block);
- end if;
+ Elab_If_Generate_Statement (Stmt, Block, Base_Block);
+ Pop_Identifier_Prefix (Mark);
+ end;
+ when Iir_Kind_For_Generate_Statement =>
+ declare
+ Mark : Id_Mark_Type;
+ begin
+ Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
+ Elab_For_Generate_Statement (Stmt, Block, Base_Block);
Pop_Identifier_Prefix (Mark);
end;
when others =>
diff --git a/src/vhdl/translate/trans-rtis.adb b/src/vhdl/translate/trans-rtis.adb
index 76db3ccd1..6fd7c25c2 100644
--- a/src/vhdl/translate/trans-rtis.adb
+++ b/src/vhdl/translate/trans-rtis.adb
@@ -725,6 +725,7 @@ package body Trans.Rtis is
return;
end if;
if Cur_Block.Last_Nbr = Rti_Array'Last then
+ -- Append a new block.
declare
N : Rti_Array_List_Acc;
begin
@@ -2164,7 +2165,8 @@ package body Trans.Rtis is
when Iir_Kind_Process_Statement
| Iir_Kind_Sensitized_Process_Statement
| Iir_Kind_Block_Statement
- | Iir_Kind_Generate_Statement =>
+ | Iir_Kind_If_Generate_Statement
+ | Iir_Kind_For_Generate_Statement =>
Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
Generate_Block (Stmt, Parent_Rti);
Pop_Identifier_Prefix (Mark);
@@ -2207,28 +2209,27 @@ package body Trans.Rtis is
Inst : O_Tnode;
begin
-- The type of a generator iterator is elaborated in the parent.
- if Get_Kind (Blk) = Iir_Kind_Generate_Statement then
+ if Get_Kind (Blk) = Iir_Kind_For_Generate_Statement then
declare
- Scheme : constant Iir := Get_Generation_Scheme (Blk);
- Iter_Type : Iir;
- Type_Info : Type_Info_Acc;
+ Param : constant Iir := Get_Parameter_Specification (Blk);
+ Iter_Type : constant Iir := Get_Type (Param);
+ Type_Info : constant Type_Info_Acc := Get_Info (Iter_Type);
Mark : Id_Mark_Type;
- Tmp : O_Dnode;
+ Iter_Rti : O_Dnode;
begin
- if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
- Iter_Type := Get_Type (Scheme);
- Type_Info := Get_Info (Iter_Type);
- if Type_Info.Type_Rti = O_Dnode_Null then
- Push_Identifier_Prefix (Mark, "ITERATOR");
- Tmp := Generate_Type_Definition (Iter_Type);
- Add_Rti_Node (Tmp);
- Pop_Identifier_Prefix (Mark);
- end if;
+ if Type_Info.Type_Rti = O_Dnode_Null then
+ Push_Identifier_Prefix (Mark, "ITERATOR");
+ Iter_Rti := Generate_Type_Definition (Iter_Type);
+ -- The RTIs for the parent are being defined, so append to the
+ -- parent.
+ Add_Rti_Node (Iter_Rti);
+ Pop_Identifier_Prefix (Mark);
end if;
end;
end if;
if Get_Kind (Get_Parent (Blk)) = Iir_Kind_Design_Unit then
+ -- Also include filename for units.
Rti_Type := Ghdl_Rtin_Block_File;
else
Rti_Type := Ghdl_Rtin_Block;
@@ -2295,26 +2296,37 @@ package body Trans.Rtis is
(Get_Concurrent_Statement_Chain (Blk), Rti);
Field_Off := Get_Scope_Offset (Info.Block_Scope, Ghdl_Ptr_Type);
Inst := Get_Scope_Type (Info.Block_Scope);
- when Iir_Kind_Generate_Statement =>
+ when Iir_Kind_If_Generate_Statement =>
+ Kind := Ghdl_Rtik_If_Generate;
declare
- Scheme : constant Iir := Get_Generation_Scheme (Blk);
- Scheme_Rti : O_Dnode := O_Dnode_Null;
+ Bod : constant Iir := Get_Generate_Statement_Body (Blk);
+ Bod_Info : constant Block_Info_Acc := Get_Info (Bod);
begin
- if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
- Generate_Object (Scheme, Scheme_Rti);
- Add_Rti_Node (Scheme_Rti);
- Kind := Ghdl_Rtik_For_Generate;
- else
- Kind := Ghdl_Rtik_If_Generate;
- end if;
+ Generate_Declaration_Chain (Get_Declaration_Chain (Bod));
+ Generate_Concurrent_Statement_Chain
+ (Get_Concurrent_Statement_Chain (Bod), Rti);
+ Field_Off := New_Offsetof
+ (Get_Scope_Type (Get_Info (Get_Parent (Blk)).Block_Scope),
+ Bod_Info.Block_Parent_Field, Ghdl_Ptr_Type);
+ end;
+ when Iir_Kind_For_Generate_Statement =>
+ Kind := Ghdl_Rtik_For_Generate;
+ declare
+ Bod : constant Iir := Get_Generate_Statement_Body (Blk);
+ Bod_Info : constant Block_Info_Acc := Get_Info (Bod);
+ Param : constant Iir := Get_Parameter_Specification (Blk);
+ Param_Rti : O_Dnode := O_Dnode_Null;
+ begin
+ Generate_Object (Param, Param_Rti);
+ Add_Rti_Node (Param_Rti);
+ Generate_Declaration_Chain (Get_Declaration_Chain (Bod));
+ Generate_Concurrent_Statement_Chain
+ (Get_Concurrent_Statement_Chain (Bod), Rti);
+ Inst := Get_Scope_Type (Bod_Info.Block_Scope);
+ Field_Off := New_Offsetof
+ (Get_Scope_Type (Get_Info (Get_Parent (Blk)).Block_Scope),
+ Bod_Info.Block_Parent_Field, Ghdl_Ptr_Type);
end;
- Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
- Generate_Concurrent_Statement_Chain
- (Get_Concurrent_Statement_Chain (Blk), Rti);
- Inst := Get_Scope_Type (Info.Block_Scope);
- Field_Off := New_Offsetof
- (Get_Scope_Type (Get_Info (Get_Parent (Blk)).Block_Scope),
- Info.Block_Parent_Field, Ghdl_Ptr_Type);
when others =>
Error_Kind ("rti.generate_block", Blk);
end case;
@@ -2346,6 +2358,8 @@ package body Trans.Rtis is
if Inst = O_Tnode_Null then
Res := Ghdl_Index_0;
else
+ -- For for-generate: size of instance, which gives the stride in the
+ -- sub-blocks array.
Res := New_Sizeof (Inst, Ghdl_Index_Type);
end if;
New_Record_Aggr_El (List, Res);
@@ -2370,7 +2384,8 @@ package body Trans.Rtis is
-- Put children in the parent list.
case Get_Kind (Blk) is
when Iir_Kind_Block_Statement
- | Iir_Kind_Generate_Statement
+ | Iir_Kind_For_Generate_Statement
+ | Iir_Kind_If_Generate_Statement
| Iir_Kind_Process_Statement
| Iir_Kind_Sensitized_Process_Statement =>
Add_Rti_Node (Rti);
@@ -2382,9 +2397,16 @@ package body Trans.Rtis is
case Get_Kind (Blk) is
when Iir_Kind_Entity_Declaration
| Iir_Kind_Architecture_Body
- | Iir_Kind_Block_Statement
- | Iir_Kind_Generate_Statement =>
+ | Iir_Kind_Block_Statement =>
Info.Block_Rti_Const := Rti;
+ when Iir_Kind_If_Generate_Statement
+ | Iir_Kind_For_Generate_Statement =>
+ declare
+ Bod : constant Iir := Get_Generate_Statement_Body (Blk);
+ Bod_Info : constant Block_Info_Acc := Get_Info (Bod);
+ begin
+ Bod_Info.Block_Rti_Const := Rti;
+ end;
when Iir_Kind_Process_Statement
| Iir_Kind_Sensitized_Process_Statement =>
Info.Process_Rti_Const := Rti;
@@ -2571,8 +2593,16 @@ package body Trans.Rtis is
when Iir_Kind_Entity_Declaration
| Iir_Kind_Architecture_Body
| Iir_Kind_Block_Statement
- | Iir_Kind_Generate_Statement =>
+ | Iir_Kind_Generate_Statement_Body =>
Rti_Const := Node_Info.Block_Rti_Const;
+ when Iir_Kind_If_Generate_Statement
+ | Iir_Kind_For_Generate_Statement =>
+ declare
+ Bod : constant Iir := Get_Generate_Statement_Body (Node);
+ Bod_Info : constant Block_Info_Acc := Get_Info (Bod);
+ begin
+ Rti_Const := Bod_Info.Block_Rti_Const;
+ end;
when Iir_Kind_Package_Declaration
| Iir_Kind_Package_Body =>
Rti_Const := Node_Info.Package_Rti_Const;
@@ -2599,8 +2629,16 @@ package body Trans.Rtis is
when Iir_Kind_Entity_Declaration
| Iir_Kind_Architecture_Body
| Iir_Kind_Block_Statement
- | Iir_Kind_Generate_Statement =>
+ | Iir_Kind_Generate_Statement_Body =>
Ref := Get_Instance_Ref (Node_Info.Block_Scope);
+ when Iir_Kind_If_Generate_Statement
+ | Iir_Kind_For_Generate_Statement =>
+ declare
+ Bod : constant Iir := Get_Generate_Statement_Body (Node);
+ Bod_Info : constant Block_Info_Acc := Get_Info (Bod);
+ begin
+ Ref := Get_Instance_Ref (Bod_Info.Block_Scope);
+ end;
when Iir_Kind_Package_Declaration
| Iir_Kind_Package_Body =>
return New_Lit (New_Null_Access (Ghdl_Ptr_Type));