aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2015-01-04 05:36:03 +0100
committerTristan Gingold <tgingold@free.fr>2015-01-04 05:36:03 +0100
commit3aaf2679a61b4d8bd61c7cccd5ca0ec1f1606de5 (patch)
tree08236cb25552ca9d06d236beef528a9380a4e914 /src
parent3fea917ef9a145d448ab2dd5d83d7ac7de280602 (diff)
downloadghdl-3aaf2679a61b4d8bd61c7cccd5ca0ec1f1606de5.tar.gz
ghdl-3aaf2679a61b4d8bd61c7cccd5ca0ec1f1606de5.tar.bz2
ghdl-3aaf2679a61b4d8bd61c7cccd5ca0ec1f1606de5.zip
Rework for vhdl08 generate: change rtis.
Diffstat (limited to 'src')
-rw-r--r--src/grt/grt-avhpi.adb57
-rw-r--r--src/grt/grt-disp_rti.adb56
-rw-r--r--src/grt/grt-disp_tree.adb38
-rw-r--r--src/grt/grt-rtis.ads36
-rw-r--r--src/grt/grt-rtis_addr.adb45
-rw-r--r--src/grt/grt-rtis_addr.ads4
-rw-r--r--src/grt/grt-rtis_utils.adb22
-rw-r--r--src/vhdl/translate/trans-chap9.adb3
-rw-r--r--src/vhdl/translate/trans-rtis.adb275
-rw-r--r--src/vhdl/translate/trans-rtis.ads1
10 files changed, 366 insertions, 171 deletions
diff --git a/src/grt/grt-avhpi.adb b/src/grt/grt-avhpi.adb
index 16bbad61b..f6c5c4138 100644
--- a/src/grt/grt-avhpi.adb
+++ b/src/grt/grt-avhpi.adb
@@ -264,10 +264,12 @@ package body Grt.Avhpi is
goto Again;
else
declare
+ Gen : constant Ghdl_Rtin_Generate_Acc :=
+ To_Ghdl_Rtin_Generate_Acc (Nblk.Parent);
Base : Address;
begin
Base := To_Addr_Acc (Iterator.Ctxt.Base + Nblk.Loc).all;
- Base := Base + Iterator.It2 * Nblk.Size;
+ Base := Base + Iterator.It2 * Gen.Size;
Res := (Kind => VhpiForGenerateK,
Ctxt => (Base => Base,
Block => Ch));
@@ -295,28 +297,39 @@ package body Grt.Avhpi is
Error := AvhpiErrorOk;
return;
when Ghdl_Rtik_If_Generate =>
- Res := (Kind => VhpiIfGenerateK,
- Ctxt => (Base => To_Addr_Acc (Iterator.Ctxt.Base
- + Nblk.Loc).all,
- Block => Ch));
- -- Return only if the condition is true.
- if Res.Ctxt.Base /= Null_Address then
- Error := AvhpiErrorOk;
- return;
- end if;
+ declare
+ Gen : constant Ghdl_Rtin_Generate_Acc :=
+ To_Ghdl_Rtin_Generate_Acc (Ch);
+ begin
+ Res := (Kind => VhpiIfGenerateK,
+ Ctxt => (Base => To_Addr_Acc (Iterator.Ctxt.Base
+ + Gen.Loc).all,
+ Block => Gen.Child));
+ -- Return only if the condition is true.
+ if Res.Ctxt.Base /= Null_Address then
+ Error := AvhpiErrorOk;
+ return;
+ end if;
+ end;
when Ghdl_Rtik_For_Generate =>
- Res := (Kind => VhpiForGenerateK,
- Ctxt => (Base => To_Addr_Acc (Iterator.Ctxt.Base
- + Nblk.Loc).all,
- Block => Ch));
- Iterator.Max2 := Get_For_Generate_Length (Nblk, Iterator.Ctxt);
- Iterator.It2 := 0;
- if Iterator.Max2 > 0 then
- Iterator.It_Cur := Iterator.It_Cur - 1;
- Error := AvhpiErrorOk;
- return;
- end if;
- -- If the iterator range is nul, then continue to scan.
+ declare
+ Gen : constant Ghdl_Rtin_Generate_Acc :=
+ To_Ghdl_Rtin_Generate_Acc (Ch);
+ begin
+ Res := (Kind => VhpiForGenerateK,
+ Ctxt => (Base => To_Addr_Acc (Iterator.Ctxt.Base
+ + Gen.Loc).all,
+ Block => Gen.Child));
+ Iterator.Max2 :=
+ Get_For_Generate_Length (Gen, Iterator.Ctxt);
+ Iterator.It2 := 0;
+ if Iterator.Max2 > 0 then
+ Iterator.It_Cur := Iterator.It_Cur - 1;
+ Error := AvhpiErrorOk;
+ return;
+ end if;
+ -- If the iterator range is nul, then continue to scan.
+ end;
when Ghdl_Rtik_Instance =>
Res := (Kind => VhpiCompInstStmtK,
Ctxt => Iterator.Ctxt,
diff --git a/src/grt/grt-disp_rti.adb b/src/grt/grt-disp_rti.adb
index bb6f75ffb..1e029d151 100644
--- a/src/grt/grt-disp_rti.adb
+++ b/src/grt/grt-disp_rti.adb
@@ -379,6 +379,8 @@ package body Grt.Disp_Rti is
Put ("ghdl_rtik_if_generate");
when Ghdl_Rtik_For_Generate =>
Put ("ghdl_rtik_for_generate");
+ when Ghdl_Rtik_Generate_Body =>
+ Put ("ghdl_rtik_generate_body");
when Ghdl_Rtik_Type_B1 =>
Put ("ghdl_rtik_type_b1");
@@ -697,30 +699,53 @@ package body Grt.Disp_Rti is
Block => To_Ghdl_Rti_Access (Blk));
Disp_Rti_Arr (Blk.Nbr_Child, Blk.Children,
Nctxt, Indent + 1);
+ when Ghdl_Rtik_Generate_Body =>
+ Disp_Rti_Arr (Blk.Nbr_Child, Blk.Children,
+ Ctxt, Indent + 1);
+ when others =>
+ Internal_Error ("disp_block");
+ end case;
+ end Disp_Block;
+
+ procedure Disp_Generate (Gen : Ghdl_Rtin_Generate_Acc;
+ Ctxt : Rti_Context;
+ Indent : Natural)
+ is
+ Nctxt : Rti_Context;
+ begin
+ Disp_Indent (Indent);
+ Disp_Kind (Gen.Common.Kind);
+ Disp_Depth (Gen.Common.Depth);
+ Put (", ");
+ Disp_Linecol (Gen.Linecol);
+ Put (": ");
+ Disp_Name (Gen.Name);
+ New_Line;
+ case Gen.Common.Kind is
when Ghdl_Rtik_For_Generate =>
declare
Length : Ghdl_Index_Type;
begin
- Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Blk.Loc).all,
- Block => To_Ghdl_Rti_Access (Blk));
- Length := Get_For_Generate_Length (Blk, Ctxt);
+ Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Gen.Loc).all,
+ Block => Gen.Child);
+ Length := Get_For_Generate_Length (Gen, Ctxt);
for I in 1 .. Length loop
- Disp_Rti_Arr (Blk.Nbr_Child, Blk.Children,
- Nctxt, Indent + 1);
- Nctxt.Base := Nctxt.Base + Blk.Size;
+ Disp_Block (To_Ghdl_Rtin_Block_Acc (Gen.Child),
+ Nctxt, Indent + 1);
+ Nctxt.Base := Nctxt.Base + Gen.Size;
end loop;
end;
when Ghdl_Rtik_If_Generate =>
- Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Blk.Loc).all,
- Block => To_Ghdl_Rti_Access (Blk));
+ Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Gen.Loc).all,
+ Block => Gen.Child);
if Nctxt.Base /= Null_Address then
- Disp_Rti_Arr (Blk.Nbr_Child, Blk.Children,
- Nctxt, Indent + 1);
+ Disp_Block (To_Ghdl_Rtin_Block_Acc (Gen.Child),
+ Nctxt, Indent + 1);
end if;
when others =>
- Internal_Error ("disp_block");
+ Internal_Error ("disp_generate");
end case;
- end Disp_Block;
+ end Disp_Generate;
procedure Disp_Object (Obj : Ghdl_Rtin_Object_Acc;
Is_Sig : Boolean;
@@ -1056,10 +1081,11 @@ package body Grt.Disp_Rti is
| Ghdl_Rtik_Architecture
| Ghdl_Rtik_Package
| Ghdl_Rtik_Process
- | Ghdl_Rtik_Block
- | Ghdl_Rtik_If_Generate
- | Ghdl_Rtik_For_Generate =>
+ | Ghdl_Rtik_Block =>
Disp_Block (To_Ghdl_Rtin_Block_Acc (Rti), Ctxt, Indent);
+ when Ghdl_Rtik_If_Generate
+ | Ghdl_Rtik_For_Generate =>
+ Disp_Generate (To_Ghdl_Rtin_Generate_Acc (Rti), Ctxt, Indent);
when Ghdl_Rtik_Package_Body =>
Disp_Rti (To_Ghdl_Rtin_Block_Acc (Rti).Parent, Ctxt, Indent);
Disp_Block (To_Ghdl_Rtin_Block_Acc (Rti), Ctxt, Indent);
diff --git a/src/grt/grt-disp_tree.adb b/src/grt/grt-disp_tree.adb
index 7d5811960..4afb64191 100644
--- a/src/grt/grt-disp_tree.adb
+++ b/src/grt/grt-disp_tree.adb
@@ -112,13 +112,15 @@ package body Grt.Disp_Tree is
end;
when Ghdl_Rtik_For_Generate =>
declare
- Blk : constant Ghdl_Rtin_Block_Acc :=
- To_Ghdl_Rtin_Block_Acc (Rti);
- Iter : Ghdl_Rtin_Object_Acc;
+ Gen : constant Ghdl_Rtin_Generate_Acc :=
+ To_Ghdl_Rtin_Generate_Acc (Rti);
+ Bod : constant Ghdl_Rtin_Block_Acc :=
+ To_Ghdl_Rtin_Block_Acc (Gen.Child);
+ Iter : constant Ghdl_Rtin_Object_Acc :=
+ To_Ghdl_Rtin_Object_Acc (Bod.Children (0));
Addr : Address;
begin
- Disp_Name (Blk.Name);
- Iter := To_Ghdl_Rtin_Object_Acc (Blk.Children (0));
+ Disp_Name (Gen.Name);
Addr := Loc_To_Addr (Iter.Common.Depth, Iter.Loc, Ctxt);
Put ('(');
Disp_Value (stdout, Iter.Obj_Type, Ctxt, Addr, False);
@@ -251,24 +253,25 @@ package body Grt.Disp_Tree is
end;
when Ghdl_Rtik_For_Generate =>
declare
- Nblk : constant Ghdl_Rtin_Block_Acc :=
- To_Ghdl_Rtin_Block_Acc (Child);
+ Gen : constant Ghdl_Rtin_Generate_Acc :=
+ To_Ghdl_Rtin_Generate_Acc (Child);
Nctxt : Rti_Context;
Length : Ghdl_Index_Type;
Old_Child2 : Ghdl_Rti_Access;
begin
- Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc).all,
- Block => Child);
- Length := Get_For_Generate_Length (Nblk, Ctxt);
+ Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Gen.Loc).all,
+ Block => Gen.Child);
+ Length := Get_For_Generate_Length (Gen, Ctxt);
Disp_Header (Nctxt, Length > 1);
Old_Child2 := Child2;
if Length > 1 then
Child2 := Child;
end if;
for I in 1 .. Length loop
- Disp_Sub_Block (Nblk, Nctxt);
+ Disp_Sub_Block
+ (To_Ghdl_Rtin_Block_Acc (Gen.Child), Nctxt);
if I /= Length then
- Nctxt.Base := Nctxt.Base + Nblk.Size;
+ Nctxt.Base := Nctxt.Base + Gen.Size;
if I = Length - 1 then
Child2 := Old_Child2;
end if;
@@ -279,15 +282,16 @@ package body Grt.Disp_Tree is
end;
when Ghdl_Rtik_If_Generate =>
declare
- Nblk : constant Ghdl_Rtin_Block_Acc :=
- To_Ghdl_Rtin_Block_Acc (Child);
+ Gen : constant Ghdl_Rtin_Generate_Acc :=
+ To_Ghdl_Rtin_Generate_Acc (Child);
Nctxt : Rti_Context;
begin
- Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc).all,
- Block => Child);
+ Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Gen.Loc).all,
+ Block => Gen.Child);
Disp_Header (Nctxt);
if Nctxt.Base /= Null_Address then
- Disp_Sub_Block (Nblk, Nctxt);
+ Disp_Sub_Block
+ (To_Ghdl_Rtin_Block_Acc (Gen.Child), Nctxt);
end if;
end;
when Ghdl_Rtik_Instance =>
diff --git a/src/grt/grt-rtis.ads b/src/grt/grt-rtis.ads
index b5d307b25..e71174076 100644
--- a/src/grt/grt-rtis.ads
+++ b/src/grt/grt-rtis.ads
@@ -35,45 +35,55 @@ package Grt.Rtis is
Ghdl_Rtik_Package,
Ghdl_Rtik_Package_Body,
Ghdl_Rtik_Entity,
+
Ghdl_Rtik_Architecture,
Ghdl_Rtik_Process,
Ghdl_Rtik_Block,
Ghdl_Rtik_If_Generate,
Ghdl_Rtik_For_Generate,
- Ghdl_Rtik_Instance, --10
+
+ Ghdl_Rtik_Generate_Body, -- 10
+ Ghdl_Rtik_Instance,
Ghdl_Rtik_Constant,
Ghdl_Rtik_Iterator,
Ghdl_Rtik_Variable,
+
Ghdl_Rtik_Signal,
- Ghdl_Rtik_File, -- 15
+ Ghdl_Rtik_File,
Ghdl_Rtik_Port,
Ghdl_Rtik_Generic,
Ghdl_Rtik_Alias,
+
Ghdl_Rtik_Guard,
- Ghdl_Rtik_Component, -- 20
+ Ghdl_Rtik_Component,
Ghdl_Rtik_Attribute,
Ghdl_Rtik_Type_B1, -- Enum
Ghdl_Rtik_Type_E8,
+
Ghdl_Rtik_Type_E32,
- Ghdl_Rtik_Type_I32, -- 25 Scalar
+ Ghdl_Rtik_Type_I32, -- Scalar
Ghdl_Rtik_Type_I64,
Ghdl_Rtik_Type_F64,
Ghdl_Rtik_Type_P32,
+
Ghdl_Rtik_Type_P64,
Ghdl_Rtik_Type_Access,
Ghdl_Rtik_Type_Array,
Ghdl_Rtik_Type_Record,
Ghdl_Rtik_Type_File,
+
Ghdl_Rtik_Subtype_Scalar,
Ghdl_Rtik_Subtype_Array,
Ghdl_Rtik_Subtype_Unconstrained_Array,
Ghdl_Rtik_Subtype_Record,
Ghdl_Rtik_Subtype_Access,
+
Ghdl_Rtik_Type_Protected,
Ghdl_Rtik_Element,
Ghdl_Rtik_Unit64,
Ghdl_Rtik_Unitptr,
Ghdl_Rtik_Attribute_Transaction,
+
Ghdl_Rtik_Attribute_Quiet,
Ghdl_Rtik_Attribute_Stable,
Ghdl_Rtik_Error);
@@ -127,7 +137,6 @@ package Grt.Rtis is
Loc : Ghdl_Rti_Loc;
Linecol : Ghdl_Index_Type;
Parent : Ghdl_Rti_Access;
- Size : Ghdl_Index_Type;
Nbr_Child : Ghdl_Index_Type;
Children : Ghdl_Rti_Arr_Acc;
end record;
@@ -137,6 +146,22 @@ package Grt.Rtis is
function To_Ghdl_Rti_Access is new Ada.Unchecked_Conversion
(Source => Ghdl_Rtin_Block_Acc, Target => Ghdl_Rti_Access);
+ type Ghdl_Rtin_Generate is record
+ Common : Ghdl_Rti_Common;
+ Name : Ghdl_C_String;
+ Loc : Ghdl_Rti_Loc;
+ Linecol : Ghdl_Index_Type;
+ Parent : Ghdl_Rti_Access;
+ -- Only for for_generate_statement.
+ Size : Ghdl_Index_Type;
+ Child : Ghdl_Rti_Access;
+ end record;
+ type Ghdl_Rtin_Generate_Acc is access Ghdl_Rtin_Generate;
+ function To_Ghdl_Rtin_Generate_Acc is new Ada.Unchecked_Conversion
+ (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Generate_Acc);
+ function To_Ghdl_Rti_Access is new Ada.Unchecked_Conversion
+ (Source => Ghdl_Rtin_Generate_Acc, Target => Ghdl_Rti_Access);
+
type Ghdl_Rtin_Block_Filename is record
Block : Ghdl_Rtin_Block;
Filename : Ghdl_C_String;
@@ -361,7 +386,6 @@ package Grt.Rtis is
Loc => Null_Rti_Loc,
Linecol => 0,
Parent => null,
- Size => 0,
Nbr_Child => 0,
Children => null);
diff --git a/src/grt/grt-rtis_addr.adb b/src/grt/grt-rtis_addr.adb
index d9f746e5b..199c449eb 100644
--- a/src/grt/grt-rtis_addr.adb
+++ b/src/grt/grt-rtis_addr.adb
@@ -53,9 +53,9 @@ package body Grt.Rtis_Addr is
function Get_Parent_Context (Ctxt : Rti_Context) return Rti_Context
is
- Blk : Ghdl_Rtin_Block_Acc;
+ Blk : constant Ghdl_Rtin_Block_Acc :=
+ To_Ghdl_Rtin_Block_Acc (Ctxt.Block);
begin
- Blk := To_Ghdl_Rtin_Block_Acc (Ctxt.Block);
case Ctxt.Block.Kind is
when Ghdl_Rtik_Process
| Ghdl_Rtik_Block =>
@@ -67,35 +67,50 @@ package body Grt.Rtis_Addr is
end if;
return (Base => Ctxt.Base + Blk.Loc,
Block => Blk.Parent);
- when Ghdl_Rtik_For_Generate
- | Ghdl_Rtik_If_Generate =>
+ when Ghdl_Rtik_Generate_Body =>
declare
Nbase : Address;
+ Nblk : Ghdl_Rti_Access;
Parent : Ghdl_Rti_Access;
- Blk1 : Ghdl_Rtin_Block_Acc;
begin
-- Read the pointer to the parent.
-- This is the first field.
Nbase := To_Addr_Acc (Ctxt.Base).all;
+ -- Parent (by default).
+ Nblk := Blk.Parent;
-- Since the parent may be a grant-parent, adjust
- -- the base.
+ -- the base (so that the substraction above will work).
Parent := Blk.Parent;
loop
case Parent.Kind is
when Ghdl_Rtik_Architecture
- | Ghdl_Rtik_For_Generate
- | Ghdl_Rtik_If_Generate =>
+ | Ghdl_Rtik_Generate_Body =>
exit;
when Ghdl_Rtik_Block =>
- Blk1 := To_Ghdl_Rtin_Block_Acc (Parent);
- Nbase := Nbase + Blk1.Loc;
- Parent := Blk1.Parent;
+ declare
+ Blk1 : constant Ghdl_Rtin_Block_Acc :=
+ To_Ghdl_Rtin_Block_Acc (Parent);
+ begin
+ Nbase := Nbase + Blk1.Loc;
+ Parent := Blk1.Parent;
+ end;
+ when Ghdl_Rtik_For_Generate
+ | Ghdl_Rtik_If_Generate =>
+ declare
+ Gen : constant Ghdl_Rtin_Generate_Acc :=
+ To_Ghdl_Rtin_Generate_Acc (Parent);
+ begin
+ Parent := Gen.Parent;
+ -- For/If generate statement are not blocks. Skip
+ -- them.
+ Nblk := Gen.Parent;
+ end;
when others =>
Internal_Error ("get_parent_context(2)");
end case;
end loop;
return (Base => Nbase,
- Block => Blk.Parent);
+ Block => Nblk);
end;
when others =>
Internal_Error ("get_parent_context(1)");
@@ -166,15 +181,17 @@ package body Grt.Rtis_Addr is
end case;
end Range_To_Length;
- function Get_For_Generate_Length (Blk : Ghdl_Rtin_Block_Acc;
+ function Get_For_Generate_Length (Gen : Ghdl_Rtin_Generate_Acc;
Ctxt : Rti_Context)
return Ghdl_Index_Type
is
+ Bod : constant Ghdl_Rtin_Block_Acc :=
+ To_Ghdl_Rtin_Block_Acc (Gen.Child);
Iter_Type : Ghdl_Rtin_Subtype_Scalar_Acc;
Rng : Ghdl_Range_Ptr;
begin
Iter_Type := To_Ghdl_Rtin_Subtype_Scalar_Acc
- (To_Ghdl_Rtin_Object_Acc (Blk.Children (0)).Obj_Type);
+ (To_Ghdl_Rtin_Object_Acc (Bod.Children (0)).Obj_Type);
if Iter_Type.Common.Kind /= Ghdl_Rtik_Subtype_Scalar then
Internal_Error ("get_for_generate_length(1)");
end if;
diff --git a/src/grt/grt-rtis_addr.ads b/src/grt/grt-rtis_addr.ads
index 3fa2792af..5dd070334 100644
--- a/src/grt/grt-rtis_addr.ads
+++ b/src/grt/grt-rtis_addr.ads
@@ -70,8 +70,8 @@ package Grt.Rtis_Addr is
Ctxt : Rti_Context)
return Address;
- -- Get the length of for_generate BLK.
- function Get_For_Generate_Length (Blk : Ghdl_Rtin_Block_Acc;
+ -- Get the length of for_generate GEN.
+ function Get_For_Generate_Length (Gen : Ghdl_Rtin_Generate_Acc;
Ctxt : Rti_Context)
return Ghdl_Index_Type;
diff --git a/src/grt/grt-rtis_utils.adb b/src/grt/grt-rtis_utils.adb
index 0d4328e7e..1994e90cb 100644
--- a/src/grt/grt-rtis_utils.adb
+++ b/src/grt/grt-rtis_utils.adb
@@ -63,28 +63,26 @@ package body Grt.Rtis_Utils is
end;
when Ghdl_Rtik_For_Generate =>
declare
- Nblk : Ghdl_Rtin_Block_Acc;
+ Gen : constant Ghdl_Rtin_Generate_Acc :=
+ To_Ghdl_Rtin_Generate_Acc (Child);
Length : Ghdl_Index_Type;
begin
- Nblk := To_Ghdl_Rtin_Block_Acc (Child);
- Nctxt :=
- (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc).all,
- Block => Child);
- Length := Get_For_Generate_Length (Nblk, Ctxt);
+ Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Gen.Loc).all,
+ Block => Gen.Child);
+ Length := Get_For_Generate_Length (Gen, Ctxt);
for I in 1 .. Length loop
Res := Traverse_Blocks_1 (Nctxt);
exit when Res = Traverse_Stop;
- Nctxt.Base := Nctxt.Base + Nblk.Size;
+ Nctxt.Base := Nctxt.Base + Gen.Size;
end loop;
end;
when Ghdl_Rtik_If_Generate =>
declare
- Nblk : Ghdl_Rtin_Block_Acc;
+ Gen : constant Ghdl_Rtin_Generate_Acc :=
+ To_Ghdl_Rtin_Generate_Acc (Child);
begin
- Nblk := To_Ghdl_Rtin_Block_Acc (Child);
- Nctxt :=
- (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc).all,
- Block => Child);
+ Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Gen.Loc).all,
+ Block => Gen.Child);
if Nctxt.Base /= Null_Address then
Res := Traverse_Blocks_1 (Nctxt);
end if;
diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb
index e2a81c360..192c8ee0c 100644
--- a/src/vhdl/translate/trans-chap9.adb
+++ b/src/vhdl/translate/trans-chap9.adb
@@ -708,7 +708,8 @@ package body Trans.Chap9 is
Chap1.Start_Block_Decl (Bod);
Push_Instance_Factory (Info.Block_Scope'Access);
- -- Add a parent field in the current instance.
+ -- Add a parent field in the current instance. This is
+ -- the first field (known by GRT).
Info.Block_Origin_Field := Add_Instance_Factory_Field
(Get_Identifier ("ORIGIN"),
Get_Info (Origin).Block_Decls_Ptr_Type);
diff --git a/src/vhdl/translate/trans-rtis.adb b/src/vhdl/translate/trans-rtis.adb
index 6fd7c25c2..ed483fe17 100644
--- a/src/vhdl/translate/trans-rtis.adb
+++ b/src/vhdl/translate/trans-rtis.adb
@@ -34,7 +34,6 @@ package body Trans.Rtis is
Ghdl_Rtin_Block_Loc : O_Fnode;
Ghdl_Rtin_Block_Linecol : O_Fnode;
Ghdl_Rtin_Block_Parent : O_Fnode;
- Ghdl_Rtin_Block_Size : O_Fnode;
Ghdl_Rtin_Block_Nbr_Child : O_Fnode;
Ghdl_Rtin_Block_Children : O_Fnode;
@@ -43,6 +42,16 @@ package body Trans.Rtis is
Ghdl_Rtin_Block_File_Block : O_Fnode;
Ghdl_Rtin_Block_File_Filename : O_Fnode;
+ -- For generate statement.
+ Ghdl_Rtin_Generate : O_Tnode;
+ Ghdl_Rtin_Generate_Common : O_Fnode;
+ Ghdl_Rtin_Generate_Name : O_Fnode;
+ Ghdl_Rtin_Generate_Loc : O_Fnode;
+ Ghdl_Rtin_Generate_Linecol : O_Fnode;
+ Ghdl_Rtin_Generate_Parent : O_Fnode;
+ Ghdl_Rtin_Generate_Size : O_Fnode;
+ Ghdl_Rtin_Generate_Child : O_Fnode;
+
-- Node for scalar type decls.
Ghdl_Rtin_Type_Scalar : O_Tnode;
Ghdl_Rtin_Type_Scalar_Common : O_Fnode;
@@ -184,6 +193,9 @@ package body Trans.Rtis is
(Constr, Get_Identifier ("__ghdl_rtik_for_generate"),
Ghdl_Rtik_For_Generate);
New_Enum_Literal
+ (Constr, Get_Identifier ("__ghdl_rtik_generate_body"),
+ Ghdl_Rtik_Generate_Body);
+ New_Enum_Literal
(Constr, Get_Identifier ("__ghdl_rtik_instance"),
Ghdl_Rtik_Instance);
@@ -390,8 +402,6 @@ package body Trans.Rtis is
Get_Identifier ("linecol"), Ghdl_Index_Type);
New_Record_Field (Constr, Ghdl_Rtin_Block_Parent,
Wki_Parent, Ghdl_Rti_Access);
- New_Record_Field (Constr, Ghdl_Rtin_Block_Size,
- Get_Identifier ("size"), Ghdl_Index_Type);
New_Record_Field (Constr, Ghdl_Rtin_Block_Nbr_Child,
Get_Identifier ("nbr_child"), Ghdl_Index_Type);
New_Record_Field (Constr, Ghdl_Rtin_Block_Children,
@@ -401,6 +411,30 @@ package body Trans.Rtis is
Ghdl_Rtin_Block);
end;
+ -- Create type ghdl_rtin_generate
+ declare
+ Constr : O_Element_List;
+ begin
+ Start_Record_Type (Constr);
+ New_Record_Field (Constr, Ghdl_Rtin_Generate_Common,
+ Get_Identifier ("common"), Ghdl_Rti_Common);
+ New_Record_Field (Constr, Ghdl_Rtin_Generate_Name,
+ Get_Identifier ("name"), Char_Ptr_Type);
+ New_Record_Field (Constr, Ghdl_Rtin_Generate_Loc,
+ Get_Identifier ("loc"), Ghdl_Ptr_Type);
+ New_Record_Field (Constr, Ghdl_Rtin_Generate_Linecol,
+ Get_Identifier ("linecol"), Ghdl_Index_Type);
+ New_Record_Field (Constr, Ghdl_Rtin_Generate_Parent,
+ Wki_Parent, Ghdl_Rti_Access);
+ New_Record_Field (Constr, Ghdl_Rtin_Generate_Size,
+ Get_Identifier ("size"), Ghdl_Index_Type);
+ New_Record_Field (Constr, Ghdl_Rtin_Generate_Child,
+ Get_Identifier ("child"), Ghdl_Rti_Access);
+ Finish_Record_Type (Constr, Ghdl_Rtin_Generate);
+ New_Type_Decl (Get_Identifier ("__ghdl_rtin_generate"),
+ Ghdl_Rtin_Generate);
+ end;
+
-- Create type ghdl_rtin_block_file
declare
Constr : O_Element_List;
@@ -1876,6 +1910,7 @@ package body Trans.Rtis is
end Generate_Object;
procedure Generate_Block (Blk : Iir; Parent_Rti : O_Dnode);
+ procedure Generate_Generate_Statement (Blk : Iir; Parent_Rti : O_Dnode);
procedure Generate_Declaration_Chain (Chain : Iir);
procedure Generate_Component_Declaration (Comp : Iir)
@@ -2164,12 +2199,36 @@ package body Trans.Rtis is
case Get_Kind (Stmt) is
when Iir_Kind_Process_Statement
| Iir_Kind_Sensitized_Process_Statement
- | Iir_Kind_Block_Statement
- | Iir_Kind_If_Generate_Statement
- | Iir_Kind_For_Generate_Statement =>
+ | Iir_Kind_Block_Statement =>
Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
Generate_Block (Stmt, Parent_Rti);
Pop_Identifier_Prefix (Mark);
+ when Iir_Kind_If_Generate_Statement =>
+ Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
+ Generate_Generate_Statement (Stmt, Parent_Rti);
+ Pop_Identifier_Prefix (Mark);
+ when Iir_Kind_For_Generate_Statement =>
+ Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
+ -- Create the RTI for the iterator type, in the parent of the
+ -- generate statement.
+ declare
+ Param : constant Iir := Get_Parameter_Specification (Stmt);
+ Iter_Type : constant Iir := Get_Type (Param);
+ Type_Info : constant Type_Info_Acc := Get_Info (Iter_Type);
+ Mark : Id_Mark_Type;
+ Iter_Rti : O_Dnode;
+ begin
+ 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;
+ Generate_Generate_Statement (Stmt, Parent_Rti);
+ Pop_Identifier_Prefix (Mark);
when Iir_Kind_Component_Instantiation_Statement =>
Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
Generate_Instance (Stmt, Parent_Rti);
@@ -2189,8 +2248,110 @@ package body Trans.Rtis is
end loop;
end Generate_Concurrent_Statement_Chain;
+ procedure Generate_Generate_Statement (Blk : Iir; Parent_Rti : O_Dnode)
+ is
+ Info : constant Ortho_Info_Acc := Get_Info (Blk);
+ Bod : constant Iir := Get_Generate_Statement_Body (Blk);
+ Bod_Info : constant Block_Info_Acc := Get_Info (Bod);
+
+ Child : Iir;
+ Child_Rti : O_Cnode;
+ Name : O_Dnode;
+ List : O_Record_Aggr_List;
+
+ Rti : O_Dnode;
+
+ Kind : O_Cnode;
+ Size : O_Cnode;
+
+ Prev : Rti_Block;
+
+ Field_Off : O_Cnode;
+ Res : O_Cnode;
+
+ Mark : Id_Mark_Type;
+ begin
+ New_Const_Decl (Rti, Create_Identifier ("RTI"),
+ O_Storage_Public, Ghdl_Rtin_Generate);
+ Push_Rti_Node (Prev);
+
+ Field_Off := New_Offsetof
+ (Get_Scope_Type (Get_Info (Get_Parent (Blk)).Block_Scope),
+ Bod_Info.Block_Parent_Field, Ghdl_Ptr_Type);
+
+ case Get_Kind (Blk) is
+ when Iir_Kind_If_Generate_Statement =>
+ Push_Identifier_Prefix (Mark, "BOD");
+ Generate_Block (Bod, Rti);
+ Pop_Identifier_Prefix (Mark);
+ Kind := Ghdl_Rtik_If_Generate;
+ Size := Ghdl_Index_0;
+ if Get_Generate_Else_Clause (Blk) = Null_Iir then
+ Child := Bod;
+ else
+ Child := Null_Iir;
+ end if;
+ when Iir_Kind_For_Generate_Statement =>
+ Push_Identifier_Prefix (Mark, "BOD");
+ Generate_Block (Bod, Rti);
+ Pop_Identifier_Prefix (Mark);
+ Kind := Ghdl_Rtik_For_Generate;
+ Size := New_Sizeof (Get_Scope_Type (Bod_Info.Block_Scope),
+ Ghdl_Index_Type);
+ Child := Bod;
+ when others =>
+ Error_Kind ("rti.generate_generate", Blk);
+ end case;
+
+ Name := Generate_Name (Blk);
+
+ Start_Const_Value (Rti);
+
+ Start_Record_Aggr (List, Ghdl_Rtin_Generate);
+ New_Record_Aggr_El (List, Generate_Common (Kind));
+ New_Record_Aggr_El (List, New_Global_Address (Name, Char_Ptr_Type));
+
+ -- Field Loc: offset in the instance of the entity.
+ New_Record_Aggr_El (List, Field_Off);
+
+ New_Record_Aggr_El (List, Generate_Linecol (Blk));
+
+ -- Field Parent: RTI of the parent.
+ New_Record_Aggr_El (List, New_Rti_Address (Parent_Rti));
+
+ -- Field Size: size of the instance.
+ -- For for-generate: size of instance, which gives the stride in the
+ -- sub-blocks array.
+ New_Record_Aggr_El (List, Size);
+
+ -- Child.
+ if Child = Null_Iir then
+ Child_Rti := New_Null_Access (Ghdl_Rti_Access);
+ else
+ Child_Rti := Get_Context_Rti (Child);
+ end if;
+ New_Record_Aggr_El (List, Child_Rti);
+
+ Finish_Record_Aggr (List, Res);
+
+ Finish_Const_Value (Rti, Res);
+
+ Pop_Rti_Node (Prev);
+
+ -- Put the result in the parent list.
+ Add_Rti_Node (Rti);
+
+ -- Store the RTI.
+ if False then
+ -- TODO: there is no info for if_generate/for_generate.
+ -- Not sure we need to store it (except maybe for 'path_name ?)
+ Info.Block_Rti_Const := Rti;
+ end if;
+ end Generate_Generate_Statement;
+
procedure Generate_Block (Blk : Iir; Parent_Rti : O_Dnode)
is
+ Info : constant Ortho_Info_Acc := Get_Info (Blk);
Name : O_Dnode;
Arr : O_Dnode;
List : O_Record_Aggr_List;
@@ -2203,31 +2364,9 @@ package body Trans.Rtis is
Res : O_Cnode;
Prev : Rti_Block;
- Info : Ortho_Info_Acc;
Field_Off : O_Cnode;
- Inst : O_Tnode;
begin
- -- The type of a generator iterator is elaborated in the parent.
- if Get_Kind (Blk) = Iir_Kind_For_Generate_Statement then
- declare
- 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;
- Iter_Rti : O_Dnode;
- begin
- 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;
@@ -2240,8 +2379,6 @@ package body Trans.Rtis is
Push_Rti_Node (Prev);
Field_Off := O_Cnode_Null;
- Inst := O_Tnode_Null;
- Info := Get_Info (Blk);
case Get_Kind (Blk) is
when Iir_Kind_Package_Declaration =>
Kind := Ghdl_Rtik_Package;
@@ -2255,7 +2392,6 @@ package body Trans.Rtis is
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 (Info.Block_Scope),
Info.Block_Parent_Field, Ghdl_Ptr_Type);
@@ -2266,14 +2402,12 @@ package body Trans.Rtis is
Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
Generate_Concurrent_Statement_Chain
(Get_Concurrent_Statement_Chain (Blk), Rti);
- Inst := Get_Scope_Type (Info.Block_Scope);
when Iir_Kind_Process_Statement
| Iir_Kind_Sensitized_Process_Statement =>
Kind := Ghdl_Rtik_Process;
Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
Field_Off :=
Get_Scope_Offset (Info.Process_Scope, Ghdl_Ptr_Type);
- Inst := Get_Scope_Type (Info.Process_Scope);
when Iir_Kind_Block_Statement =>
Kind := Ghdl_Rtik_Block;
declare
@@ -2295,38 +2429,24 @@ package body Trans.Rtis is
Generate_Concurrent_Statement_Chain
(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_If_Generate_Statement =>
- Kind := Ghdl_Rtik_If_Generate;
+ when Iir_Kind_Generate_Statement_Body =>
+ Kind := Ghdl_Rtik_Generate_Body;
+ -- Also includes iterator of for_generate_statement.
declare
- Bod : constant Iir := Get_Generate_Statement_Body (Blk);
- Bod_Info : constant Block_Info_Acc := Get_Info (Bod);
+ Parent : constant Iir := Get_Parent (Blk);
+ Param_Rti : O_Dnode;
begin
- 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);
+ if Get_Kind (Parent) = Iir_Kind_For_Generate_Statement then
+ -- Must be set to null, as this isn't a completion.
+ Param_Rti := O_Dnode_Null;
+ Generate_Object
+ (Get_Parameter_Specification (Parent), Param_Rti);
+ Add_Rti_Node (Param_Rti);
+ end if;
end;
+ Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
+ Generate_Concurrent_Statement_Chain
+ (Get_Concurrent_Statement_Chain (Blk), Rti);
when others =>
Error_Kind ("rti.generate_block", Blk);
end case;
@@ -2344,25 +2464,24 @@ package body Trans.Rtis is
Start_Record_Aggr (List, Ghdl_Rtin_Block);
New_Record_Aggr_El (List, Generate_Common (Kind));
New_Record_Aggr_El (List, New_Global_Address (Name, Char_Ptr_Type));
+
+ -- Field Loc: offset in the instance of the entity.
if Field_Off = O_Cnode_Null then
Field_Off := Get_Null_Loc;
end if;
New_Record_Aggr_El (List, Field_Off);
+
New_Record_Aggr_El (List, Generate_Linecol (Blk));
+
+ -- Field Parent: RTI of the parent.
if Parent_Rti = O_Dnode_Null then
Res := New_Null_Access (Ghdl_Rti_Access);
else
Res := New_Rti_Address (Parent_Rti);
end if;
New_Record_Aggr_El (List, Res);
- 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);
+
+ -- Fields Nbr_Child and Children.
New_Record_Aggr_El
(List, New_Unsigned_Literal (Ghdl_Index_Type,
Unsigned_64 (Cur_Block.Nbr)));
@@ -2381,11 +2500,10 @@ package body Trans.Rtis is
Pop_Rti_Node (Prev);
- -- Put children in the parent list.
+ -- Put result in the parent list.
case Get_Kind (Blk) is
when Iir_Kind_Block_Statement
- | Iir_Kind_For_Generate_Statement
- | Iir_Kind_If_Generate_Statement
+ | Iir_Kind_Generate_Statement_Body
| Iir_Kind_Process_Statement
| Iir_Kind_Sensitized_Process_Statement =>
Add_Rti_Node (Rti);
@@ -2397,16 +2515,9 @@ 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_Block_Statement
+ | Iir_Kind_Generate_Statement_Body =>
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;
diff --git a/src/vhdl/translate/trans-rtis.ads b/src/vhdl/translate/trans-rtis.ads
index 85fbe1156..06662fc6f 100644
--- a/src/vhdl/translate/trans-rtis.ads
+++ b/src/vhdl/translate/trans-rtis.ads
@@ -29,6 +29,7 @@ package Trans.Rtis is
Ghdl_Rtik_Block : O_Cnode;
Ghdl_Rtik_If_Generate : O_Cnode;
Ghdl_Rtik_For_Generate : O_Cnode;
+ Ghdl_Rtik_Generate_Body : O_Cnode;
Ghdl_Rtik_Instance : O_Cnode;
Ghdl_Rtik_Constant : O_Cnode;
Ghdl_Rtik_Iterator : O_Cnode;