summaryrefslogtreecommitdiff
path: root/src/grt
diff options
context:
space:
mode:
Diffstat (limited to 'src/grt')
-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
7 files changed, 170 insertions, 88 deletions
diff --git a/src/grt/grt-avhpi.adb b/src/grt/grt-avhpi.adb
index 16bbad6..f6c5c41 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 bb6f75f..1e029d1 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 7d58119..4afb641 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 b5d307b..e711740 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 d9f746e..199c449 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 3fa2792..5dd0703 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 0d4328e..1994e90 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;
generated by cgit (git 2.34.1) at 2025-02-03 09:29:01 +0000