diff options
author | Tristan Gingold <tgingold@free.fr> | 2015-01-07 08:07:42 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2015-01-07 08:07:42 +0100 |
commit | 99443212bf78a5d36b693abab225a160a92d097a (patch) | |
tree | 9191d2419b376bd45737e3b23e9b95967c017560 /src/grt | |
parent | 3aaf2679a61b4d8bd61c7cccd5ca0ec1f1606de5 (diff) | |
download | ghdl-99443212bf78a5d36b693abab225a160a92d097a.tar.gz ghdl-99443212bf78a5d36b693abab225a160a92d097a.tar.bz2 ghdl-99443212bf78a5d36b693abab225a160a92d097a.zip |
Handle vhdl08 if generate statements
Diffstat (limited to 'src/grt')
-rw-r--r-- | src/grt/grt-avhpi.adb | 21 | ||||
-rw-r--r-- | src/grt/grt-disp_rti.adb | 53 | ||||
-rw-r--r-- | src/grt/grt-disp_tree.adb | 14 | ||||
-rw-r--r-- | src/grt/grt-rtis_addr.adb | 19 | ||||
-rw-r--r-- | src/grt/grt-rtis_addr.ads | 5 | ||||
-rw-r--r-- | src/grt/grt-rtis_utils.adb | 58 |
6 files changed, 87 insertions, 83 deletions
diff --git a/src/grt/grt-avhpi.adb b/src/grt/grt-avhpi.adb index f6c5c4138..1b8e5aa76 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 1e029d151..ad45d087a 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 4afb64191..3eb715d3f 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 199c449eb..444f1f033 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 5dd070334..dd0ca1546 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 1994e90cb..9d7a56f2f 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; |