diff options
author | Tristan Gingold <tgingold@free.fr> | 2017-01-31 05:58:09 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2017-01-31 20:22:09 +0100 |
commit | b5009c3026b295d91ed5fc3d8682c700b67db4ab (patch) | |
tree | 8ab12da1e584bd5ba855c38d408d9b7468b7530a /src/vhdl | |
parent | bc10b035f5998d1cc9ec2aa0122ee1c24099ca05 (diff) | |
download | ghdl-b5009c3026b295d91ed5fc3d8682c700b67db4ab.tar.gz ghdl-b5009c3026b295d91ed5fc3d8682c700b67db4ab.tar.bz2 ghdl-b5009c3026b295d91ed5fc3d8682c700b67db4ab.zip |
simulate: reorder block list, support Concurrent_Simple_Signal_Assignment
Diffstat (limited to 'src/vhdl')
-rw-r--r-- | src/vhdl/simulate/annotations.adb | 5 | ||||
-rw-r--r-- | src/vhdl/simulate/elaboration.adb | 62 | ||||
-rw-r--r-- | src/vhdl/simulate/elaboration.ads | 4 | ||||
-rw-r--r-- | src/vhdl/simulate/execution.adb | 14 |
4 files changed, 60 insertions, 25 deletions
diff --git a/src/vhdl/simulate/annotations.adb b/src/vhdl/simulate/annotations.adb index 100802527..34a2a88b9 100644 --- a/src/vhdl/simulate/annotations.adb +++ b/src/vhdl/simulate/annotations.adb @@ -978,6 +978,11 @@ package body Annotations is when Iir_Kind_Simple_Simultaneous_Statement => null; + when Iir_Kind_Concurrent_Simple_Signal_Assignment => + -- In case concurrent signal assignemnts were not + -- canonicalized. + null; + when others => Error_Kind ("annotate_concurrent_statements_list", El); end case; diff --git a/src/vhdl/simulate/elaboration.adb b/src/vhdl/simulate/elaboration.adb index dc0006130..5904bd534 100644 --- a/src/vhdl/simulate/elaboration.adb +++ b/src/vhdl/simulate/elaboration.adb @@ -357,9 +357,15 @@ package body Elaboration is Actuals_Ref => null, Result => null); - if Father /= null and then Obj_Info.Kind = Kind_Block then - Res.Brother := Father.Children; - Father.Children := Res; + if Father /= null then + case Obj_Info.Kind is + when Kind_Block + | Kind_Process => + Res.Brother := Father.Children; + Father.Children := Res; + when others => + null; + end case; end if; return Res; @@ -1803,11 +1809,32 @@ package body Elaboration is | Iir_Kind_Psl_Assert_Statement => Elaborate_Psl_Directive (Instance, Stmt); + when Iir_Kind_Concurrent_Simple_Signal_Assignment => + -- In case concurrent signal assignemnts were not + -- canonicalized. + null; + when others => Error_Kind ("elaborate_statement_part", Stmt); end case; Stmt := Get_Chain (Stmt); end loop; + + -- Put children in order (were prepended, so in reverse order). + declare + Last, Child : Block_Instance_Acc; + Next_Child : Block_Instance_Acc; + begin + Child := Instance.Children; + Last := null; + while Child /= null loop + Next_Child := Child.Brother; + Child.Brother := Last; + Last := Child; + Child := Next_Child; + end loop; + Instance.Children := Last; + end; end Elaborate_Statement_Part; -- Compute the default value for declaration DECL, using either @@ -2037,9 +2064,9 @@ package body Elaboration is Expr : Iir_Value_Literal_Acc; Ind : Instance_Slot_Type; begin - -- Gather children (were prepended, so in reverse order). + -- Gather children. Child := Instance.Children; - for I in reverse Sub_Instances'Range loop + for I in Sub_Instances'Range loop Sub_Instances (I) := Child; Child := Child.Brother; end loop; @@ -2112,22 +2139,25 @@ package body Elaboration is Item : Iir; begin - -- Gather children. + -- Gather block children. declare Child : Block_Instance_Acc; + Child_Info : Sim_Info_Acc; begin Child := Instance.Children; while Child /= null loop - declare - Slot : constant Instance_Slot_Type := - Get_Info (Child.Label).Inst_Slot; - begin - -- Skip processes (they have no slot). - if Slot /= Invalid_Instance_Slot then - pragma Assert (Sub_Instances (Slot) = null); - Sub_Instances (Slot) := Child; - end if; - end; + Child_Info := Get_Info (Child.Label); + if Child_Info.Kind = Kind_Block then + declare + Slot : constant Instance_Slot_Type := Child_Info.Inst_Slot; + begin + -- Skip processes (they have no slot). + if Slot /= Invalid_Instance_Slot then + pragma Assert (Sub_Instances (Slot) = null); + Sub_Instances (Slot) := Child; + end if; + end; + end if; Child := Child.Brother; end loop; end; diff --git a/src/vhdl/simulate/elaboration.ads b/src/vhdl/simulate/elaboration.ads index f6dac20d5..9a03bcc25 100644 --- a/src/vhdl/simulate/elaboration.ads +++ b/src/vhdl/simulate/elaboration.ads @@ -70,8 +70,12 @@ package Elaboration is Stmt : Iir; -- Instanciation tree. + -- Parent is always set (but null for top-level block and packages) Parent: Block_Instance_Acc; + + -- Chain of children. They are in declaration order after elaboration. + -- (in reverse order during elaboration). -- Not null only for blocks and processes. Children: Block_Instance_Acc; Brother: Block_Instance_Acc; diff --git a/src/vhdl/simulate/execution.adb b/src/vhdl/simulate/execution.adb index 013d06928..61630f389 100644 --- a/src/vhdl/simulate/execution.adb +++ b/src/vhdl/simulate/execution.adb @@ -1676,9 +1676,7 @@ package body Execution is Bound : Iir_Value_Literal_Acc; begin -- Only for constrained subtypes. - if Get_Kind (A_Type) = Iir_Kind_Array_Type_Definition then - raise Internal_Error; - end if; + pragma Assert (Get_Kind (A_Type) /= Iir_Kind_Array_Type_Definition); Index_List := Get_Index_Subtype_List (A_Type); Res := Create_Array_Value @@ -2007,12 +2005,10 @@ package body Execution is return Res; end Execute_Record_Aggregate; - function Execute_Aggregate - (Block: Block_Instance_Acc; - Aggregate: Iir; - Aggregate_Type: Iir) - return Iir_Value_Literal_Acc - is + function Execute_Aggregate (Block: Block_Instance_Acc; + Aggregate: Iir; + Aggregate_Type: Iir) + return Iir_Value_Literal_Acc is begin case Get_Kind (Aggregate_Type) is when Iir_Kind_Array_Type_Definition |