summaryrefslogtreecommitdiff
path: root/src/grt
diff options
context:
space:
mode:
Diffstat (limited to 'src/grt')
-rw-r--r--src/grt/grt-avhpi.adb21
-rw-r--r--src/grt/grt-disp_rti.adb53
-rw-r--r--src/grt/grt-disp_tree.adb14
-rw-r--r--src/grt/grt-rtis_addr.adb19
-rw-r--r--src/grt/grt-rtis_addr.ads5
-rw-r--r--src/grt/grt-rtis_utils.adb58
6 files changed, 87 insertions, 83 deletions
diff --git a/src/grt/grt-avhpi.adb b/src/grt/grt-avhpi.adb
index f6c5c41..1b8e5aa 100644
--- a/src/grt/grt-avhpi.adb
+++ b/src/grt/grt-avhpi.adb
@@ -297,20 +297,13 @@ package body Grt.Avhpi is
Error := AvhpiErrorOk;
return;
when Ghdl_Rtik_If_Generate =>
- 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;
+ Res := (Kind => VhpiIfGenerateK,
+ Ctxt => Get_If_Generate_Child (Iterator.Ctxt, Ch));
+ -- Return only if the condition is true.
+ if Res.Ctxt.Base /= Null_Address then
+ Error := AvhpiErrorOk;
+ return;
+ end if;
when Ghdl_Rtik_For_Generate =>
declare
Gen : constant Ghdl_Rtin_Generate_Acc :=
diff --git a/src/grt/grt-disp_rti.adb b/src/grt/grt-disp_rti.adb
index 1e029d1..ad45d08 100644
--- a/src/grt/grt-disp_rti.adb
+++ b/src/grt/grt-disp_rti.adb
@@ -702,16 +702,21 @@ package body Grt.Disp_Rti is
when Ghdl_Rtik_Generate_Body =>
Disp_Rti_Arr (Blk.Nbr_Child, Blk.Children,
Ctxt, Indent + 1);
+ when Ghdl_Rtik_If_Generate =>
+ Nctxt := Get_If_Generate_Child (Ctxt, To_Ghdl_Rti_Access (Blk));
+ Disp_Block
+ (To_Ghdl_Rtin_Block_Acc (Nctxt.Block), Nctxt, 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)
+ procedure Disp_For_Generate (Gen : Ghdl_Rtin_Generate_Acc;
+ Ctxt : Rti_Context;
+ Indent : Natural)
is
Nctxt : Rti_Context;
+ Length : Ghdl_Index_Type;
begin
Disp_Indent (Indent);
Disp_Kind (Gen.Common.Kind);
@@ -721,31 +726,16 @@ package body Grt.Disp_Rti is
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 + Gen.Loc).all,
- Block => Gen.Child);
- Length := Get_For_Generate_Length (Gen, Ctxt);
- for I in 1 .. Length loop
- 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 + Gen.Loc).all,
- Block => Gen.Child);
- if Nctxt.Base /= Null_Address then
- Disp_Block (To_Ghdl_Rtin_Block_Acc (Gen.Child),
- Nctxt, Indent + 1);
- end if;
- when others =>
- Internal_Error ("disp_generate");
- end case;
- end Disp_Generate;
+
+ 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_Block (To_Ghdl_Rtin_Block_Acc (Gen.Child),
+ Nctxt, Indent + 1);
+ Nctxt.Base := Nctxt.Base + Gen.Size;
+ end loop;
+ end Disp_For_Generate;
procedure Disp_Object (Obj : Ghdl_Rtin_Object_Acc;
Is_Sig : Boolean;
@@ -1083,9 +1073,10 @@ package body Grt.Disp_Rti is
| Ghdl_Rtik_Process
| 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_If_Generate =>
+ Disp_Block (To_Ghdl_Rtin_Block_Acc (Rti), Ctxt, Indent);
+ when Ghdl_Rtik_For_Generate =>
+ Disp_For_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 4afb641..3eb715d 100644
--- a/src/grt/grt-disp_tree.adb
+++ b/src/grt/grt-disp_tree.adb
@@ -154,10 +154,11 @@ package body Grt.Disp_Tree is
when Ghdl_Rtik_If_Generate =>
Put (" [if-generate ");
if Ctxt.Base = Null_Address then
- Put ("false]");
+ Put ("false");
else
- Put ("true]");
+ Put ("true");
end if;
+ Put ("]");
when Ghdl_Rtik_Signal =>
Put (" [signal]");
when Ghdl_Rtik_Port =>
@@ -282,16 +283,13 @@ package body Grt.Disp_Tree is
end;
when Ghdl_Rtik_If_Generate =>
declare
- Gen : constant Ghdl_Rtin_Generate_Acc :=
- To_Ghdl_Rtin_Generate_Acc (Child);
- Nctxt : Rti_Context;
+ Nctxt : constant Rti_Context :=
+ Get_If_Generate_Child (Ctxt, Child);
begin
- 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
- (To_Ghdl_Rtin_Block_Acc (Gen.Child), Nctxt);
+ (To_Ghdl_Rtin_Block_Acc (Nctxt.Block), Nctxt);
end if;
end;
when Ghdl_Rtik_Instance =>
diff --git a/src/grt/grt-rtis_addr.adb b/src/grt/grt-rtis_addr.adb
index 199c449..444f1f0 100644
--- a/src/grt/grt-rtis_addr.adb
+++ b/src/grt/grt-rtis_addr.adb
@@ -135,6 +135,25 @@ package body Grt.Rtis_Addr is
end if;
end Get_Instance_Link;
+ function Get_If_Generate_Child (Ctxt : Rti_Context; Gen : Ghdl_Rti_Access)
+ return Rti_Context
+ is
+ pragma Assert (Gen.Kind = Ghdl_Rtik_If_Generate);
+ Blk : constant Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Gen);
+ Base_Addr : constant Address := Ctxt.Base + Blk.Loc;
+
+ -- Address of the block_id field. It is just after the instance field.
+ -- Assume alignment is ok (it is on 32 and 64 bit platforms).
+ Id_Addr : constant Address :=
+ Base_Addr + Ghdl_Index_Type'(Address'Size / Storage_Unit);
+ Id : Ghdl_Index_Type;
+ pragma Import (Ada, Id);
+ for Id'Address use Id_Addr;
+ begin
+ return (Base => To_Addr_Acc (Base_Addr).all,
+ Block => Blk.Children (Id));
+ end Get_If_Generate_Child;
+
function Loc_To_Addr (Depth : Ghdl_Rti_Depth;
Loc : Ghdl_Rti_Loc;
Ctxt : Rti_Context)
diff --git a/src/grt/grt-rtis_addr.ads b/src/grt/grt-rtis_addr.ads
index 5dd0703..dd0ca15 100644
--- a/src/grt/grt-rtis_addr.ads
+++ b/src/grt/grt-rtis_addr.ads
@@ -64,6 +64,11 @@ package Grt.Rtis_Addr is
Ctxt : out Rti_Context;
Stmt : out Ghdl_Rti_Access);
+ -- Get the child context of if-generate statement GEN. Return Null_Context
+ -- if there is no child.
+ function Get_If_Generate_Child (Ctxt : Rti_Context; Gen : Ghdl_Rti_Access)
+ return Rti_Context;
+
-- Convert a location to an address.
function Loc_To_Addr (Depth : Ghdl_Rti_Depth;
Loc : Ghdl_Rti_Loc;
diff --git a/src/grt/grt-rtis_utils.adb b/src/grt/grt-rtis_utils.adb
index 1994e90..9d7a56f 100644
--- a/src/grt/grt-rtis_utils.adb
+++ b/src/grt/grt-rtis_utils.adb
@@ -77,16 +77,10 @@ package body Grt.Rtis_Utils is
end loop;
end;
when Ghdl_Rtik_If_Generate =>
- declare
- Gen : constant Ghdl_Rtin_Generate_Acc :=
- To_Ghdl_Rtin_Generate_Acc (Child);
- begin
- 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;
- end;
+ Nctxt := Get_If_Generate_Child (Ctxt, Child);
+ if Nctxt.Base /= Null_Address then
+ Res := Traverse_Blocks_1 (Nctxt);
+ end if;
when Ghdl_Rtik_Instance =>
Res := Process (Ctxt, Child);
if Res = Traverse_Ok then
@@ -567,12 +561,6 @@ package body Grt.Rtis_Utils is
loop
Blk := To_Ghdl_Rtin_Block_Acc (Ctxt.Block);
case Ctxt.Block.Kind is
- when Ghdl_Rtik_Process
- | Ghdl_Rtik_Block
- | Ghdl_Rtik_If_Generate =>
- Prepend (Rstr, Blk.Name);
- Prepend (Rstr, Sep);
- Ctxt := Get_Parent_Context (Ctxt);
when Ghdl_Rtik_Entity =>
declare
Link : Ghdl_Entity_Link_Acc;
@@ -626,20 +614,30 @@ package body Grt.Rtis_Utils is
Prepend (Rstr, Sep);
end if;
end;
- when Ghdl_Rtik_For_Generate =>
- declare
- Iter : Ghdl_Rtin_Object_Acc;
- Addr : Address;
- begin
- Prepend (Rstr, ')');
- Iter := To_Ghdl_Rtin_Object_Acc (Blk.Children (0));
- Addr := Loc_To_Addr (Iter.Common.Depth, Iter.Loc, Ctxt);
- Get_Value (Rstr, Addr, Get_Base_Type (Iter.Obj_Type));
- Prepend (Rstr, '(');
- Prepend (Rstr, Blk.Name);
- Prepend (Rstr, Sep);
- Ctxt := Get_Parent_Context (Ctxt);
- end;
+ when Ghdl_Rtik_Process
+ | Ghdl_Rtik_Block
+ | Ghdl_Rtik_If_Generate =>
+ Prepend (Rstr, Blk.Name);
+ Prepend (Rstr, Sep);
+ Ctxt := Get_Parent_Context (Ctxt);
+ when Ghdl_Rtik_Generate_Body =>
+ if Blk.Parent.Kind = Ghdl_Rtik_For_Generate then
+ declare
+ Gen : constant Ghdl_Rtin_Generate_Acc :=
+ To_Ghdl_Rtin_Generate_Acc (Blk.Parent);
+ Iter : Ghdl_Rtin_Object_Acc;
+ Addr : Address;
+ begin
+ Prepend (Rstr, ')');
+ Iter := To_Ghdl_Rtin_Object_Acc (Blk.Children (0));
+ Addr := Loc_To_Addr (Iter.Common.Depth, Iter.Loc, Ctxt);
+ Get_Value (Rstr, Addr, Get_Base_Type (Iter.Obj_Type));
+ Prepend (Rstr, '(');
+ Prepend (Rstr, Gen.Name);
+ Prepend (Rstr, Sep);
+ end;
+ end if;
+ Ctxt := Get_Parent_Context (Ctxt);
when others =>
Internal_Error ("grt.rtis_utils.get_path_name");
end case;
generated by cgit (git 2.34.1) at 2024-12-20 12:02:33 +0000