diff options
| author | Tristan Gingold <tgingold@free.fr> | 2015-01-04 05:36:03 +0100 | 
|---|---|---|
| committer | Tristan Gingold <tgingold@free.fr> | 2015-01-04 05:36:03 +0100 | 
| commit | 3aaf2679a61b4d8bd61c7cccd5ca0ec1f1606de5 (patch) | |
| tree | 08236cb25552ca9d06d236beef528a9380a4e914 /src | |
| parent | 3fea917ef9a145d448ab2dd5d83d7ac7de280602 (diff) | |
| download | ghdl-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.adb | 57 | ||||
| -rw-r--r-- | src/grt/grt-disp_rti.adb | 56 | ||||
| -rw-r--r-- | src/grt/grt-disp_tree.adb | 38 | ||||
| -rw-r--r-- | src/grt/grt-rtis.ads | 36 | ||||
| -rw-r--r-- | src/grt/grt-rtis_addr.adb | 45 | ||||
| -rw-r--r-- | src/grt/grt-rtis_addr.ads | 4 | ||||
| -rw-r--r-- | src/grt/grt-rtis_utils.adb | 22 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap9.adb | 3 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-rtis.adb | 275 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-rtis.ads | 1 | 
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; | 
