Adding some RTI docs and comments. Also tracing that some be removed.…

… Don'

't merge

doc/internals/rti.rst

@@ -0,0 +1,90 @@
+RTI
+###
+
+RTI Blocks
+==========
+
+entity / architecture / package / process / block
+-------------------------------------------------
+
+  * `Next_Context := (Base => Context.Base+Self.Loc, Block => Self)`
+
+  * Loops over all the children in the block.
+
+  * All the children receive the same context.
+
+generate_body
+-------------
+
+  * `Next_Context := Context`
+
+  * A generate body is transparent. It contains all the children there,
+    but the context still points to the top generate statement.
+
+  * All the children receive the same context.
+
+if_generate / case_generate
+---------------------------
+
+  * At the location Context.Base + Self.Loc there is
+
+    * instance_pointer field
+
+    * block_id field
+
+  * `Next_Context = (Base => instance_pointer, Block => Self.Children(block_id))`
+
+  * I think this is how it works:
+    During elaboration we work out which of the children
+    is selected and create the structure with the
+    instance pointer pointing to where that childs
+    info is getting placed, and the block_id indicating
+    which of the children was selected.
+
+for_generate
+------------
+
+  * At the location Context.Base + Self.Loc there is
+
+    * for_instance_pointer field
+
+  * `Next_Context := (Base => for_instance_pointer + i*size, Block => Self.Child)`
+    where i is the loop index, and size is Self.Size
+
+  * A for_generate contains a generate_body as it's only child.
+
+  * The first element in that generate_body is an iterator.
+
+  * That iterator has a type, and we assume that the type of that
+    iterator is specified within the same context as the for_generate.
+    This is typically true because, in practice, we always define the
+    iterator type implicitly in the for_generate statement. Ghdl
+    create an anonymous type definition immediately preceding the
+    for_generate.
+
+instance
+--------
+
+
+Example
+=======
+
+.. code-block:: Vhdl
+
+   library ieee;
+   use ieee.std_logic_1164.all;
+   
+   entity myxor is
+     port (
+       a: in std_logic_vector(2 downto 0);
+       b: in std_logic_vector(2 downto 0);
+       c: out std_logic_vector(2 downto 0)
+       );
+   end entity;
+     
+   architecture arch of myxor is
+   begin
+     gloop: for i in 0 to 2 generate
+       c(i) <= a(i) xor b(i);
+     end generate;
+   end architecture;

src/grt/grt-disp_rti.adb

@@ -30,9 +30,64 @@ with Grt.Hooks; use Grt.Hooks;
 with Grt.Rtis_Utils; use Grt.Rtis_Utils;
 with Grt.Signals;
 
+with System.Address_Image;
+
 package body Grt.Disp_Rti is
    procedure Disp_Kind (Kind : Ghdl_Rtik);
 
