diff options
| author | Tristan Gingold <tgingold@free.fr> | 2016-11-04 08:05:19 +0100 |
|---|---|---|
| committer | Tristan Gingold <tgingold@free.fr> | 2016-11-05 06:38:19 +0100 |
| commit | b106247a9843880bcfa3611444e20696f0fb35ae (patch) | |
| tree | 614fb373a86c6ff16a7239478bb2b5780b6901d9 | |
| parent | 4c7c53b2fb53cd6ff03776b4ce47f6e9f30fd52f (diff) | |
| download | ghdl-b106247a9843880bcfa3611444e20696f0fb35ae.tar.gz ghdl-b106247a9843880bcfa3611444e20696f0fb35ae.tar.bz2 ghdl-b106247a9843880bcfa3611444e20696f0fb35ae.zip | |
ownership: check tree after sem and canon.
| -rw-r--r-- | src/ghdldrv/ghdlxml.adb | 4 | ||||
| -rw-r--r-- | src/libraries.adb | 8 | ||||
| -rw-r--r-- | src/vhdl/canon.adb | 216 | ||||
| -rw-r--r-- | src/vhdl/configuration.adb | 17 | ||||
| -rw-r--r-- | src/vhdl/disp_tree.adb | 21 | ||||
| -rw-r--r-- | src/vhdl/disp_vhdl.adb | 16 | ||||
| -rw-r--r-- | src/vhdl/iirs.adb | 14 | ||||
| -rw-r--r-- | src/vhdl/iirs.ads | 85 | ||||
| -rw-r--r-- | src/vhdl/iirs_utils.adb | 19 | ||||
| -rw-r--r-- | src/vhdl/iirs_utils.ads | 7 | ||||
| -rw-r--r-- | src/vhdl/iirs_walk.adb | 9 | ||||
| -rw-r--r-- | src/vhdl/nodes_gc.adb | 221 | ||||
| -rw-r--r-- | src/vhdl/nodes_meta.adb | 528 | ||||
| -rw-r--r-- | src/vhdl/nodes_meta.ads | 3 | ||||
| -rw-r--r-- | src/vhdl/nodes_meta.ads.in | 3 | ||||
| -rw-r--r-- | src/vhdl/sem.adb | 5 | ||||
| -rw-r--r-- | src/vhdl/sem_inst.adb | 65 | ||||
| -rw-r--r-- | src/vhdl/sem_inst.ads | 2 | ||||
| -rw-r--r-- | src/vhdl/sem_specs.adb | 4 | ||||
| -rw-r--r-- | src/vhdl/sem_stmts.adb | 2 | ||||
| -rw-r--r-- | src/vhdl/sem_types.adb | 1 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap2.adb | 6 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap8.adb | 7 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap9.adb | 18 |
24 files changed, 737 insertions, 544 deletions
diff --git a/src/ghdldrv/ghdlxml.adb b/src/ghdldrv/ghdlxml.adb index eb6eceec9..96356ddf2 100644 --- a/src/ghdldrv/ghdlxml.adb +++ b/src/ghdldrv/ghdlxml.adb @@ -401,7 +401,7 @@ package body Ghdlxml is Disp_Iir_Chain (Img, V); when Attr_Chain_Next => null; - when Attr_Of_Ref => + when Attr_Of_Ref | Attr_Of_Maybe_Ref => raise Internal_Error; end case; end; @@ -415,6 +415,8 @@ package body Ghdlxml is Disp_Iir_List (Img, L, False); when Attr_Of_Ref => Disp_Iir_List (Img, L, True); + when Attr_Of_Maybe_Ref => + Disp_Iir_List (Img, L, Get_Is_Ref (N)); when Attr_Ref => Disp_Iir_List_Ref (Img, L); when others => diff --git a/src/libraries.adb b/src/libraries.adb index 4258eeaea..40764e56b 100644 --- a/src/libraries.adb +++ b/src/libraries.adb @@ -1580,6 +1580,10 @@ package body Libraries is Disp_Vhdl.Disp_Vhdl (Unit); end if; + if Flags.Check_Ast_Level > 0 then + Nodes_GC.Check_Tree (Unit); + end if; + -- Post checks ---------------- @@ -1627,6 +1631,10 @@ package body Libraries is if (Main or Flags.List_All) and then Flags.List_Canon then Disp_Vhdl.Disp_Vhdl (Unit); end if; + + if Flags.Check_Ast_Level > 0 then + Nodes_GC.Check_Tree (Unit); + end if; end Finish_Compilation; procedure Load_Parse_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir) diff --git a/src/vhdl/canon.adb b/src/vhdl/canon.adb index 8a1ec3736..a23bbeb3f 100644 --- a/src/vhdl/canon.adb +++ b/src/vhdl/canon.adb @@ -18,7 +18,7 @@ with Errorout; use Errorout; with Iirs_Utils; use Iirs_Utils; with Types; use Types; -with Flags; +with Flags; use Flags; with Name_Table; with Sem; with Sem_Inst; @@ -1272,6 +1272,7 @@ package body Canon is Set_Parent (Proc, Get_Parent (Stmt)); Sensitivity_List := Create_Iir_List; Set_Sensitivity_List (Proc, Sensitivity_List); + Set_Is_Ref (Proc, True); Set_Process_Origin (Proc, Stmt); -- LRM93 9.5 @@ -1314,7 +1315,9 @@ package body Canon is Set_Sequential_Statement_Chain (Proc, If_Stmt); Location_Copy (If_Stmt, Stmt); Canon_Extract_Sensitivity (Get_Guard (Stmt), Sensitivity_List, False); - Set_Condition (If_Stmt, Get_Guard (Stmt)); + Set_Condition + (If_Stmt, Build_Reference_Decl (Get_Guard (Stmt), If_Stmt)); + Set_Guard (Stmt, Null_Iir); Chain := If_Stmt; declare @@ -1333,7 +1336,7 @@ package body Canon is Create_Iir (Iir_Kind_Simple_Signal_Assignment_Statement); Location_Copy (Dis_Stmt, Stmt); Set_Parent (Dis_Stmt, If_Stmt); - Set_Target (Dis_Stmt, Target); + Set_Target (Dis_Stmt, Build_Reference_Decl (Target, Dis_Stmt)); Set_Sequential_Statement_Chain (Else_Clause, Dis_Stmt); -- XX Set_Waveform_Chain (Dis_Stmt, Null_Iir); @@ -1350,14 +1353,14 @@ package body Canon is end if; end Canon_Concurrent_Signal_Assignment; - function Canon_Concurrent_Procedure_Call (El : Iir) + function Canon_Concurrent_Procedure_Call (Conc_Stmt : Iir) return Iir_Sensitized_Process_Statement is + Call : constant Iir_Procedure_Call := Get_Procedure_Call (Conc_Stmt); + Imp : constant Iir := Get_Implementation (Call); Proc : Iir_Sensitized_Process_Statement; Call_Stmt : Iir_Procedure_Call_Statement; Wait_Stmt : Iir_Wait_Statement; - Call : constant Iir_Procedure_Call := Get_Procedure_Call (El); - Imp : constant Iir := Get_Implementation (Call); Assoc_Chain : Iir; Sensitivity_List : Iir_List; Is_Sensitized : Boolean; @@ -1378,26 +1381,27 @@ package body Canon is else Proc := Create_Iir (Iir_Kind_Process_Statement); end if; - Location_Copy (Proc, El); - Set_Parent (Proc, Get_Parent (El)); - Set_Process_Origin (Proc, El); + Location_Copy (Proc, Conc_Stmt); + Set_Parent (Proc, Get_Parent (Conc_Stmt)); + Set_Process_Origin (Proc, Conc_Stmt); + Set_Procedure_Call (Conc_Stmt, Null_Iir); -- LRM93 9.3 -- The equivalent process statement has a label if and only if the -- concurrent procedure call statement has a label; if the equivalent -- process statement has a label, it is the same as that of the -- concurrent procedure call statement. - Set_Label (Proc, Get_Label (El)); + Set_Label (Proc, Get_Label (Conc_Stmt)); -- LRM93 9.3 -- The equivalent process statement is a postponed process if and only -- if the concurrent procedure call statement includes the reserved -- word POSTPONED. - Set_Postponed_Flag (Proc, Get_Postponed_Flag (El)); + Set_Postponed_Flag (Proc, Get_Postponed_Flag (Conc_Stmt)); Call_Stmt := Create_Iir (Iir_Kind_Procedure_Call_Statement); Set_Sequential_Statement_Chain (Proc, Call_Stmt); - Location_Copy (Call_Stmt, El); + Location_Copy (Call_Stmt, Conc_Stmt); Set_Parent (Call_Stmt, Proc); Set_Procedure_Call (Call_Stmt, Call); Assoc_Chain := Canon_Association_Chain_And_Actuals @@ -1418,21 +1422,26 @@ package body Canon is Canon_Extract_Sensitivity_Procedure_Call (Sensitivity_List, Call); if Is_Sensitized then Set_Sensitivity_List (Proc, Sensitivity_List); + Set_Is_Ref (Proc, True); else Wait_Stmt := Create_Iir (Iir_Kind_Wait_Statement); - Location_Copy (Wait_Stmt, El); + Location_Copy (Wait_Stmt, Conc_Stmt); Set_Parent (Wait_Stmt, Proc); Set_Sensitivity_List (Wait_Stmt, Sensitivity_List); + Set_Is_Ref (Wait_Stmt, True); Set_Chain (Call_Stmt, Wait_Stmt); end if; return Proc; end Canon_Concurrent_Procedure_Call; -- Return a statement from a waveform. - function Canon_Wave_Transform - (Orig_Stmt : Iir; Waveform_Chain : Iir_Waveform_Element; Proc : Iir) - return Iir + function Canon_Wave_Transform (Orig_Stmt : Iir; + Waveform_Chain : Iir_Waveform_Element; + Proc : Iir; + Is_First : Boolean) + return Iir is + Target : Iir; Stmt : Iir; Sensitivity_List : Iir_List; begin @@ -1456,7 +1465,11 @@ package body Canon is -- target <= [ delay_mechanism ] waveform_element1, -- waveform_element2, ..., waveform_elementN; Stmt := Create_Iir (Iir_Kind_Simple_Signal_Assignment_Statement); - Set_Target (Stmt, Get_Target (Orig_Stmt)); + Target := Get_Target (Orig_Stmt); + if not Is_First then + Target := Build_Reference_Decl (Target, Orig_Stmt); + end if; + Set_Target (Stmt, Target); if Proc = Null_Iir then Sensitivity_List := Null_Iir_List; else @@ -1467,6 +1480,7 @@ package body Canon is Set_Delay_Mechanism (Stmt, Get_Delay_Mechanism (Orig_Stmt)); Set_Reject_Time_Expression (Stmt, Get_Reject_Time_Expression (Orig_Stmt)); + Set_Reject_Time_Expression (Orig_Stmt, Null_Iir); end if; Location_Copy (Stmt, Orig_Stmt); return Stmt; @@ -1479,7 +1493,9 @@ package body Canon is Stmt : Iir; begin Stmt := Canon_Wave_Transform - (Conc_Stmt, Get_Waveform_Chain (Conc_Stmt), Proc); + (Conc_Stmt, Get_Waveform_Chain (Conc_Stmt), Proc, True); + Set_Waveform_Chain (Conc_Stmt, Null_Iir); + Set_Target (Conc_Stmt, Null_Iir); Set_Parent (Stmt, Parent); Set_Sequential_Statement_Chain (Parent, Stmt); end Canon_Concurrent_Simple_Signal_Assignment; @@ -1506,7 +1522,8 @@ package body Canon is -- Canon waveform. Wf := Get_Waveform_Chain (Cond_Wf); - Wf := Canon_Wave_Transform (Conc_Stmt, Wf, Proc); + Wf := Canon_Wave_Transform + (Conc_Stmt, Wf, Proc, Cond_Wf = Cond_Wf_Chain); if Expr = Null_Iir and Cond_Wf = Cond_Wf_Chain then -- A conditional assignment that is in fact a simple one. Usual @@ -1543,8 +1560,14 @@ package body Canon is Set_Parent (Wf, Stmt); Last_Res := Res1; end if; + + Set_Condition (Cond_Wf, Null_Iir); + Set_Waveform_Chain (Cond_Wf, Null_Iir); + Cond_Wf := Get_Chain (Cond_Wf); end loop; + + Set_Target (Conc_Stmt, Null_Iir); return Stmt; end Canon_Conditional_Signal_Assignment; @@ -1563,18 +1586,21 @@ package body Canon is is Sensitivity_List : constant Iir_List := Get_Sensitivity_List (Proc); Expr : constant Iir := Get_Expression (Conc_Stmt); + Selected_Waveform_Chain : constant Iir := + Get_Selected_Waveform_Chain (Conc_Stmt); + Target : constant Iir := Get_Target (Conc_Stmt); + Reject_Time : constant Iir := Get_Reject_Time_Expression (Conc_Stmt); Selected_Waveform : Iir; Case_Stmt: Iir_Case_Statement; Stmt : Iir; Waveform : Iir; begin - Selected_Waveform := Get_Selected_Waveform_Chain (Conc_Stmt); if Canon_Flag_Expressions then Canon_Expression (Expr); end if; Canon_Extract_Sensitivity (Expr, Sensitivity_List, False); - if False then + if Vhdl_Std < Vhdl_08 then Case_Stmt := Create_Iir (Iir_Kind_Case_Statement); Set_Parent (Case_Stmt, Parent); Set_Sequential_Statement_Chain (Parent, Case_Stmt); @@ -1582,11 +1608,17 @@ package body Canon is Set_Expression (Case_Stmt, Expr); - Set_Case_Statement_Alternative_Chain (Case_Stmt, Selected_Waveform); + Set_Case_Statement_Alternative_Chain + (Case_Stmt, Selected_Waveform_Chain); + + Selected_Waveform := Selected_Waveform_Chain; while Selected_Waveform /= Null_Iir loop + Set_Parent (Selected_Waveform, Case_Stmt); Waveform := Get_Associated_Chain (Selected_Waveform); if Waveform /= Null_Iir then - Stmt := Canon_Wave_Transform (Conc_Stmt, Waveform, Proc); + Stmt := Canon_Wave_Transform + (Conc_Stmt, Waveform, Proc, + Selected_Waveform = Selected_Waveform_Chain); Set_Parent (Stmt, Case_Stmt); Set_Associated_Chain (Selected_Waveform, Stmt); end if; @@ -1599,25 +1631,29 @@ package body Canon is Location_Copy (Stmt, Conc_Stmt); Set_Expression (Stmt, Expr); - Set_Expression (Conc_Stmt, Null_Iir); - Set_Target (Stmt, Get_Target (Conc_Stmt)); - Set_Target (Conc_Stmt, Null_Iir); + Set_Target (Stmt, Target); Set_Delay_Mechanism (Stmt, Get_Delay_Mechanism (Conc_Stmt)); - Set_Reject_Time_Expression - (Stmt, Get_Reject_Time_Expression (Conc_Stmt)); - Set_Reject_Time_Expression (Conc_Stmt, Null_Iir); + Set_Reject_Time_Expression (Stmt, Reject_Time); - Set_Selected_Waveform_Chain (Stmt, Selected_Waveform); - Set_Selected_Waveform_Chain (Conc_Stmt, Selected_Waveform); + Set_Selected_Waveform_Chain (Stmt, Selected_Waveform_Chain); + Set_Selected_Waveform_Chain (Conc_Stmt, Null_Iir); + Selected_Waveform := Selected_Waveform_Chain; while Selected_Waveform /= Null_Iir loop Waveform := Get_Associated_Chain (Selected_Waveform); + Set_Parent (Selected_Waveform, Stmt); if Waveform /= Null_Iir then Canon_Waveform (Waveform, Sensitivity_List); end if; Selected_Waveform := Get_Chain (Selected_Waveform); end loop; end if; + + -- Transfer ownership. + Set_Expression (Conc_Stmt, Null_Iir); + Set_Target (Conc_Stmt, Null_Iir); + Set_Selected_Waveform_Chain (Conc_Stmt, Null_Iir); + Set_Reject_Time_Expression (Conc_Stmt, Null_Iir); end Canon_Concurrent_Selected_Signal_Assignment; procedure Canon_Generate_Statement_Body @@ -1799,27 +1835,30 @@ package body Canon is Location_Copy (Stmt, El); Sensitivity_List := Create_Iir_List; Set_Sensitivity_List (Proc, Sensitivity_List); + Set_Is_Ref (Proc, True); -- Expand the expression, fill the sensitivity list, - Canon_Extract_Sensitivity - (Get_Assertion_Condition (El), Sensitivity_List, False); + Expr := Get_Assertion_Condition (El); + Canon_Extract_Sensitivity (Expr, Sensitivity_List, False); if Canon_Flag_Expressions then - Canon_Expression (Get_Assertion_Condition (El)); + Canon_Expression (Expr); end if; - Set_Assertion_Condition - (Stmt, Get_Assertion_Condition (El)); + Set_Assertion_Condition (Stmt, Expr); + Set_Assertion_Condition (El, Null_Iir); Expr := Get_Report_Expression (El); if Canon_Flag_Expressions and Expr /= Null_Iir then Canon_Expression (Expr); end if; Set_Report_Expression (Stmt, Expr); + Set_Report_Expression (El, Null_Iir); Expr := Get_Severity_Expression (El); if Canon_Flag_Expressions and Expr /= Null_Iir then Canon_Expression (Expr); end if; Set_Severity_Expression (Stmt, Expr); + Set_Severity_Expression (El, Null_Iir); Replace_Stmt (Proc); El := Proc; @@ -2128,11 +2167,9 @@ package body Canon is -- Add a default binding indication -- Extract a component instantiation Instances := Get_Instantiation_List (Cfg); - if Instances = Iir_List_All or Instances = Iir_List_Others then - -- designator_all and designator_others must have been replaced - -- by a list during canon. - raise Internal_Error; - end if; + -- Designator_all and designator_others must have been replaced + -- by a list during canon. + pragma Assert (Instances not in Iir_Lists_All_Others); Bind := Get_Default_Binding_Indication (Get_Named_Entity (Get_First_Element (Instances))); if Bind = Null_Iir then @@ -2140,6 +2177,7 @@ package body Canon is return; end if; Set_Binding_Indication (Cfg, Bind); + Set_Is_Ref (Cfg, True); Add_Binding_Indication_Dependence (Top, Bind); return; else @@ -2153,6 +2191,7 @@ package body Canon is Entity := Get_Entity_From_Entity_Aspect (Entity_Aspect); Comp := Get_Named_Entity (Get_Component_Name (Cfg)); + -- Canon generic map Map_Chain := Get_Generic_Map_Aspect_Chain (Bind); if Map_Chain = Null_Iir then if Is_Config and then Is_Valid (Entity) then @@ -2165,6 +2204,7 @@ package body Canon is end if; Set_Generic_Map_Aspect_Chain (Bind, Map_Chain); + -- Canon port map Map_Chain := Get_Port_Map_Aspect_Chain (Bind); if Map_Chain = Null_Iir then if Is_Config and then Is_Valid (Entity) then @@ -2177,7 +2217,7 @@ package body Canon is end if; Set_Port_Map_Aspect_Chain (Bind, Map_Chain); - if Get_Kind (Cfg) = Iir_Kind_Component_Configuration then + if Is_Config then Block := Get_Block_Configuration (Cfg); if Block /= Null_Iir then -- If there is no architecture_identifier in the binding, @@ -2189,7 +2229,9 @@ package body Canon is pragma Assert (Get_Kind (Entity) = Iir_Kind_Entity_Declaration); Set_Architecture - (Entity_Aspect, Get_Block_Specification (Block)); + (Entity_Aspect, + Build_Reference_Name + (Get_Block_Specification (Block))); end if; Canon_Block_Configuration (Top, Block); end if; @@ -2220,7 +2262,7 @@ package body Canon is loop El := Create_Iir (Get_Kind (Assoc)); Location_Copy (El, Assoc); - Set_Formal (El, Get_Formal (Assoc)); + Set_Formal (El, Sem_Inst.Copy_Tree (Get_Formal (Assoc))); Set_Whole_Association_Flag (El, Get_Whole_Association_Flag (Assoc)); @@ -2228,16 +2270,16 @@ package body Canon is when Iir_Kind_Association_Element_Open => null; when Iir_Kind_Association_Element_By_Expression => - Set_Actual (El, Get_Actual (Assoc)); - Set_In_Conversion (El, Get_In_Conversion (Assoc)); - Set_Out_Conversion (El, Get_Out_Conversion (Assoc)); + Set_Actual (El, Sem_Inst.Copy_Tree (Get_Actual (Assoc))); + Set_In_Conversion + (El, Sem_Inst.Copy_Tree (Get_In_Conversion (Assoc))); + Set_Out_Conversion + (El, Sem_Inst.Copy_Tree (Get_Out_Conversion (Assoc))); Set_Collapse_Signal_Flag (Assoc, Sem.Can_Collapse_Signals (Assoc, Get_Formal (Assoc))); when Iir_Kind_Association_Element_By_Individual => Set_Actual_Type (El, Get_Actual_Type (Assoc)); - Set_Individual_Association_Chain - (El, Get_Individual_Association_Chain (Assoc)); when others => Error_Kind ("copy_association", Assoc); end case; @@ -2267,10 +2309,6 @@ package body Canon is S_El : Iir; S_Inter : Iir; begin - if Sec_Chain = Null_Iir then - -- Short-cut. - return First_Chain; - end if; F_El := First_Chain; F_Inter := Inter_Chain; Sub_Chain_Init (First, Last); @@ -2297,13 +2335,14 @@ package body Canon is return First; end Merge_Association_Chain; + Comp_Name : constant Iir := Get_Component_Name (Conf_Spec); + Comp : constant Iir := Get_Named_Entity (Comp_Name); + Cs_Binding : constant Iir := Get_Binding_Indication (Conf_Spec); + Cc_Binding : constant Iir := Get_Binding_Indication (Comp_Conf); Res : Iir_Component_Configuration; - Cs_Binding : Iir_Binding_Indication; - Cc_Binding : Iir_Binding_Indication; Cs_Chain : Iir; Res_Binding : Iir_Binding_Indication; Entity : Iir; - Comp : Iir; Instance_List : Iir_List; Conf_Instance_List : Iir_List; Instance : Iir; @@ -2314,32 +2353,13 @@ package body Canon is Res := Create_Iir (Iir_Kind_Component_Configuration); Location_Copy (Res, Comp_Conf); Set_Parent (Res, Parent); - Set_Component_Name (Res, Get_Component_Name (Conf_Spec)); - --- -- Keep in the designator list only the non-incrementally --- -- bound instances. --- Inst_List := Get_Instantiation_List (Comp_Conf); --- Designator_List := Create_Iir_List; --- for I in 0 .. Get_Nbr_Elements (Inst_List) - 1 loop --- Inst := Get_Nth_Element (Inst_List, I); --- if Get_Component_Configuration (Inst) = Comp_Conf then --- Set_Component_Configuration (Inst, Res); --- Append_Element (Designator_List, Inst); --- end if; --- end loop; --- Set_Instantiation_List (Res, Designator_List); --- Set_Binding_Indication --- (Res, Get_Binding_Indication (Comp_Conf)); --- Append (Last_Item, Conf, Comp_Conf); + Set_Component_Name (Res, Build_Reference_Name (Comp_Name)); - Cs_Binding := Get_Binding_Indication (Conf_Spec); - Cc_Binding := Get_Binding_Indication (Comp_Conf); Res_Binding := Create_Iir (Iir_Kind_Binding_Indication); Location_Copy (Res_Binding, Res); Set_Binding_Indication (Res, Res_Binding); Entity := Get_Entity_From_Entity_Aspect (Get_Entity_Aspect (Cs_Binding)); - Comp := Get_Named_Entity (Get_Component_Name (Conf_Spec)); -- Merge generic map aspect. Cs_Chain := Get_Generic_Map_Aspect_Chain (Cs_Binding); @@ -2353,7 +2373,7 @@ package body Canon is Cs_Chain, Get_Generic_Map_Aspect_Chain (Cc_Binding))); - -- merge port map aspect + -- Merge port map aspect. Cs_Chain := Get_Port_Map_Aspect_Chain (Cs_Binding); if Cs_Chain = Null_Iir then Cs_Chain := Sem_Specs.Create_Default_Map_Aspect @@ -2365,10 +2385,11 @@ package body Canon is Cs_Chain, Get_Port_Map_Aspect_Chain (Cc_Binding))); - -- set entity aspect - Set_Entity_Aspect (Res_Binding, Get_Entity_Aspect (Cs_Binding)); + -- Set entity aspect. + Set_Entity_Aspect + (Res_Binding, Sem_Inst.Copy_Tree (Get_Entity_Aspect (Cs_Binding))); - -- create list of instances: + -- Create list of instances: -- * keep common instances -- replace component_configuration of them -- remove them in the instance list of COMP_CONF @@ -2400,6 +2421,7 @@ package body Canon is is El : Iir; Comp_Conf : Iir; + Inst : Iir; begin El := Get_Concurrent_Statement_Chain (Parent); while El /= Null_Iir loop @@ -2411,7 +2433,9 @@ package body Canon is Comp_Conf := Get_Component_Configuration (El); if Comp_Conf = Null_Iir then -- The component is not yet configured. - Append_Element (List, Build_Simple_Name (El, El)); + Inst := Build_Simple_Name (El, El); + Set_Is_Forward_Ref (Inst, True); + Append_Element (List, Inst); Set_Component_Configuration (El, Conf); else -- The component is already configured. @@ -2422,15 +2446,9 @@ package body Canon is -- FIXME: handle incremental configuration. raise Internal_Error; end if; - if Spec = Iir_List_All then - -- Several component configuration for an instance. - -- Must have been caught by sem. - raise Internal_Error; - elsif Spec = Iir_List_Others then - null; - else - raise Internal_Error; - end if; + -- Several component configuration for an instance. + -- Must have been caught by sem. + pragma Assert (Spec = Iir_List_Others); end if; end if; El := Get_Chain (El); @@ -2467,7 +2485,7 @@ package body Canon is Spec : constant Iir_List := Get_Instantiation_List (Conf); List : Iir_Designator_List; begin - if Spec = Iir_List_All or Spec = Iir_List_Others then + if Spec in Iir_Lists_All_Others then List := Create_Iir_List; Canon_Component_Specification_All_Others (Conf, Parent, Spec, List, @@ -2500,12 +2518,14 @@ package body Canon is elsif Signal_List = Iir_List_Others then Force := False; else + -- User list: nothing to do. return; end if; Dis_Type := Get_Type (Get_Type_Mark (Dis)); N_List := Create_Iir_List; Set_Signal_List (Dis, N_List); + Set_Is_Ref (Dis, True); El := Get_Declaration_Chain (Decl_Parent); while El /= Null_Iir loop if Get_Kind (El) = Iir_Kind_Signal_Declaration @@ -2832,7 +2852,7 @@ package body Canon is El := Get_Declaration_Chain (Blk); while El /= Null_Iir loop if Get_Kind (El) = Iir_Kind_Configuration_Specification then - -- Already canoncalized during canon of block declarations. + -- Already canonicalized during canon of block declarations. -- But need to set configuration on instantiations. Canon_Component_Specification (El, Blk); end if; @@ -2899,7 +2919,9 @@ package body Canon is Res := Create_Iir (Iir_Kind_Component_Configuration); Location_Copy (Res, El); Set_Parent (Res, Conf); - Set_Component_Name (Res, Get_Instantiated_Unit (El)); + Set_Component_Name + (Res, + Build_Reference_Name (Get_Instantiated_Unit (El))); Designator_List := Create_Iir_List; Append_Element (Designator_List, Build_Simple_Name (El, El)); @@ -2913,7 +2935,9 @@ package body Canon is Res := Create_Iir (Iir_Kind_Component_Configuration); Location_Copy (Res, Comp_Conf); Set_Parent (Res, Conf); - Set_Component_Name (Res, Get_Component_Name (Comp_Conf)); + Set_Component_Name + (Res, + Build_Reference_Name (Get_Component_Name (Comp_Conf))); -- Keep in the designator list only the non-incrementally -- bound instances, and only the instances in the current -- statements parts (vhdl-87 generate issue). @@ -2926,12 +2950,14 @@ package body Canon is and then Get_Parent (Inst) = Blk then Set_Component_Configuration (Inst, Res); - Append_Element (Designator_List, Inst_Name); + Append_Element (Designator_List, + Build_Reference_Name (Inst_Name)); end if; end loop; Set_Instantiation_List (Res, Designator_List); Set_Binding_Indication (Res, Get_Binding_Indication (Comp_Conf)); + Set_Is_Ref (Res, True); Append (Last_Item, Conf, Res); end if; end; diff --git a/src/vhdl/configuration.adb b/src/vhdl/configuration.adb index 78e51d034..2c0e2dd38 100644 --- a/src/vhdl/configuration.adb +++ b/src/vhdl/configuration.adb @@ -281,6 +281,7 @@ package body Configuration is use Libraries; Entity : Iir; + Arch_Name : Iir; Arch : Iir; Config : Iir; Arch_Lib : Iir; @@ -298,23 +299,23 @@ package body Configuration is Add_Design_Unit (Entity, Aspect); -- Extract and add the architecture. - Arch := Get_Architecture (Aspect); - if Arch /= Null_Iir then - case Get_Kind (Arch) is + Arch_Name := Get_Architecture (Aspect); + if Arch_Name /= Null_Iir then + case Get_Kind (Arch_Name) is when Iir_Kind_Simple_Name => - Id := Get_Identifier (Arch); + Id := Get_Identifier (Arch_Name); Arch := Load_Secondary_Unit (Entity, Id, Aspect); if Arch = Null_Iir then Error_Msg_Elab ("cannot find architecture %i of %n", (+Id, +Entity_Lib)); return; else - Set_Architecture (Aspect, Get_Library_Unit (Arch)); + Set_Named_Entity (Arch_Name, Get_Library_Unit (Arch)); end if; - when Iir_Kind_Architecture_Body => - Arch := Get_Design_Unit (Arch); + when Iir_Kind_Reference_Name => + Arch := Get_Design_Unit (Get_Named_Entity (Arch_Name)); when others => - Error_Kind ("add_design_aspect", Arch); + Error_Kind ("add_design_aspect", Arch_Name); end case; else Arch := Get_Latest_Architecture (Entity_Lib); diff --git a/src/vhdl/disp_tree.adb b/src/vhdl/disp_tree.adb index 9aed6c3f9..ecfc93ba4 100644 --- a/src/vhdl/disp_tree.adb +++ b/src/vhdl/disp_tree.adb @@ -443,15 +443,24 @@ package body Disp_Tree is when Attr_Chain_Next => Disp_Iir_Number (Get_Iir (N, F)); New_Line; - when Attr_Of_Ref => + when Attr_Of_Ref | Attr_Of_Maybe_Ref => raise Internal_Error; end case; when Type_Iir_List => - if Get_Field_Attribute (F) = Attr_Of_Ref then - Ndepth := 0; - else - Ndepth := Depth - 1; - end if; + case Get_Field_Attribute (F) is + when Attr_None => + Ndepth := Depth - 1; + when Attr_Of_Ref => + Ndepth := 0; + when Attr_Of_Maybe_Ref => + if Get_Is_Ref (N) then + Ndepth := 0; + else + Ndepth := Depth - 1; + end if; + when others => + raise Internal_Error; + end case; Disp_Iir_List (Get_Iir_List (N, F), Sub_Indent, Ndepth); when Type_PSL_NFA => Disp_PSL_NFA (Get_PSL_NFA (N, F), Sub_Indent); diff --git a/src/vhdl/disp_vhdl.adb b/src/vhdl/disp_vhdl.adb index 211aeb9db..291214af6 100644 --- a/src/vhdl/disp_vhdl.adb +++ b/src/vhdl/disp_vhdl.adb @@ -289,6 +289,8 @@ package body Disp_Vhdl is when Iir_Kind_Range_Array_Attribute | Iir_Kind_Reverse_Range_Array_Attribute => Disp_Range (Name); + when Iir_Kind_Reference_Name => + Disp_Name (Get_Referenced_Name (Name)); when others => Error_Kind ("disp_name", Name); end case; @@ -1533,7 +1535,7 @@ package body Disp_Vhdl is if I /= Natural'First then Put (", "); end if; - Disp_Name_Of (El); + Disp_Name (El); end loop; end if; end Disp_Instantiation_List; @@ -2721,6 +2723,16 @@ package body Disp_Vhdl is | Iir_Kind_Iterator_Declaration => Disp_Name_Of (Expr); return; + when Iir_Kind_Reference_Name => + declare + Name : constant Iir := Get_Referenced_Name (Expr); + begin + if Is_Valid (Name) then + Disp_Name (Name); + else + Disp_Expression (Get_Named_Entity (Expr)); + end if; + end; when Iir_Kinds_Dyadic_Operator => Disp_Dyadic_Operator (Expr); @@ -3290,7 +3302,7 @@ package body Disp_Vhdl is Put ("for "); Disp_Instantiation_List (Get_Instantiation_List (Conf)); Put (" : "); - Disp_Name_Of (Get_Component_Name (Conf)); + Disp_Name (Get_Component_Name (Conf)); New_Line; Binding := Get_Binding_Indication (Conf); if Binding /= Null_Iir then diff --git a/src/vhdl/iirs.adb b/src/vhdl/iirs.adb index b14e6175a..a5a12a742 100644 --- a/src/vhdl/iirs.adb +++ b/src/vhdl/iirs.adb @@ -1428,7 +1428,7 @@ package body Iirs is pragma Assert (Target /= Null_Iir); pragma Assert (Has_Open_Flag (Get_Kind (Target)), "no field Open_Flag"); - return Get_Flag15 (Target); + return Get_Flag7 (Target); end Get_Open_Flag; procedure Set_Open_Flag (Target : Iir; Flag : Boolean) is @@ -1436,7 +1436,7 @@ package body Iirs is pragma Assert (Target /= Null_Iir); pragma Assert (Has_Open_Flag (Get_Kind (Target)), "no field Open_Flag"); - Set_Flag15 (Target, Flag); + Set_Flag7 (Target, Flag); end Set_Open_Flag; function Get_After_Drivers_Flag (Target : Iir) return Boolean is @@ -2050,9 +2050,9 @@ package body Iirs is end Set_Nature; type Iir_Mode_Conv is record - Flag12: Boolean; Flag13: Boolean; Flag14: Boolean; + Flag15: Boolean; end record; pragma Pack (Iir_Mode_Conv); pragma Assert (Iir_Mode_Conv'Size = Iir_Mode'Size); @@ -2066,9 +2066,9 @@ package body Iirs is pragma Assert (Target /= Null_Iir); pragma Assert (Has_Mode (Get_Kind (Target)), "no field Mode"); - Conv.Flag12 := Get_Flag12 (Target); Conv.Flag13 := Get_Flag13 (Target); Conv.Flag14 := Get_Flag14 (Target); + Conv.Flag15 := Get_Flag15 (Target); return To_Iir_Mode (Conv); end Get_Mode; @@ -2082,9 +2082,9 @@ package body Iirs is pragma Assert (Has_Mode (Get_Kind (Target)), "no field Mode"); Conv := To_Iir_Mode_Conv (Mode); - Set_Flag12 (Target, Conv.Flag12); Set_Flag13 (Target, Conv.Flag13); Set_Flag14 (Target, Conv.Flag14); + Set_Flag15 (Target, Conv.Flag15); end Set_Mode; function Get_Guarded_Signal_Flag (Target : Iir) return Boolean is @@ -5614,7 +5614,7 @@ package body Iirs is pragma Assert (N /= Null_Iir); pragma Assert (Has_Is_Ref (Get_Kind (N)), "no field Is_Ref"); - return Get_Flag7 (N); + return Get_Flag12 (N); end Get_Is_Ref; procedure Set_Is_Ref (N : Iir; Ref : Boolean) is @@ -5622,7 +5622,7 @@ package body Iirs is pragma Assert (N /= Null_Iir); pragma Assert (Has_Is_Ref (Get_Kind (N)), "no field Is_Ref"); - Set_Flag7 (N, Ref); + Set_Flag12 (N, Ref); end Set_Is_Ref; function Get_Is_Forward_Ref (N : Iir) return Boolean is diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads index 3c33aeecc..4e0cbfd57 100644 --- a/src/vhdl/iirs.ads +++ b/src/vhdl/iirs.ads @@ -639,6 +639,8 @@ package Iirs is -- Get/Set_Binding_Indication (Field3) -- -- Get/Set_Chain (Field2) + -- + -- Get/Set_Is_Ref (Flag12) -- Iir_Kind_Disconnection_Specification (Short) -- @@ -658,13 +660,15 @@ package Iirs is -- The declaration containing this type declaration. -- Get/Set_Parent (Field0) -- - -- Get/Set_Chain (Field2) - -- -- Get/Set_Signal_List (Field3) -- -- Get/Set_Type_Mark (Field4) -- -- Get/Set_Expression (Field5) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Is_Ref (Flag12) -- Iir_Kind_Block_Header (Medium) -- @@ -1216,7 +1220,7 @@ package Iirs is -- present for uniformity (and speed). -- Get/Set_Type (Field1) -- - -- Get/Set_Mode (Flag12,Flag13,Flag14) + -- Get/Set_Mode (Flag13,Flag14,Flag15) -- -- Only for Iir_Kind_Interface_Signal_Declaration: -- Get/Set_Has_Disconnect_Flag (Flag1) @@ -1232,8 +1236,6 @@ package Iirs is -- -- Get/Set_Use_Flag (Flag6) -- - -- Get/Set_Is_Ref (Flag7) - -- -- Only for Iir_Kind_Interface_Signal_Declaration: -- Get/Set_Guarded_Signal_Flag (Flag8) -- @@ -1244,8 +1246,10 @@ package Iirs is -- -- Get/Set_Has_Class (Flag11) -- + -- Get/Set_Is_Ref (Flag12) + -- -- Only for Iir_Kind_Interface_Signal_Declaration: - -- Get/Set_Open_Flag (Flag15) + -- Get/Set_Open_Flag (Flag7) -- -- Get/Set_Expr_Staticness (State1) -- @@ -1269,7 +1273,7 @@ package Iirs is -- -- Get/Set_Use_Flag (Flag6) -- - -- Get/Set_Is_Ref (Flag7) + -- Get/Set_Is_Ref (Flag12) -- -- Get/Set_Name_Staticness (State2) @@ -1543,12 +1547,12 @@ package Iirs is -- -- Get/Set_Use_Flag (Flag6) -- - -- Get/Set_Is_Ref (Flag7) - -- -- Get/Set_Guarded_Signal_Flag (Flag8) -- -- Get/Set_Signal_Kind (Flag9) -- + -- Get/Set_Is_Ref (Flag12) + -- -- Get/Set_Expr_Staticness (State1) -- -- Get/Set_Name_Staticness (State2) @@ -1641,7 +1645,7 @@ package Iirs is -- Get/Set_Use_Flag (Flag6) -- -- Only for Iir_Kind_Constant_Declaration: - -- Get/Set_Is_Ref (Flag7) + -- Get/Set_Is_Ref (Flag12) -- -- Get/Set_Expr_Staticness (State1) -- @@ -1670,7 +1674,7 @@ package Iirs is -- -- Get/Set_Use_Flag (Flag6) -- - -- Get/Set_Is_Ref (Flag7) + -- Get/Set_Is_Ref (Flag12) -- -- Get/Set_Expr_Staticness (State1) -- @@ -1709,7 +1713,7 @@ package Iirs is -- Get/Set_File_Open_Kind (Field7) -- -- This is used only in vhdl 87. - -- Get/Set_Mode (Flag12,Flag13,Flag14) + -- Get/Set_Mode (Flag13,Flag14,Flag15) -- -- Get/Set_Has_Identifier_List (Flag3) -- @@ -2033,7 +2037,7 @@ package Iirs is -- -- Get/Set_Only_Characters_Flag (Flag4) -- - -- Get/Set_Is_Ref (Flag7) + -- Get/Set_Is_Ref (Flag12) -- -- Get/Set_Type_Staticness (State1) @@ -2091,11 +2095,11 @@ package Iirs is -- -- Get/Set_Type_Staticness (State1) -- - -- Get/Set_Is_Ref (Flag7) - -- -- Get/Set_End_Has_Reserved_Id (Flag8) -- -- Get/Set_End_Has_Identifier (Flag9) + -- + -- Get/Set_Is_Ref (Flag12) -- Iir_Kind_Unit_Declaration (Short) -- @@ -2159,7 +2163,7 @@ package Iirs is -- -- Get/Set_Has_Signal_Flag (Flag3) -- - -- Get/Set_Is_Ref (Flag7) + -- Get/Set_Is_Ref (Flag12) -- Iir_Kind_Array_Type_Definition (Medium) -- @@ -2460,7 +2464,7 @@ package Iirs is -- -- Get/Set_Has_Signal_Flag (Flag3) -- - -- Get/Set_Is_Ref (Flag7) + -- Get/Set_Is_Ref (Flag12) -- -- Get/Set_Type_Staticness (State1) @@ -2484,7 +2488,7 @@ package Iirs is -- -- Get/Set_Has_Signal_Flag (Flag3) -- - -- Get/Set_Is_Ref (Flag7) + -- Get/Set_Is_Ref (Flag12) -- -- Get/Set_Type_Staticness (State1) @@ -2637,7 +2641,7 @@ package Iirs is -- -- Get/Set_Tolerance (Field7) -- - -- Get/Set_Is_Ref (Flag7) + -- Get/Set_Is_Ref (Flag12) ------------------------- -- Nature definitions -- @@ -2754,6 +2758,9 @@ package Iirs is -- -- Only for Iir_Kind_Process_Statement: -- Get/Set_Suspend_Flag (Flag11) + -- + -- Only for Iir_Kind_Sensitized_Process_Statement: + -- Get/Set_Is_Ref (Flag12) -- Iir_Kind_Concurrent_Assertion_Statement (Short) -- @@ -3051,23 +3058,23 @@ package Iirs is -- -- Get/Set_Parent (Field0) -- - -- May be NULL only for an iir_kind_elsif node, and then means the else - -- clause. - -- Get/Set_Condition (Field1) - -- - -- Only for Iir_Kind_If_Statement: - -- Get/Set_Chain (Field2) - -- -- Only for Iir_Kind_If_Statement: -- Get/Set_Label (Field3) -- -- Only for Iir_Kind_If_Statement: -- Get/Set_Identifier (Alias Field3) -- + -- May be NULL only for an iir_kind_elsif node, and then means the else + -- clause. + -- Get/Set_Condition (Field1) + -- + -- Get/Set_Sequential_Statement_Chain (Field5) + -- -- Must be an Iir_kind_elsif node, or NULL for no more elsif clauses. -- Get/Set_Else_Clause (Field4) -- - -- Get/Set_Sequential_Statement_Chain (Field5) + -- Only for Iir_Kind_If_Statement: + -- Get/Set_Chain (Field2) -- -- Only for Iir_Kind_If_Statement: -- Get/Set_Visible_Flag (Flag4) @@ -3275,6 +3282,8 @@ package Iirs is -- Get/Set_Sensitivity_List (Field6) -- -- Get/Set_Visible_Flag (Flag4) + -- + -- Get/Set_Is_Ref (Flag12) -- Iir_Kind_Return_Statement (Short) -- @@ -3586,6 +3595,8 @@ package Iirs is -- -- Get/Set_Named_Entity (Field4) -- + -- The name from which the reference was created. Can be Null_Iir if the + -- reference was created directly from a declaration. -- Get/Set_Referenced_Name (Field2) -- -- Get/Set_Is_Forward_Ref (Flag1) @@ -5616,8 +5627,9 @@ package Iirs is function Get_Last_Design_Unit (Design : Iir) return Iir; procedure Set_Last_Design_Unit (Design : Iir; Chain : Iir); - -- Library declaration of a library clause. - -- Field: Field1 Ref + -- Library declaration of a library clause. This is Forward_Ref as the + -- dependency of the unit on the library is not tracked. + -- Field: Field1 Forward_Ref function Get_Library_Declaration (Design : Iir) return Iir; procedure Set_Library_Declaration (Design : Iir; Library : Iir); @@ -5836,7 +5848,7 @@ package Iirs is function Get_Attribute_Specification (Val : Iir) return Iir; procedure Set_Attribute_Specification (Val : Iir; Attr : Iir); - -- Field: Field3 (uc) + -- Field: Field3 Of_Maybe_Ref (uc) function Get_Signal_List (Target : Iir) return Iir_List; procedure Set_Signal_List (Target : Iir; List : Iir_List); @@ -5881,7 +5893,7 @@ package Iirs is -- This flag is set for a very short time during the check that no in -- port is unconnected. - -- Field: Flag15 + -- Field: Flag7 function Get_Open_Flag (Target : Iir) return Boolean; procedure Set_Open_Flag (Target : Iir; Flag : Boolean); @@ -6076,7 +6088,7 @@ package Iirs is procedure Set_Nature (Target : Iir; Nature : Iir); -- Mode of interfaces or file (v87). - -- Field: Flag12,Flag13,Flag14 (grp) + -- Field: Flag13,Flag14,Flag15 (grp) function Get_Mode (Target : Iir) return Iir_Mode; procedure Set_Mode (Target : Iir; Mode : Iir_Mode); @@ -6468,7 +6480,8 @@ package Iirs is function Get_Reject_Time_Expression (Target : Iir) return Iir; procedure Set_Reject_Time_Expression (Target : Iir; Expr : Iir); - -- Field: Field6 (uc) + -- The Is_Ref flag is set for extracted sensitivity lists. + -- Field: Field6 Of_Maybe_Ref (uc) function Get_Sensitivity_List (Wait : Iir) return Iir_List; procedure Set_Sensitivity_List (Wait : Iir; List : Iir_List); @@ -6703,7 +6716,7 @@ package Iirs is procedure Set_Guard_Decl (Target : Iir_Block_Statement; Decl : Iir); -- Sensitivity list for the implicit guard signal. - -- Field: Field4 (uc) + -- Field: Field4 Of_Ref (uc) function Get_Guard_Sensitivity_List (Guard : Iir) return Iir_List; procedure Set_Guard_Sensitivity_List (Guard : Iir; List : Iir_List); @@ -6795,7 +6808,7 @@ package Iirs is function Get_Default_Entity_Aspect (Target : Iir) return Iir; procedure Set_Default_Entity_Aspect (Target : Iir; Aspect : Iir); - -- Field: Field3 + -- Field: Field3 Maybe_Ref function Get_Binding_Indication (Target : Iir) return Iir; procedure Set_Binding_Indication (Target : Iir; Binding : Iir); @@ -7204,7 +7217,7 @@ package Iirs is -- the first, while Has_Identifier_List is set to True on all items but -- the last. Furthermore Is_Ref appears in nodes where Has_Identifier_List -- is not present. - -- Field: Flag7 + -- Field: Flag12 function Get_Is_Ref (N : Iir) return Boolean; procedure Set_Is_Ref (N : Iir; Ref : Boolean); diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb index ee10ed704..5495e6057 100644 --- a/src/vhdl/iirs_utils.adb +++ b/src/vhdl/iirs_utils.adb @@ -865,6 +865,25 @@ package body Iirs_Utils is return Res; end Build_Reference_Name; + function Build_Reference_Decl (Decl : Iir; Loc : Iir) return Iir + is + Res : Iir; + begin + Res := Create_Iir (Iir_Kind_Reference_Name); + Location_Copy (Res, Loc); + Set_Named_Entity (Res, Decl); + return Res; + end Build_Reference_Decl; + + function Strip_Reference_Name (N : Iir) return Iir is + begin + if Get_Kind (N) = Iir_Kind_Reference_Name then + return Get_Named_Entity (N); + else + return N; + end if; + end Strip_Reference_Name; + function Has_Resolution_Function (Subtyp : Iir) return Iir is Ind : constant Iir := Get_Resolution_Indication (Subtyp); diff --git a/src/vhdl/iirs_utils.ads b/src/vhdl/iirs_utils.ads index 0bb46e370..3a1ddfc2c 100644 --- a/src/vhdl/iirs_utils.ads +++ b/src/vhdl/iirs_utils.ads @@ -184,6 +184,13 @@ package Iirs_Utils is -- Create a name that referenced the same named entity as NAME. function Build_Reference_Name (Name : Iir) return Iir; + -- Create a reference to a declaration (or aggregate). + function Build_Reference_Decl (Decl : Iir; Loc : Iir) return Iir; + + -- If N is a reference_name, return the corresponding node, otherwise + -- return N. + function Strip_Reference_Name (N : Iir) return Iir; + -- If SUBTYP has a resolution indication that is a function name, returns -- the function declaration (not the name). function Has_Resolution_Function (Subtyp : Iir) return Iir; diff --git a/src/vhdl/iirs_walk.adb b/src/vhdl/iirs_walk.adb index 17e35131f..80f825f68 100644 --- a/src/vhdl/iirs_walk.adb +++ b/src/vhdl/iirs_walk.adb @@ -16,6 +16,8 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. +with Iirs_Utils; use Iirs_Utils; + package body Iirs_Walk is function Walk_Chain (Chain : Iir; Cb : Walk_Cb) return Walk_Status is @@ -98,12 +100,13 @@ package body Iirs_Walk is function Walk_Assignment_Target (Target : Iir; Cb : Walk_Cb) return Walk_Status is + Targ : constant Iir := Strip_Reference_Name (Target); Chain : Iir; Status : Walk_Status := Walk_Continue; begin - case Get_Kind (Target) is + case Get_Kind (Targ) is when Iir_Kind_Aggregate => - Chain := Get_Association_Choices_Chain (Target); + Chain := Get_Association_Choices_Chain (Targ); while Chain /= Null_Iir loop Status := Walk_Assignment_Target (Get_Associated_Expr (Chain), Cb); @@ -111,7 +114,7 @@ package body Iirs_Walk is Chain := Get_Chain (Chain); end loop; when others => - Status := Cb.all (Target); + Status := Cb.all (Targ); end case; return Status; end Walk_Assignment_Target; diff --git a/src/vhdl/nodes_gc.adb b/src/vhdl/nodes_gc.adb index 99343222f..fde394e4e 100644 --- a/src/vhdl/nodes_gc.adb +++ b/src/vhdl/nodes_gc.adb @@ -38,6 +38,26 @@ package body Nodes_GC is procedure Free is new Ada.Unchecked_Deallocation (Marker_Array, Marker_Array_Acc); + procedure Report_Early_Reference (N : Iir; F : Nodes_Meta.Fields_Enum) + is + use Ada.Text_IO; + begin + Put ("early reference to "); + Put (Nodes_Meta.Get_Field_Image (F)); + Put (" in "); + Disp_Tree.Disp_Tree (N, True); + Has_Error := True; + end Report_Early_Reference; + + procedure Report_Already_Marked (N : Iir) + is + use Ada.Text_IO; + begin + Put ("Already marked "); + Disp_Tree.Disp_Tree (N, True); + Has_Error := True; + end Report_Already_Marked; + procedure Mark_Iir (N : Iir); procedure Mark_Iir_List (N : Iir_List) @@ -58,6 +78,26 @@ package body Nodes_GC is end case; end Mark_Iir_List; + procedure Mark_Iir_List_Ref (N : Iir_List; F : Fields_Enum) + is + El : Iir; + begin + case N is + when Null_Iir_List + | Iir_List_All + | Iir_List_Others => + null; + when others => + for I in Natural loop + El := Get_Nth_Element (N, I); + exit when El = Null_Iir; + if not Markers (El) then + Report_Early_Reference (El, F); + end if; + end loop; + end case; + end Mark_Iir_List_Ref; + procedure Mark_PSL_Node (N : PSL_Node) is begin null; @@ -68,15 +108,6 @@ package body Nodes_GC is null; end Mark_PSL_NFA; - procedure Report_Already_Marked (N : Iir) - is - use Ada.Text_IO; - begin - Put ("Already marked "); - Disp_Tree.Disp_Tree (N, True); - Has_Error := True; - end Report_Already_Marked; - procedure Already_Marked (N : Iir) is begin -- An unused node mustn't be referenced. @@ -101,17 +132,6 @@ package body Nodes_GC is Report_Already_Marked (N); end Already_Marked; - procedure Report_Early_Reference (N : Iir; F : Nodes_Meta.Fields_Enum) - is - use Ada.Text_IO; - begin - Put ("early reference to "); - Put (Nodes_Meta.Get_Field_Image (F)); - Put (" in "); - Disp_Tree.Disp_Tree (N, True); - Has_Error := True; - end Report_Early_Reference; - procedure Mark_Chain (Head : Iir) is El : Iir; @@ -129,36 +149,13 @@ package body Nodes_GC is Has_Error := True; end Report_Unreferenced_Node; - procedure Mark_Iir_Ref_Field (N : Iir; F : Fields_Enum) is + procedure Mark_Iir_Ref_Field (N : Iir; F : Fields_Enum) + is + Nf : constant Iir := Get_Iir (N, F); begin - case Get_Field_Type (F) is - when Type_Iir => - declare - Nf : constant Iir := Get_Iir (N, F); - begin - if Is_Valid (Nf) and then not Markers (Nf) then - Report_Early_Reference (N, F); - end if; - end; - when Type_Iir_List => - declare - Nl : constant Iir_List := Get_Iir_List (N, F); - El : Iir; - begin - if Is_Null_List (Nl) or else Nl in Iir_Lists_All_Others then - return; - end if; - for I in Natural loop - El := Get_Nth_Element (Nl, I); - exit when El = Null_Iir; - if not Markers (El) then - Report_Early_Reference (El, F); - end if; - end loop; - end; - when others => - raise Internal_Error; - end case; + if Is_Valid (Nf) and then not Markers (Nf) then + Report_Early_Reference (N, F); + end if; end Mark_Iir_Ref_Field; procedure Mark_Iir (N : Iir) is @@ -178,58 +175,79 @@ package body Nodes_GC is begin for I in Fields'Range loop F := Fields (I); - case Get_Field_Attribute (F) is - when Attr_Ref => - Mark_Iir_Ref_Field (N, F); - when Attr_Forward_Ref - | Attr_Chain_Next => - null; - when Attr_Maybe_Forward_Ref => - -- Only used for Named_Entity - pragma Assert (F = Field_Named_Entity); - - -- Overload_List has to be handled specially, as it that - -- case the Ref applies to the elements of the list. - declare - Nf : constant Iir := Get_Iir (N, F); - begin - if Nf /= Null_Iir then - if Get_Is_Forward_Ref (N) then - pragma Assert - (Get_Kind (Nf) /= Iir_Kind_Overload_List); - null; - else - if Get_Kind (Nf) = Iir_Kind_Overload_List then - Mark_Iir (Nf); - else - Mark_Iir_Ref_Field (N, F); + case Get_Field_Type (F) is + when Type_Iir => + case Get_Field_Attribute (F) is + when Attr_None => + Mark_Iir (Get_Iir (N, F)); + when Attr_Ref => + Mark_Iir_Ref_Field (N, F); + when Attr_Forward_Ref + | Attr_Chain_Next => + null; + when Attr_Maybe_Forward_Ref => + -- Only used for Named_Entity + pragma Assert (F = Field_Named_Entity); + + -- Overload_List has to be handled specially, as it + -- that case the Ref applies to the elements of the + -- list. + declare + Nf : constant Iir := Get_Iir (N, F); + begin + if Nf /= Null_Iir then + if Get_Is_Forward_Ref (N) then + pragma Assert + (Get_Kind (Nf) /= Iir_Kind_Overload_List); + null; + else + if Get_Kind (Nf) = Iir_Kind_Overload_List then + Mark_Iir (Nf); + else + Mark_Iir_Ref_Field (N, F); + end if; + end if; end if; + end; + when Attr_Maybe_Ref => + if Get_Is_Ref (N) then + Mark_Iir_Ref_Field (N, F); + else + Mark_Iir (Get_Iir (N, F)); end if; + when Attr_Chain => + Mark_Chain (Get_Iir (N, F)); + when Attr_Of_Ref | Attr_Of_Maybe_Ref => + raise Internal_Error; + end case; + when Type_Iir_List => + declare + Ref : Boolean; + begin + case Get_Field_Attribute (F) is + when Attr_None => + Ref := False; + when Attr_Of_Ref => + Ref := True; + when Attr_Of_Maybe_Ref => + Ref := Get_Is_Ref (N); + when Attr_Ref => + Ref := True; + when others => + raise Internal_Error; + end case; + if Ref then + Mark_Iir_List_Ref (Get_Iir_List (N, F), F); + else + Mark_Iir_List (Get_Iir_List (N, F)); end if; end; - when Attr_Maybe_Ref => - if Get_Is_Ref (N) then - Mark_Iir_Ref_Field (N, F); - else - Mark_Iir (Get_Iir (N, F)); - end if; - when Attr_Chain => - Mark_Chain (Get_Iir (N, F)); - when Attr_None => - case Get_Field_Type (F) is - when Type_Iir => - Mark_Iir (Get_Iir (N, F)); - when Type_Iir_List => - Mark_Iir_List (Get_Iir_List (N, F)); - when Type_PSL_Node => - Mark_PSL_Node (Get_PSL_Node (N, F)); - when Type_PSL_NFA => - Mark_PSL_NFA (Get_PSL_NFA (N, F)); - when others => - null; - end case; - when Attr_Of_Ref => - Mark_Iir_Ref_Field (N, F); + when Type_PSL_Node => + Mark_PSL_Node (Get_PSL_Node (N, F)); + when Type_PSL_NFA => + Mark_PSL_NFA (Get_PSL_NFA (N, F)); + when others => + null; end case; end loop; end; @@ -245,7 +263,14 @@ package body Nodes_GC is return; end if; - Markers (Get_Design_File (Unit)) := True; + -- Mark parents of UNIT. + declare + File : constant Iir := Get_Design_File (Unit); + Lib : constant Iir := Get_Library (File); + begin + Markers (File) := True; + Markers (Lib) := True; + end; -- First mark dependences List := Get_Dependence_List (Unit); diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb index 6eeae3877..67a25689b 100644 --- a/src/vhdl/nodes_meta.adb +++ b/src/vhdl/nodes_meta.adb @@ -1547,7 +1547,7 @@ package body Nodes_Meta is when Field_Last_Design_Unit => return Attr_Ref; when Field_Library_Declaration => - return Attr_Ref; + return Attr_Forward_Ref; when Field_File_Checksum => return Attr_None; when Field_Analysis_Time_Stamp => @@ -1629,7 +1629,7 @@ package body Nodes_Meta is when Field_Attribute_Specification => return Attr_Ref; when Field_Signal_List => - return Attr_None; + return Attr_Of_Maybe_Ref; when Field_Designated_Entity => return Attr_Forward_Ref; when Field_Formal => @@ -1885,7 +1885,7 @@ package body Nodes_Meta is when Field_Reject_Time_Expression => return Attr_None; when Field_Sensitivity_List => - return Attr_None; + return Attr_Of_Maybe_Ref; when Field_Process_Origin => return Attr_None; when Field_Package_Origin => @@ -1967,7 +1967,7 @@ package body Nodes_Meta is when Field_Guard_Decl => return Attr_None; when Field_Guard_Sensitivity_List => - return Attr_None; + return Attr_Of_Ref; when Field_Signal_Attribute_Chain => return Attr_Forward_Ref; when Field_Block_Block_Configuration => @@ -2007,7 +2007,7 @@ package body Nodes_Meta is when Field_Default_Entity_Aspect => return Attr_None; when Field_Binding_Indication => - return Attr_None; + return Attr_Maybe_Ref; when Field_Named_Entity => return Attr_Maybe_Forward_Ref; when Field_Alias_Declaration => @@ -2405,6 +2405,7 @@ package body Nodes_Meta is Field_Generic_Map_Aspect_Chain, Field_Port_Map_Aspect_Chain, -- Iir_Kind_Component_Configuration + Field_Is_Ref, Field_Parent, Field_Component_Name, Field_Instantiation_List, @@ -2471,12 +2472,14 @@ package body Nodes_Meta is Field_Attribute_Designator, Field_Attribute_Specification_Chain, -- Iir_Kind_Disconnection_Specification + Field_Is_Ref, Field_Parent, - Field_Chain, Field_Signal_List, Field_Type_Mark, Field_Expression, + Field_Chain, -- Iir_Kind_Configuration_Specification + Field_Is_Ref, Field_Parent, Field_Component_Name, Field_Instantiation_List, @@ -2589,9 +2592,9 @@ package body Nodes_Meta is Field_Designated_Subtype_Indication, -- Iir_Kind_Physical_Subtype_Definition Field_Resolved_Flag, + Field_Is_Ref, Field_Signal_Type_Flag, Field_Has_Signal_Flag, - Field_Is_Ref, Field_Type_Staticness, Field_Range_Constraint, Field_Subtype_Type_Mark, @@ -2600,9 +2603,9 @@ package body Nodes_Meta is Field_Resolution_Indication, -- Iir_Kind_Floating_Subtype_Definition Field_Resolved_Flag, + Field_Is_Ref, Field_Signal_Type_Flag, Field_Has_Signal_Flag, - Field_Is_Ref, Field_Type_Staticness, Field_Range_Constraint, Field_Subtype_Type_Mark, @@ -2612,9 +2615,9 @@ package body Nodes_Meta is Field_Tolerance, -- Iir_Kind_Integer_Subtype_Definition Field_Resolved_Flag, + Field_Is_Ref, Field_Signal_Type_Flag, Field_Has_Signal_Flag, - Field_Is_Ref, Field_Type_Staticness, Field_Range_Constraint, Field_Subtype_Type_Mark, @@ -2623,9 +2626,9 @@ package body Nodes_Meta is Field_Resolution_Indication, -- Iir_Kind_Enumeration_Subtype_Definition Field_Resolved_Flag, + Field_Is_Ref, Field_Signal_Type_Flag, Field_Has_Signal_Flag, - Field_Is_Ref, Field_Type_Staticness, Field_Range_Constraint, Field_Subtype_Type_Mark, @@ -2634,10 +2637,10 @@ package body Nodes_Meta is Field_Resolution_Indication, -- Iir_Kind_Enumeration_Type_Definition Field_Resolved_Flag, + Field_Is_Ref, Field_Signal_Type_Flag, Field_Has_Signal_Flag, Field_Only_Characters_Flag, - Field_Is_Ref, Field_Type_Staticness, Field_Enumeration_Literal_List, Field_Range_Constraint, @@ -2645,27 +2648,27 @@ package body Nodes_Meta is Field_Base_Type, -- Iir_Kind_Integer_Type_Definition Field_Resolved_Flag, + Field_Is_Ref, Field_Signal_Type_Flag, Field_Has_Signal_Flag, - Field_Is_Ref, Field_Type_Staticness, Field_Range_Constraint, Field_Type_Declarator, Field_Base_Type, -- Iir_Kind_Floating_Type_Definition Field_Resolved_Flag, + Field_Is_Ref, Field_Signal_Type_Flag, Field_Has_Signal_Flag, - Field_Is_Ref, Field_Type_Staticness, Field_Range_Constraint, Field_Type_Declarator, Field_Base_Type, -- Iir_Kind_Physical_Type_Definition Field_Resolved_Flag, + Field_Is_Ref, Field_Signal_Type_Flag, Field_Has_Signal_Flag, - Field_Is_Ref, Field_End_Has_Reserved_Id, Field_End_Has_Identifier, Field_Type_Staticness, @@ -3096,12 +3099,12 @@ package body Nodes_Meta is -- Iir_Kind_Signal_Declaration Field_Identifier, Field_Has_Disconnect_Flag, + Field_Is_Ref, Field_Has_Active_Flag, Field_Has_Identifier_List, Field_Visible_Flag, Field_After_Drivers_Flag, Field_Use_Flag, - Field_Is_Ref, Field_Guarded_Signal_Flag, Field_Signal_Kind, Field_Expr_Staticness, @@ -3113,11 +3116,11 @@ package body Nodes_Meta is Field_Type, -- Iir_Kind_Variable_Declaration Field_Identifier, + Field_Is_Ref, Field_Shared_Flag, Field_Has_Identifier_List, Field_Visible_Flag, Field_Use_Flag, - Field_Is_Ref, Field_Expr_Staticness, Field_Name_Staticness, Field_Parent, @@ -3128,10 +3131,10 @@ package body Nodes_Meta is -- Iir_Kind_Constant_Declaration Field_Identifier, Field_Deferred_Declaration_Flag, + Field_Is_Ref, Field_Has_Identifier_List, Field_Visible_Flag, Field_Use_Flag, - Field_Is_Ref, Field_Expr_Staticness, Field_Name_Staticness, Field_Parent, @@ -3156,12 +3159,12 @@ package body Nodes_Meta is Field_Identifier, Field_Has_Mode, Field_Has_Class, + Field_Is_Ref, Field_Mode, Field_Has_Identifier_List, Field_Visible_Flag, Field_After_Drivers_Flag, Field_Use_Flag, - Field_Is_Ref, Field_Expr_Staticness, Field_Name_Staticness, Field_Parent, @@ -3173,12 +3176,12 @@ package body Nodes_Meta is Field_Identifier, Field_Has_Mode, Field_Has_Class, + Field_Is_Ref, Field_Mode, Field_Has_Identifier_List, Field_Visible_Flag, Field_After_Drivers_Flag, Field_Use_Flag, - Field_Is_Ref, Field_Expr_Staticness, Field_Name_Staticness, Field_Parent, @@ -3191,14 +3194,14 @@ package body Nodes_Meta is Field_Has_Disconnect_Flag, Field_Has_Mode, Field_Has_Class, + Field_Is_Ref, Field_Mode, - Field_Open_Flag, Field_Has_Active_Flag, Field_Has_Identifier_List, Field_Visible_Flag, Field_After_Drivers_Flag, Field_Use_Flag, - Field_Is_Ref, + Field_Open_Flag, Field_Guarded_Signal_Flag, Field_Signal_Kind, Field_Expr_Staticness, @@ -3212,12 +3215,12 @@ package body Nodes_Meta is Field_Identifier, Field_Has_Mode, Field_Has_Class, + Field_Is_Ref, Field_Mode, Field_Has_Identifier_List, Field_Visible_Flag, Field_After_Drivers_Flag, Field_Use_Flag, - Field_Is_Ref, Field_Expr_Staticness, Field_Name_Staticness, Field_Parent, @@ -3227,10 +3230,10 @@ package body Nodes_Meta is Field_Type, -- Iir_Kind_Interface_Type_Declaration Field_Identifier, + Field_Is_Ref, Field_Has_Identifier_List, Field_Visible_Flag, Field_Use_Flag, - Field_Is_Ref, Field_Name_Staticness, Field_Parent, Field_Type, @@ -3614,6 +3617,7 @@ package body Nodes_Meta is Field_Label, Field_Seen_Flag, Field_End_Has_Postponed, + Field_Is_Ref, Field_Passive_Flag, Field_Postponed_Flag, Field_Visible_Flag, @@ -3874,6 +3878,7 @@ package body Nodes_Meta is Field_Report_Expression, -- Iir_Kind_Wait_Statement Field_Label, + Field_Is_Ref, Field_Visible_Flag, Field_Parent, Field_Timeout_Clause, @@ -3957,15 +3962,15 @@ package body Nodes_Meta is Field_End_Has_Identifier, Field_Parent, Field_Condition, - Field_Chain, - Field_Else_Clause, Field_Sequential_Statement_Chain, + Field_Else_Clause, + Field_Chain, -- Iir_Kind_Elsif Field_End_Has_Identifier, Field_Parent, Field_Condition, - Field_Else_Clause, Field_Sequential_Statement_Chain, + Field_Else_Clause, -- Iir_Kind_Character_Literal Field_Identifier, Field_Is_Forward_Ref, @@ -4359,237 +4364,237 @@ package body Nodes_Meta is Iir_Kind_Entity_Aspect_Open => 165, Iir_Kind_Block_Configuration => 171, Iir_Kind_Block_Header => 175, - Iir_Kind_Component_Configuration => 181, - Iir_Kind_Binding_Indication => 185, - Iir_Kind_Entity_Class => 187, - Iir_Kind_Attribute_Value => 195, - Iir_Kind_Signature => 198, - Iir_Kind_Aggregate_Info => 205, - Iir_Kind_Procedure_Call => 209, - Iir_Kind_Record_Element_Constraint => 215, - Iir_Kind_Array_Element_Resolution => 217, - Iir_Kind_Record_Resolution => 218, - Iir_Kind_Record_Element_Resolution => 221, - Iir_Kind_Attribute_Specification => 229, - Iir_Kind_Disconnection_Specification => 234, - Iir_Kind_Configuration_Specification => 239, - Iir_Kind_Access_Type_Definition => 247, - Iir_Kind_Incomplete_Type_Definition => 255, - Iir_Kind_Interface_Type_Definition => 262, - Iir_Kind_File_Type_Definition => 269, - Iir_Kind_Protected_Type_Declaration => 278, - Iir_Kind_Record_Type_Definition => 288, - Iir_Kind_Array_Type_Definition => 300, - Iir_Kind_Array_Subtype_Definition => 315, - Iir_Kind_Record_Subtype_Definition => 326, - Iir_Kind_Access_Subtype_Definition => 334, - Iir_Kind_Physical_Subtype_Definition => 344, - Iir_Kind_Floating_Subtype_Definition => 355, - Iir_Kind_Integer_Subtype_Definition => 365, - Iir_Kind_Enumeration_Subtype_Definition => 375, - Iir_Kind_Enumeration_Type_Definition => 385, - Iir_Kind_Integer_Type_Definition => 393, - Iir_Kind_Floating_Type_Definition => 401, - Iir_Kind_Physical_Type_Definition => 412, - Iir_Kind_Range_Expression => 420, - Iir_Kind_Protected_Type_Body => 427, - Iir_Kind_Wildcard_Type_Definition => 432, - Iir_Kind_Subtype_Definition => 437, - Iir_Kind_Scalar_Nature_Definition => 441, - Iir_Kind_Overload_List => 442, - Iir_Kind_Type_Declaration => 449, - Iir_Kind_Anonymous_Type_Declaration => 455, - Iir_Kind_Subtype_Declaration => 462, - Iir_Kind_Nature_Declaration => 468, - Iir_Kind_Subnature_Declaration => 474, - Iir_Kind_Package_Declaration => 489, - Iir_Kind_Package_Instantiation_Declaration => 502, - Iir_Kind_Package_Body => 510, - Iir_Kind_Configuration_Declaration => 519, - Iir_Kind_Entity_Declaration => 531, - Iir_Kind_Architecture_Body => 543, - Iir_Kind_Context_Declaration => 549, - Iir_Kind_Package_Header => 551, - Iir_Kind_Unit_Declaration => 559, - Iir_Kind_Library_Declaration => 566, - Iir_Kind_Component_Declaration => 576, - Iir_Kind_Attribute_Declaration => 583, - Iir_Kind_Group_Template_Declaration => 589, - Iir_Kind_Group_Declaration => 596, - Iir_Kind_Element_Declaration => 603, - Iir_Kind_Non_Object_Alias_Declaration => 611, - Iir_Kind_Psl_Declaration => 619, - Iir_Kind_Psl_Endpoint_Declaration => 633, - Iir_Kind_Terminal_Declaration => 639, - Iir_Kind_Free_Quantity_Declaration => 648, - Iir_Kind_Across_Quantity_Declaration => 660, - Iir_Kind_Through_Quantity_Declaration => 672, - Iir_Kind_Enumeration_Literal => 683, - Iir_Kind_Function_Declaration => 708, - Iir_Kind_Procedure_Declaration => 732, - Iir_Kind_Function_Body => 742, - Iir_Kind_Procedure_Body => 753, - Iir_Kind_Object_Alias_Declaration => 764, - Iir_Kind_File_Declaration => 778, - Iir_Kind_Guard_Signal_Declaration => 791, - Iir_Kind_Signal_Declaration => 808, - Iir_Kind_Variable_Declaration => 821, - Iir_Kind_Constant_Declaration => 835, - Iir_Kind_Iterator_Declaration => 846, - Iir_Kind_Interface_Constant_Declaration => 862, - Iir_Kind_Interface_Variable_Declaration => 878, - Iir_Kind_Interface_Signal_Declaration => 899, - Iir_Kind_Interface_File_Declaration => 915, - Iir_Kind_Interface_Type_Declaration => 925, - Iir_Kind_Interface_Package_Declaration => 936, - Iir_Kind_Interface_Function_Declaration => 953, - Iir_Kind_Interface_Procedure_Declaration => 966, - Iir_Kind_Signal_Attribute_Declaration => 969, - Iir_Kind_Identity_Operator => 973, - Iir_Kind_Negation_Operator => 977, - Iir_Kind_Absolute_Operator => 981, - Iir_Kind_Not_Operator => 985, - Iir_Kind_Condition_Operator => 989, - Iir_Kind_Reduction_And_Operator => 993, - Iir_Kind_Reduction_Or_Operator => 997, - Iir_Kind_Reduction_Nand_Operator => 1001, - Iir_Kind_Reduction_Nor_Operator => 1005, - Iir_Kind_Reduction_Xor_Operator => 1009, - Iir_Kind_Reduction_Xnor_Operator => 1013, - Iir_Kind_And_Operator => 1018, - Iir_Kind_Or_Operator => 1023, - Iir_Kind_Nand_Operator => 1028, - Iir_Kind_Nor_Operator => 1033, - Iir_Kind_Xor_Operator => 1038, - Iir_Kind_Xnor_Operator => 1043, - Iir_Kind_Equality_Operator => 1048, - Iir_Kind_Inequality_Operator => 1053, - Iir_Kind_Less_Than_Operator => 1058, - Iir_Kind_Less_Than_Or_Equal_Operator => 1063, - Iir_Kind_Greater_Than_Operator => 1068, - Iir_Kind_Greater_Than_Or_Equal_Operator => 1073, - Iir_Kind_Match_Equality_Operator => 1078, - Iir_Kind_Match_Inequality_Operator => 1083, - Iir_Kind_Match_Less_Than_Operator => 1088, - Iir_Kind_Match_Less_Than_Or_Equal_Operator => 1093, - Iir_Kind_Match_Greater_Than_Operator => 1098, - Iir_Kind_Match_Greater_Than_Or_Equal_Operator => 1103, - Iir_Kind_Sll_Operator => 1108, - Iir_Kind_Sla_Operator => 1113, - Iir_Kind_Srl_Operator => 1118, - Iir_Kind_Sra_Operator => 1123, - Iir_Kind_Rol_Operator => 1128, - Iir_Kind_Ror_Operator => 1133, - Iir_Kind_Addition_Operator => 1138, - Iir_Kind_Substraction_Operator => 1143, - Iir_Kind_Concatenation_Operator => 1148, - Iir_Kind_Multiplication_Operator => 1153, - Iir_Kind_Division_Operator => 1158, - Iir_Kind_Modulus_Operator => 1163, - Iir_Kind_Remainder_Operator => 1168, - Iir_Kind_Exponentiation_Operator => 1173, - Iir_Kind_Function_Call => 1181, - Iir_Kind_Aggregate => 1187, - Iir_Kind_Parenthesis_Expression => 1190, - Iir_Kind_Qualified_Expression => 1194, - Iir_Kind_Type_Conversion => 1199, - Iir_Kind_Allocator_By_Expression => 1203, - Iir_Kind_Allocator_By_Subtype => 1208, - Iir_Kind_Selected_Element => 1214, - Iir_Kind_Dereference => 1219, - Iir_Kind_Implicit_Dereference => 1224, - Iir_Kind_Slice_Name => 1231, - Iir_Kind_Indexed_Name => 1237, - Iir_Kind_Psl_Expression => 1239, - Iir_Kind_Sensitized_Process_Statement => 1259, - Iir_Kind_Process_Statement => 1279, - Iir_Kind_Concurrent_Simple_Signal_Assignment => 1290, - Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1301, - Iir_Kind_Concurrent_Selected_Signal_Assignment => 1313, - Iir_Kind_Concurrent_Assertion_Statement => 1321, - Iir_Kind_Concurrent_Procedure_Call_Statement => 1328, - Iir_Kind_Psl_Assert_Statement => 1341, - Iir_Kind_Psl_Cover_Statement => 1354, - Iir_Kind_Block_Statement => 1367, - Iir_Kind_If_Generate_Statement => 1377, - Iir_Kind_Case_Generate_Statement => 1386, - Iir_Kind_For_Generate_Statement => 1395, - Iir_Kind_Component_Instantiation_Statement => 1405, - Iir_Kind_Psl_Default_Clock => 1409, - Iir_Kind_Simple_Simultaneous_Statement => 1416, - Iir_Kind_Generate_Statement_Body => 1427, - Iir_Kind_If_Generate_Else_Clause => 1432, - Iir_Kind_Simple_Signal_Assignment_Statement => 1441, - Iir_Kind_Conditional_Signal_Assignment_Statement => 1450, - Iir_Kind_Selected_Waveform_Assignment_Statement => 1460, - Iir_Kind_Null_Statement => 1464, - Iir_Kind_Assertion_Statement => 1471, - Iir_Kind_Report_Statement => 1477, - Iir_Kind_Wait_Statement => 1484, - Iir_Kind_Variable_Assignment_Statement => 1490, - Iir_Kind_Conditional_Variable_Assignment_Statement => 1496, - Iir_Kind_Return_Statement => 1502, - Iir_Kind_For_Loop_Statement => 1511, - Iir_Kind_While_Loop_Statement => 1519, - Iir_Kind_Next_Statement => 1525, - Iir_Kind_Exit_Statement => 1531, - Iir_Kind_Case_Statement => 1539, - Iir_Kind_Procedure_Call_Statement => 1545, - Iir_Kind_If_Statement => 1554, - Iir_Kind_Elsif => 1559, - Iir_Kind_Character_Literal => 1567, - Iir_Kind_Simple_Name => 1575, - Iir_Kind_Selected_Name => 1584, - Iir_Kind_Operator_Symbol => 1590, - Iir_Kind_Reference_Name => 1593, - Iir_Kind_Selected_By_All_Name => 1599, - Iir_Kind_Parenthesis_Name => 1604, - Iir_Kind_External_Constant_Name => 1612, - Iir_Kind_External_Signal_Name => 1620, - Iir_Kind_External_Variable_Name => 1628, - Iir_Kind_Package_Pathname => 1632, - Iir_Kind_Absolute_Pathname => 1633, - Iir_Kind_Relative_Pathname => 1634, - Iir_Kind_Pathname_Element => 1639, - Iir_Kind_Base_Attribute => 1641, - Iir_Kind_Left_Type_Attribute => 1646, - Iir_Kind_Right_Type_Attribute => 1651, - Iir_Kind_High_Type_Attribute => 1656, - Iir_Kind_Low_Type_Attribute => 1661, - Iir_Kind_Ascending_Type_Attribute => 1666, - Iir_Kind_Image_Attribute => 1672, - Iir_Kind_Value_Attribute => 1678, - Iir_Kind_Pos_Attribute => 1684, - Iir_Kind_Val_Attribute => 1690, - Iir_Kind_Succ_Attribute => 1696, - Iir_Kind_Pred_Attribute => 1702, - Iir_Kind_Leftof_Attribute => 1708, - Iir_Kind_Rightof_Attribute => 1714, - Iir_Kind_Delayed_Attribute => 1723, - Iir_Kind_Stable_Attribute => 1732, - Iir_Kind_Quiet_Attribute => 1741, - Iir_Kind_Transaction_Attribute => 1750, - Iir_Kind_Event_Attribute => 1754, - Iir_Kind_Active_Attribute => 1758, - Iir_Kind_Last_Event_Attribute => 1762, - Iir_Kind_Last_Active_Attribute => 1766, - Iir_Kind_Last_Value_Attribute => 1770, - Iir_Kind_Driving_Attribute => 1774, - Iir_Kind_Driving_Value_Attribute => 1778, - Iir_Kind_Behavior_Attribute => 1778, - Iir_Kind_Structure_Attribute => 1778, - Iir_Kind_Simple_Name_Attribute => 1785, - Iir_Kind_Instance_Name_Attribute => 1790, - Iir_Kind_Path_Name_Attribute => 1795, - Iir_Kind_Left_Array_Attribute => 1802, - Iir_Kind_Right_Array_Attribute => 1809, - Iir_Kind_High_Array_Attribute => 1816, - Iir_Kind_Low_Array_Attribute => 1823, - Iir_Kind_Length_Array_Attribute => 1830, - Iir_Kind_Ascending_Array_Attribute => 1837, - Iir_Kind_Range_Array_Attribute => 1844, - Iir_Kind_Reverse_Range_Array_Attribute => 1851, - Iir_Kind_Attribute_Name => 1860 + Iir_Kind_Component_Configuration => 182, + Iir_Kind_Binding_Indication => 186, + Iir_Kind_Entity_Class => 188, + Iir_Kind_Attribute_Value => 196, + Iir_Kind_Signature => 199, + Iir_Kind_Aggregate_Info => 206, + Iir_Kind_Procedure_Call => 210, + Iir_Kind_Record_Element_Constraint => 216, + Iir_Kind_Array_Element_Resolution => 218, + Iir_Kind_Record_Resolution => 219, + Iir_Kind_Record_Element_Resolution => 222, + Iir_Kind_Attribute_Specification => 230, + Iir_Kind_Disconnection_Specification => 236, + Iir_Kind_Configuration_Specification => 242, + Iir_Kind_Access_Type_Definition => 250, + Iir_Kind_Incomplete_Type_Definition => 258, + Iir_Kind_Interface_Type_Definition => 265, + Iir_Kind_File_Type_Definition => 272, + Iir_Kind_Protected_Type_Declaration => 281, + Iir_Kind_Record_Type_Definition => 291, + Iir_Kind_Array_Type_Definition => 303, + Iir_Kind_Array_Subtype_Definition => 318, + Iir_Kind_Record_Subtype_Definition => 329, + Iir_Kind_Access_Subtype_Definition => 337, + Iir_Kind_Physical_Subtype_Definition => 347, + Iir_Kind_Floating_Subtype_Definition => 358, + Iir_Kind_Integer_Subtype_Definition => 368, + Iir_Kind_Enumeration_Subtype_Definition => 378, + Iir_Kind_Enumeration_Type_Definition => 388, + Iir_Kind_Integer_Type_Definition => 396, + Iir_Kind_Floating_Type_Definition => 404, + Iir_Kind_Physical_Type_Definition => 415, + Iir_Kind_Range_Expression => 423, + Iir_Kind_Protected_Type_Body => 430, + Iir_Kind_Wildcard_Type_Definition => 435, + Iir_Kind_Subtype_Definition => 440, + Iir_Kind_Scalar_Nature_Definition => 444, + Iir_Kind_Overload_List => 445, + Iir_Kind_Type_Declaration => 452, + Iir_Kind_Anonymous_Type_Declaration => 458, + Iir_Kind_Subtype_Declaration => 465, + Iir_Kind_Nature_Declaration => 471, + Iir_Kind_Subnature_Declaration => 477, + Iir_Kind_Package_Declaration => 492, + Iir_Kind_Package_Instantiation_Declaration => 505, + Iir_Kind_Package_Body => 513, + Iir_Kind_Configuration_Declaration => 522, + Iir_Kind_Entity_Declaration => 534, + Iir_Kind_Architecture_Body => 546, + Iir_Kind_Context_Declaration => 552, + Iir_Kind_Package_Header => 554, + Iir_Kind_Unit_Declaration => 562, + Iir_Kind_Library_Declaration => 569, + Iir_Kind_Component_Declaration => 579, + Iir_Kind_Attribute_Declaration => 586, + Iir_Kind_Group_Template_Declaration => 592, + Iir_Kind_Group_Declaration => 599, + Iir_Kind_Element_Declaration => 606, + Iir_Kind_Non_Object_Alias_Declaration => 614, + Iir_Kind_Psl_Declaration => 622, + Iir_Kind_Psl_Endpoint_Declaration => 636, + Iir_Kind_Terminal_Declaration => 642, + Iir_Kind_Free_Quantity_Declaration => 651, + Iir_Kind_Across_Quantity_Declaration => 663, + Iir_Kind_Through_Quantity_Declaration => 675, + Iir_Kind_Enumeration_Literal => 686, + Iir_Kind_Function_Declaration => 711, + Iir_Kind_Procedure_Declaration => 735, + Iir_Kind_Function_Body => 745, + Iir_Kind_Procedure_Body => 756, + Iir_Kind_Object_Alias_Declaration => 767, + Iir_Kind_File_Declaration => 781, + Iir_Kind_Guard_Signal_Declaration => 794, + Iir_Kind_Signal_Declaration => 811, + Iir_Kind_Variable_Declaration => 824, + Iir_Kind_Constant_Declaration => 838, + Iir_Kind_Iterator_Declaration => 849, + Iir_Kind_Interface_Constant_Declaration => 865, + Iir_Kind_Interface_Variable_Declaration => 881, + Iir_Kind_Interface_Signal_Declaration => 902, + Iir_Kind_Interface_File_Declaration => 918, + Iir_Kind_Interface_Type_Declaration => 928, + Iir_Kind_Interface_Package_Declaration => 939, + Iir_Kind_Interface_Function_Declaration => 956, + Iir_Kind_Interface_Procedure_Declaration => 969, + Iir_Kind_Signal_Attribute_Declaration => 972, + Iir_Kind_Identity_Operator => 976, + Iir_Kind_Negation_Operator => 980, + Iir_Kind_Absolute_Operator => 984, + Iir_Kind_Not_Operator => 988, + Iir_Kind_Condition_Operator => 992, + Iir_Kind_Reduction_And_Operator => 996, + Iir_Kind_Reduction_Or_Operator => 1000, + Iir_Kind_Reduction_Nand_Operator => 1004, + Iir_Kind_Reduction_Nor_Operator => 1008, + Iir_Kind_Reduction_Xor_Operator => 1012, + Iir_Kind_Reduction_Xnor_Operator => 1016, + Iir_Kind_And_Operator => 1021, + Iir_Kind_Or_Operator => 1026, + Iir_Kind_Nand_Operator => 1031, + Iir_Kind_Nor_Operator => 1036, + Iir_Kind_Xor_Operator => 1041, + Iir_Kind_Xnor_Operator => 1046, + Iir_Kind_Equality_Operator => 1051, + Iir_Kind_Inequality_Operator => 1056, + Iir_Kind_Less_Than_Operator => 1061, + Iir_Kind_Less_Than_Or_Equal_Operator => 1066, + Iir_Kind_Greater_Than_Operator => 1071, + Iir_Kind_Greater_Than_Or_Equal_Operator => 1076, + Iir_Kind_Match_Equality_Operator => 1081, + Iir_Kind_Match_Inequality_Operator => 1086, + Iir_Kind_Match_Less_Than_Operator => 1091, + Iir_Kind_Match_Less_Than_Or_Equal_Operator => 1096, + Iir_Kind_Match_Greater_Than_Operator => 1101, + Iir_Kind_Match_Greater_Than_Or_Equal_Operator => 1106, + Iir_Kind_Sll_Operator => 1111, + Iir_Kind_Sla_Operator => 1116, + Iir_Kind_Srl_Operator => 1121, + Iir_Kind_Sra_Operator => 1126, + Iir_Kind_Rol_Operator => 1131, + Iir_Kind_Ror_Operator => 1136, + Iir_Kind_Addition_Operator => 1141, + Iir_Kind_Substraction_Operator => 1146, + Iir_Kind_Concatenation_Operator => 1151, + Iir_Kind_Multiplication_Operator => 1156, + Iir_Kind_Division_Operator => 1161, + Iir_Kind_Modulus_Operator => 1166, + Iir_Kind_Remainder_Operator => 1171, + Iir_Kind_Exponentiation_Operator => 1176, + Iir_Kind_Function_Call => 1184, + Iir_Kind_Aggregate => 1190, + Iir_Kind_Parenthesis_Expression => 1193, + Iir_Kind_Qualified_Expression => 1197, + Iir_Kind_Type_Conversion => 1202, + Iir_Kind_Allocator_By_Expression => 1206, + Iir_Kind_Allocator_By_Subtype => 1211, + Iir_Kind_Selected_Element => 1217, + Iir_Kind_Dereference => 1222, + Iir_Kind_Implicit_Dereference => 1227, + Iir_Kind_Slice_Name => 1234, + Iir_Kind_Indexed_Name => 1240, + Iir_Kind_Psl_Expression => 1242, + Iir_Kind_Sensitized_Process_Statement => 1263, + Iir_Kind_Process_Statement => 1283, + Iir_Kind_Concurrent_Simple_Signal_Assignment => 1294, + Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1305, + Iir_Kind_Concurrent_Selected_Signal_Assignment => 1317, + Iir_Kind_Concurrent_Assertion_Statement => 1325, + Iir_Kind_Concurrent_Procedure_Call_Statement => 1332, + Iir_Kind_Psl_Assert_Statement => 1345, + Iir_Kind_Psl_Cover_Statement => 1358, + Iir_Kind_Block_Statement => 1371, + Iir_Kind_If_Generate_Statement => 1381, + Iir_Kind_Case_Generate_Statement => 1390, + Iir_Kind_For_Generate_Statement => 1399, + Iir_Kind_Component_Instantiation_Statement => 1409, + Iir_Kind_Psl_Default_Clock => 1413, + Iir_Kind_Simple_Simultaneous_Statement => 1420, + Iir_Kind_Generate_Statement_Body => 1431, + Iir_Kind_If_Generate_Else_Clause => 1436, + Iir_Kind_Simple_Signal_Assignment_Statement => 1445, + Iir_Kind_Conditional_Signal_Assignment_Statement => 1454, + Iir_Kind_Selected_Waveform_Assignment_Statement => 1464, + Iir_Kind_Null_Statement => 1468, + Iir_Kind_Assertion_Statement => 1475, + Iir_Kind_Report_Statement => 1481, + Iir_Kind_Wait_Statement => 1489, + Iir_Kind_Variable_Assignment_Statement => 1495, + Iir_Kind_Conditional_Variable_Assignment_Statement => 1501, + Iir_Kind_Return_Statement => 1507, + Iir_Kind_For_Loop_Statement => 1516, + Iir_Kind_While_Loop_Statement => 1524, + Iir_Kind_Next_Statement => 1530, + Iir_Kind_Exit_Statement => 1536, + Iir_Kind_Case_Statement => 1544, + Iir_Kind_Procedure_Call_Statement => 1550, + Iir_Kind_If_Statement => 1559, + Iir_Kind_Elsif => 1564, + Iir_Kind_Character_Literal => 1572, + Iir_Kind_Simple_Name => 1580, + Iir_Kind_Selected_Name => 1589, + Iir_Kind_Operator_Symbol => 1595, + Iir_Kind_Reference_Name => 1598, + Iir_Kind_Selected_By_All_Name => 1604, + Iir_Kind_Parenthesis_Name => 1609, + Iir_Kind_External_Constant_Name => 1617, + Iir_Kind_External_Signal_Name => 1625, + Iir_Kind_External_Variable_Name => 1633, + Iir_Kind_Package_Pathname => 1637, + Iir_Kind_Absolute_Pathname => 1638, + Iir_Kind_Relative_Pathname => 1639, + Iir_Kind_Pathname_Element => 1644, + Iir_Kind_Base_Attribute => 1646, + Iir_Kind_Left_Type_Attribute => 1651, + Iir_Kind_Right_Type_Attribute => 1656, + Iir_Kind_High_Type_Attribute => 1661, + Iir_Kind_Low_Type_Attribute => 1666, + Iir_Kind_Ascending_Type_Attribute => 1671, + Iir_Kind_Image_Attribute => 1677, + Iir_Kind_Value_Attribute => 1683, + Iir_Kind_Pos_Attribute => 1689, + Iir_Kind_Val_Attribute => 1695, + Iir_Kind_Succ_Attribute => 1701, + Iir_Kind_Pred_Attribute => 1707, + Iir_Kind_Leftof_Attribute => 1713, + Iir_Kind_Rightof_Attribute => 1719, + Iir_Kind_Delayed_Attribute => 1728, + Iir_Kind_Stable_Attribute => 1737, + Iir_Kind_Quiet_Attribute => 1746, + Iir_Kind_Transaction_Attribute => 1755, + Iir_Kind_Event_Attribute => 1759, + Iir_Kind_Active_Attribute => 1763, + Iir_Kind_Last_Event_Attribute => 1767, + Iir_Kind_Last_Active_Attribute => 1771, + Iir_Kind_Last_Value_Attribute => 1775, + Iir_Kind_Driving_Attribute => 1779, + Iir_Kind_Driving_Value_Attribute => 1783, + Iir_Kind_Behavior_Attribute => 1783, + Iir_Kind_Structure_Attribute => 1783, + Iir_Kind_Simple_Name_Attribute => 1790, + Iir_Kind_Instance_Name_Attribute => 1795, + Iir_Kind_Path_Name_Attribute => 1800, + Iir_Kind_Left_Array_Attribute => 1807, + Iir_Kind_Right_Array_Attribute => 1814, + Iir_Kind_High_Array_Attribute => 1821, + Iir_Kind_Low_Array_Attribute => 1828, + Iir_Kind_Length_Array_Attribute => 1835, + Iir_Kind_Ascending_Array_Attribute => 1842, + Iir_Kind_Range_Array_Attribute => 1849, + Iir_Kind_Reverse_Range_Array_Attribute => 1856, + Iir_Kind_Attribute_Name => 1865 ); function Get_Fields (K : Iir_Kind) return Fields_Array @@ -10394,7 +10399,10 @@ package body Nodes_Meta is function Has_Is_Ref (K : Iir_Kind) return Boolean is begin case K is - when Iir_Kind_Physical_Subtype_Definition + when Iir_Kind_Component_Configuration + | Iir_Kind_Disconnection_Specification + | Iir_Kind_Configuration_Specification + | Iir_Kind_Physical_Subtype_Definition | Iir_Kind_Floating_Subtype_Definition | Iir_Kind_Integer_Subtype_Definition | Iir_Kind_Enumeration_Subtype_Definition @@ -10410,7 +10418,9 @@ package body Nodes_Meta is | Iir_Kind_Interface_Variable_Declaration | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Interface_File_Declaration - | Iir_Kind_Interface_Type_Declaration => + | Iir_Kind_Interface_Type_Declaration + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Wait_Statement => return True; when others => return False; diff --git a/src/vhdl/nodes_meta.ads b/src/vhdl/nodes_meta.ads index bd878c4bc..ddd23ed79 100644 --- a/src/vhdl/nodes_meta.ads +++ b/src/vhdl/nodes_meta.ads @@ -398,8 +398,9 @@ package Nodes_Meta is type Field_Attribute is ( Attr_None, - Attr_Ref, Attr_Maybe_Ref, Attr_Of_Ref, + Attr_Ref, Attr_Maybe_Ref, Attr_Forward_Ref, Attr_Maybe_Forward_Ref, + Attr_Of_Ref, Attr_Of_Maybe_Ref, Attr_Chain, Attr_Chain_Next ); diff --git a/src/vhdl/nodes_meta.ads.in b/src/vhdl/nodes_meta.ads.in index fe54242b1..893064816 100644 --- a/src/vhdl/nodes_meta.ads.in +++ b/src/vhdl/nodes_meta.ads.in @@ -47,8 +47,9 @@ package Nodes_Meta is type Field_Attribute is ( Attr_None, - Attr_Ref, Attr_Maybe_Ref, Attr_Of_Ref, + Attr_Ref, Attr_Maybe_Ref, Attr_Forward_Ref, Attr_Maybe_Forward_Ref, + Attr_Of_Ref, Attr_Of_Maybe_Ref, Attr_Chain, Attr_Chain_Next ); diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb index 789cb4378..1664d67e1 100644 --- a/src/vhdl/sem.adb +++ b/src/vhdl/sem.adb @@ -998,9 +998,7 @@ package body Sem is Comp_Arch := Get_Architecture (Entity_Aspect); if Comp_Arch /= Null_Iir then - if Get_Kind (Comp_Arch) /= Iir_Kind_Simple_Name then - raise Internal_Error; - end if; + pragma Assert (Get_Kind (Comp_Arch) = Iir_Kind_Simple_Name); if Get_Identifier (Comp_Arch) /= Get_Identifier (Block_Spec) then Error_Msg_Sem @@ -1024,6 +1022,7 @@ package body Sem is (+Block_Conf, "no architecture %i", +Block_Spec); return; end if; + Add_Dependence (Design); Arch := Get_Library_Unit (Design); Set_Named_Entity (Block_Spec, Arch); Xref_Ref (Block_Spec, Arch); diff --git a/src/vhdl/sem_inst.adb b/src/vhdl/sem_inst.adb index 5467858d5..147073063 100644 --- a/src/vhdl/sem_inst.adb +++ b/src/vhdl/sem_inst.adb @@ -18,7 +18,7 @@ with Tables; with Nodes; with Nodes_Meta; with Types; use Types; -with Files_Map; use Files_Map; +with Files_Map; with Iirs_Utils; use Iirs_Utils; with Errorout; use Errorout; @@ -147,6 +147,18 @@ package body Sem_Inst is -- The virtual file for the instance. Instance_File : Source_File_Entry; + -- Get the new location. + function Relocate (Loc : Location_Type) return Location_Type is + begin + if Instance_File /= No_Source_File_Entry then + -- For Instantiate. + return Files_Map.Instance_Relocate (Instance_File, Loc); + else + -- For Copy_Tree. + return Loc; + end if; + end Relocate; + function Instantiate_Iir (N : Iir; Is_Ref : Boolean) return Iir; -- Instantiate a list. Simply create a new list and instantiate nodes of @@ -230,7 +242,7 @@ package body Sem_Inst is R := Instantiate_Iir_Chain (S); when Attr_Chain_Next => R := Null_Iir; - when Attr_Of_Ref => + when Attr_Of_Ref | Attr_Of_Maybe_Ref => -- Can only appear in list. raise Internal_Error; end case; @@ -240,17 +252,21 @@ package body Sem_Inst is declare S : constant Iir_List := Get_Iir_List (N, F); R : Iir_List; + Ref : Boolean; begin case Get_Field_Attribute (F) is when Attr_None => - R := Instantiate_Iir_List (S, False); + Ref := False; when Attr_Of_Ref => - R := Instantiate_Iir_List (S, True); + Ref := True; + when Attr_Of_Maybe_Ref => + Ref := Get_Is_Ref (N); when others => -- Ref is specially handled in Instantiate_Iir. -- Others cannot appear for lists. raise Internal_Error; end case; + R := Instantiate_Iir_List (S, Ref); Set_Iir_List (Res, F, R); end; when Type_PSL_NFA @@ -298,8 +314,7 @@ package body Sem_Inst is Set_Iir_Direction (Res, F, Get_Iir_Direction (N, F)); when Type_Location_Type => Set_Location_Type - (Res, F, Instance_Relocate (Instance_File, - Get_Location_Type (N, F))); + (Res, F, Relocate (Get_Location_Type (N, F))); when Type_Iir_Int32 => Set_Iir_Int32 (Res, F, Get_Iir_Int32 (N, F)); when Type_Int32 => @@ -362,8 +377,7 @@ package body Sem_Inst is -- And the instance of N is RES. Set_Instance (N, Res); - Set_Location - (Res, Instance_Relocate (Instance_File, Get_Location (N))); + Set_Location (Res, Relocate (Get_Location (N))); for I in Fields'Range loop F := Fields (I); @@ -532,8 +546,7 @@ package body Sem_Inst is while Inter /= Null_Iir loop -- Create a copy of the interface. FIXME: is it really needed ? Res := Create_Iir (Get_Kind (Inter)); - Set_Location - (Res, Instance_Relocate (Instance_File, Get_Location (Inter))); + Set_Location (Res, Relocate (Get_Location (Inter))); Set_Parent (Res, Inst); Set_Identifier (Res, Get_Identifier (Inter)); @@ -633,7 +646,7 @@ package body Sem_Inst is Set_Instance_On_Chain (S, S_Inst); when Attr_Chain_Next => null; - when Attr_Of_Ref => + when Attr_Of_Ref | Attr_Of_Maybe_Ref => -- Can only appear in list. raise Internal_Error; end case; @@ -646,6 +659,10 @@ package body Sem_Inst is case Get_Field_Attribute (F) is when Attr_None => Set_Instance_On_Iir_List (S, S_Inst); + when Attr_Of_Maybe_Ref => + if not Get_Is_Ref (N) then + Set_Instance_On_Iir_List (S, S_Inst); + end if; when Attr_Of_Ref | Attr_Ref | Attr_Forward_Ref => @@ -786,8 +803,28 @@ package body Sem_Inst is end loop; end Instantiate_Generic_Map_Chain; + function Copy_Tree (Orig : Iir) return Iir + is + Prev_Instance_File : constant Source_File_Entry := Instance_File; + Mark : constant Instance_Index_Type := Prev_Instance_Table.Last; + Res : Iir; + begin + Instance_File := No_Source_File_Entry; + + -- Be sure Get_Origin_Priv can be called on existing nodes. + Expand_Origin_Table; + + Res := Instantiate_Iir (Orig, False); + + Instance_File := Prev_Instance_File; + Restore_Origin (Mark); + + return Res; + end Copy_Tree; + procedure Create_Relocation (Inst : Iir; Orig : Iir) is + use Files_Map; Orig_File : Source_File_Entry; Pos : Source_Ptr; begin @@ -959,7 +996,7 @@ package body Sem_Inst is Substitute_On_Chain (S, E, Rep); when Attr_Chain_Next => null; - when Attr_Of_Ref => + when Attr_Of_Ref | Attr_Of_Maybe_Ref => -- Can only appear in list. raise Internal_Error; end case; @@ -972,6 +1009,10 @@ package body Sem_Inst is case Get_Field_Attribute (F) is when Attr_None => Substitute_On_Iir_List (S, E, Rep); + when Attr_Of_Maybe_Ref => + if not Get_Is_Ref (N) then + Substitute_On_Iir_List (S, E, Rep); + end if; when Attr_Of_Ref | Attr_Ref | Attr_Forward_Ref => diff --git a/src/vhdl/sem_inst.ads b/src/vhdl/sem_inst.ads index 919d6b0f1..804451272 100644 --- a/src/vhdl/sem_inst.ads +++ b/src/vhdl/sem_inst.ads @@ -31,4 +31,6 @@ package Sem_Inst is -- In CHAIN, substitute all references to E by REP. procedure Substitute_On_Chain (Chain : Iir; E : Iir; Rep : Iir); + -- Deep copy of ORIG. Doesn't change location. + function Copy_Tree (Orig : Iir) return Iir; end Sem_Inst; diff --git a/src/vhdl/sem_specs.adb b/src/vhdl/sem_specs.adb index c88ff51d0..5a1d511e4 100644 --- a/src/vhdl/sem_specs.adb +++ b/src/vhdl/sem_specs.adb @@ -1510,9 +1510,7 @@ package body Sem_Specs is Aspect := Create_Iir (Iir_Kind_Entity_Aspect_Entity); Location_Copy (Aspect, Parent); - Entity_Name := Create_Iir (Iir_Kind_Simple_Name); - Location_Copy (Entity_Name, Parent); - Set_Named_Entity (Entity_Name, Entity); + Entity_Name := Build_Simple_Name (Entity, Parent); Set_Entity_Name (Aspect, Entity_Name); Set_Entity_Aspect (Res, Aspect); diff --git a/src/vhdl/sem_stmts.adb b/src/vhdl/sem_stmts.adb index d352aac0a..d79e05d2b 100644 --- a/src/vhdl/sem_stmts.adb +++ b/src/vhdl/sem_stmts.adb @@ -1510,7 +1510,7 @@ package body Sem_Stmts is -- Create a default binding indication if necessary. if Get_Component_Configuration (Stmt) = Null_Iir - and then Get_Kind (Decl) = Iir_Kind_Component_Declaration + and then Is_Component_Instantiation (Stmt) then Entity_Unit := Get_Visible_Entity_Declaration (Decl); if Entity_Unit = Null_Iir then diff --git a/src/vhdl/sem_types.adb b/src/vhdl/sem_types.adb index 064648096..53d96229c 100644 --- a/src/vhdl/sem_types.adb +++ b/src/vhdl/sem_types.adb @@ -409,6 +409,7 @@ package body Sem_Types is (Phys_Range, Get_Expr_Staticness (Range_Expr1)); Set_Range_Constraint (Sub_Type, Phys_Range); + Set_Range_Constraint (Def, Null_Iir); -- This must be locally... Set_Type_Staticness (Sub_Type, Get_Expr_Staticness (Range_Expr1)); diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb index d721a7816..015bca20d 100644 --- a/src/vhdl/translate/trans-chap2.adb +++ b/src/vhdl/translate/trans-chap2.adb @@ -1223,13 +1223,17 @@ package body Trans.Chap2 is Instantiate_Iir_Chain_Info (Get_Iir (N, F)); when Attr_Chain_Next => null; - when Attr_Of_Ref => + when Attr_Of_Ref | Attr_Of_Maybe_Ref => raise Internal_Error; end case; when Type_Iir_List => case Get_Field_Attribute (F) is when Attr_None => Instantiate_Iir_List_Info (Get_Iir_List (N, F)); + when Attr_Of_Maybe_Ref => + if not Get_Is_Ref (N) then + Instantiate_Iir_List_Info (Get_Iir_List (N, F)); + end if; when Attr_Ref | Attr_Of_Ref => null; diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb index 3e7fcb2a4..3dd31c628 100644 --- a/src/vhdl/translate/trans-chap8.adb +++ b/src/vhdl/translate/trans-chap8.adb @@ -347,7 +347,8 @@ package body Trans.Chap8 is Else_Clause : Iir; begin Start_If_Stmt - (Blk, Chap7.Translate_Expression (Get_Condition (Stmt))); + (Blk, Chap7.Translate_Expression (Strip_Reference_Name + (Get_Condition (Stmt)))); Translate_Statements_Chain (Get_Sequential_Statement_Chain (Stmt)); @@ -4069,7 +4070,7 @@ package body Trans.Chap8 is Targ : Mnode; Drv : Mnode) is - Target : constant Iir := Get_Target (Stmt); + Target : constant Iir := Strip_Reference_Name (Get_Target (Stmt)); Target_Type : constant Iir := Get_Type (Target); We : Iir_Waveform_Element; Val : O_Enode; @@ -4197,7 +4198,7 @@ package body Trans.Chap8 is procedure Translate_Simple_Signal_Assignment_Statement (Stmt : Iir) is - Target : constant Iir := Get_Target (Stmt); + Target : constant Iir := Strip_Reference_Name (Get_Target (Stmt)); Wf_Chain : constant Iir := Get_Waveform_Chain (Stmt); Mechanism : Signal_Assignment_Mechanism; Targ : Mnode; diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb index 5f4ef84bf..90995f21b 100644 --- a/src/vhdl/translate/trans-chap9.adb +++ b/src/vhdl/translate/trans-chap9.adb @@ -1172,13 +1172,17 @@ package body Trans.Chap9 is Destroy_Types_In_Chain (Get_Iir (N, F)); when Attr_Chain_Next => null; - when Attr_Of_Ref => + when Attr_Of_Ref | Attr_Of_Maybe_Ref => raise Internal_Error; end case; when Type_Iir_List => case Get_Field_Attribute (F) is when Attr_None => Destroy_Types_In_List (Get_Iir_List (N, F)); + when Attr_Of_Maybe_Ref => + if not Get_Is_Ref (N) then + Destroy_Types_In_List (Get_Iir_List (N, F)); + end if; when Attr_Ref | Attr_Of_Ref => null; @@ -1549,9 +1553,15 @@ package body Trans.Chap9 is when Iir_Kind_Entity_Aspect_Entity => Entity := Get_Entity (Aspect); Arch := Get_Architecture (Aspect); - if Flags.Flag_Elaborate and then Arch = Null_Iir then - -- This is valid only during elaboration. - Arch := Libraries.Get_Latest_Architecture (Entity); + if Arch = Null_Iir then + if Flags.Flag_Elaborate then + -- This is valid only during elaboration. + Arch := Libraries.Get_Latest_Architecture (Entity); + end if; + else + if Is_Valid (Get_Named_Entity (Arch)) then + Arch := Get_Named_Entity (Arch); + end if; end if; Config := Null_Iir; when Iir_Kind_Entity_Aspect_Configuration => |