+   function Pointer_To_String (Rti : Ghdl_Rti_Access) return String is
+   begin
+      return System.Address_Image(Rti.all'address);
+   end Pointer_To_String;
+
+   procedure Disp_Loc (Loc : Integer_Address) is
+   begin
+      Put ("Loc is at " & Integer_Address'Image(Loc) & ". ");
+   end Disp_Loc;
+
+   procedure Disp_Self (Self : Ghdl_Rti_Access) is
+   begin
+      Put ("Self is " & Pointer_To_String(Self) & ". ");
+   end Disp_Self;
+
+   procedure Disp_Parent (Parent : Ghdl_Rti_Access) is
+   begin
+      Put ("Parent is " & Pointer_To_String(Parent) & ". ");
+   end Disp_Parent;
+
+   procedure Disp_Nbr_Child (Nbr_Child : Ghdl_Index_Type) is
+   begin
+      Put ("Number of children is " & Ghdl_Index_Type'Image(Nbr_Child) & ". ");
+   end Disp_Nbr_Child;
+
+   procedure Disp_Child (Child : Ghdl_Rti_Access) is
+   begin
+      Put ("Child is " & Pointer_To_String(Child) & ". ");
+   end Disp_Child;
+
+   function Get_Offset (Base : System.Address; Top : System.Address)
+                       return Integer is
+      Base_Int : Integer_Address;
+      Top_Int : Integer_Address;
+   begin
+      Base_Int := To_Integer(Base);
+      Top_Int := To_Integer(Top);
+      if Base_Int > Top_Int then
+         return Integer(Base_Int - Top_Int);
+      else
+         return - Integer(Top_Int - Base_Int);
+      end if;
+   end Get_Offset;
+
+   procedure Disp_Context (Ctxt : Rti_Context) is
+      Offset : Integer;
+   begin
+      Offset := Get_Offset(Ctxt.Base, Ghdl_Rti_Top_Instance);
+      Put ("Context is Base(" & System.Address_Image(Ctxt.Base) & ")");
+      Put (", Relative Base(" & Integer'Image(Offset) & ")");
+      Put (", Rti Pointer (" & Pointer_To_String(Ctxt.Block) & ")");
+   end Disp_Context;
+
    procedure Disp_Name (Name : Ghdl_C_String) is
    begin
       if Name = null then
@@ -771,6 +826,9 @@ package body Grt.Disp_Rti is
    is
    begin
       for I in 1 .. Nbr loop
+         Disp_Indent(Indent);
+         Put ("Array index is " & Ghdl_Index_Type'Image(I) & ".");
+         New_Line;
          Disp_Rti (Arr (I - 1), Ctxt, Indent);
       end loop;
    end Disp_Rti_Arr;
@@ -781,6 +839,9 @@ package body Grt.Disp_Rti is
    is
       Nctxt : Rti_Context;
    begin
+      Disp_Indent (Indent);
+      Put ("*********************");
+      New_Line;
       Disp_Indent (Indent);
       Disp_Kind (Blk.Common.Kind);
       Disp_Depth (Blk.Common.Depth);
@@ -789,6 +850,28 @@ package body Grt.Disp_Rti is
       Put (": ");
       Disp_Name (Blk.Name);
       New_Line;
+      Disp_Indent (Indent);
+      Disp_Self (To_Ghdl_Rti_Access(Blk));
+      New_Line;
+      Disp_Indent (Indent);
+      Disp_Context (Ctxt);
+      New_Line;
+      Disp_Indent (Indent);
+      Disp_Loc (Blk.Loc);
+      New_Line;
+      Disp_Indent (Indent);
+      Disp_Parent (Blk.Parent);
+      New_Line;
+      Disp_Indent (Indent);
+      Disp_Nbr_Child (Blk.Nbr_Child);
+      New_Line;
+      --Common : Ghdl_Rti_Common;
+      --Name : Ghdl_C_String;
+      --Loc : Ghdl_Rti_Loc;
+      --Linecol : Ghdl_Index_Type;
+      --Parent : Ghdl_Rti_Access;
+      --Nbr_Child : Ghdl_Index_Type;
+      --Children : Ghdl_Rti_Arr_Acc;
       case Blk.Common.Kind is
          when Ghdl_Rtik_Package
            | Ghdl_Rtik_Package_Body
@@ -806,7 +889,12 @@ package body Grt.Disp_Rti is
          case Blk.Common.Kind is
             when Ghdl_Rtik_Architecture =>
                --  Disp entity.
+               Put("@@@@@ When displaying an architecture we display" &
+                     "the parent first ");
+               New_Line;
                Disp_Rti (Blk.Parent, Ctxt, Indent + 1);
+               Put("@@@@@ Back to architecture now");
+               New_Line;
             when others =>
                null;
          end case;
@@ -823,6 +911,9 @@ package body Grt.Disp_Rti is
             Disp_Rti_Arr (Blk.Nbr_Child, Blk.Children,
                           Nctxt, Indent + 1);
          when Ghdl_Rtik_Generate_Body =>
+            Disp_Indent (Indent);
+            Put ("Putting Generate_Body");
+            New_Line;
             Disp_Rti_Arr (Blk.Nbr_Child, Blk.Children,
                           Ctxt, Indent + 1);
          when Ghdl_Rtik_If_Generate
@@ -845,7 +936,11 @@ package body Grt.Disp_Rti is
    is
       Nctxt : Rti_Context;
       Length : Ghdl_Index_Type;
+      Added: Address;
    begin
+      Disp_Indent (Indent);
+      Put ("**********************");
+      New_Line;
       Disp_Indent (Indent);
       Disp_Kind (Gen.Common.Kind);
       Disp_Depth (Gen.Common.Depth);
@@ -854,14 +949,55 @@ package body Grt.Disp_Rti is
       Put (": ");
       Disp_Name (Gen.Name);
       New_Line;
+      Disp_Indent (Indent);
+      Disp_Self (To_Ghdl_Rti_Access(Gen));
+      New_Line;
+      Disp_Indent (Indent);
+      Disp_Loc(Gen.Loc);
+      New_Line;
+      Disp_Indent (Indent);
+      Disp_Context (Ctxt);
+      New_Line;
+      Disp_Indent (Indent);
+      Disp_Parent (Gen.Parent);
+      New_Line;
+      Disp_Indent (Indent);
+      Put ("Size is " & Ghdl_Index_Type'Image(Gen.Size));
+      New_Line;
+      Disp_Indent (Indent);
+      Disp_Child (Gen.Child);
+      New_Line;
 
+      Put ("Ctxt.Base is " & Address_Image(Ctxt.Base));
+      New_Line;
+      Put ("Gen.Loc is " & Integer_Address'Image(Gen.Loc));
+      New_Line;
+      Put ("Ctxt.Base + Gen.Loc is " & Address_Image(Ctxt.Base + Gen.Loc));
+      Added := Ctxt.Base + Gen.Loc;
+      New_Line;
+      Put ("Added is " & Address_Image(Added));
+      New_Line;
+      Put ("Added stuff is " & Address_Image(To_Addr_Acc(Added).all));
+      New_Line;
+      --Put ("The size is " & Integer'Image(Gen.Size));
+      --New_Line;
+
+      -- The new address where RTI is stored can be found by taking
+      --  Ctxt.Base, adding Gen.Loc and then going to that location.
+      --  This contains a pointer to the RTI information so follow it
+      --  to the correct location.
+      -- This implies that a For_Generate statement only takes up
+      --  one's pointers worth a memory.
       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
+         Put ("Nctxt.Base is " & Address_Image(Nctxt.Base) & ")");
+         New_Line;
          Disp_Block (To_Ghdl_Rtin_Block_Acc (Gen.Child),
                      Nctxt, Indent + 1);
          Nctxt.Base := Nctxt.Base + Gen.Size;
+         --Put ("Adding Size which is " & Integer'Image(Gen.Size) & ")");
       end loop;
    end Disp_For_Generate;
 
@@ -1338,11 +1474,21 @@ package body Grt.Disp_Rti is
       Put ("DISP_RTI.Disp_All: ");
       Disp_Kind (Ghdl_Rti_Top.Common.Kind);
       New_Line;
+      Put ("Ghdl_Rti_Top_Instance is " &
+             System.Address_Image(Ghdl_Rti_Top_Instance'address));
+      New_Line;
+      Put ("Ghdl_Rti_Top.Parent is " &
+             System.Address_Image(Ghdl_Rti_Top.Parent.all'address));
+      New_Line;
       Ctxt := (Base => Ghdl_Rti_Top_Instance,
                Block => Ghdl_Rti_Top.Parent);
+      -- These seem to be the standard packages.
       Disp_Rti_Arr (Ghdl_Rti_Top.Nbr_Child,
                     Ghdl_Rti_Top.Children,
                     Ctxt, 0);
+      Put ("DISP_RTI.Disp_All: Putting parent");
+      New_Line;
+      -- And this seems to contain the actual design.
       Disp_Rti (Ghdl_Rti_Top.Parent, Ctxt, 0);
 
       --Disp_Hierarchy;

src/grt/grt-rtis_addr.adb

@@ -182,6 +182,9 @@ package body Grt.Rtis_Addr is
               Block => Blk.Children (Id));
    end Get_If_Case_Generate_Child;
 
+   -- Where tryint to find the absolute location of an item.
+   -- We have a Loc field and a Depth for that item.
+   -- We also have the context that we are in.
    function Loc_To_Addr (Depth : Ghdl_Rti_Depth;
                          Loc : Ghdl_Rti_Loc;
                          Ctxt : Rti_Context)
@@ -190,15 +193,23 @@ package body Grt.Rtis_Addr is
       Cur_Ctxt : Rti_Context;
       Nctxt : Rti_Context;
    begin
+      -- If the depth of the location is 0 it is an absolute location already.
       if Depth = 0 then
          return To_Address (Loc);
       elsif Ctxt.Block.Depth = Depth then
+         -- If the depth of the item matches the context depth then we can
+         -- just find the location based on the context base.
+
          --Addr := Base + Storage_Offset (Obj.Loc.Off);
          return Ctxt.Base + Loc;
       else
+         -- The context can't have already moved past the item.
          if Ctxt.Block.Depth < Depth then
             Internal_Error ("loc_to_addr");
          end if;
+         -- We're assume that the item lies above the context
+         -- and not on some other branch (i.e. not a decendent of context
+         -- but with a nevertheless smaller depth).
          Cur_Ctxt := Ctxt;
          loop
             Nctxt := Get_Parent_Context (Cur_Ctxt);
@@ -237,6 +248,10 @@ package body Grt.Rtis_Addr is
       Iter_Type : Ghdl_Rtin_Subtype_Scalar_Acc;
       Rng : Ghdl_Range_Ptr;
    begin
+      -- The first child of the generator body is an iterator.
+      -- Get the type of this iterator, and then get the
+      -- range of that type.  For that we can detemine the length
+      -- of the for_generate.
       Iter_Type := To_Ghdl_Rtin_Subtype_Scalar_Acc
         (To_Ghdl_Rtin_Object_Acc (Bod.Children (0)).Obj_Type);
       if Iter_Type.Common.Kind /= Ghdl_Rtik_Subtype_Scalar then