diff options
author | Tristan Gingold <tgingold@free.fr> | 2019-10-13 07:55:07 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2019-10-13 18:54:24 +0200 |
commit | a0d967a826d073df38a15e29e4879c676ce98a2b (patch) | |
tree | e16e55c9372e605fd26e74ab352c97331ed11fa0 /src | |
parent | fcef281d6e3f2bda74c2f75543ea3d7d2927c813 (diff) | |
download | ghdl-a0d967a826d073df38a15e29e4879c676ce98a2b.tar.gz ghdl-a0d967a826d073df38a15e29e4879c676ce98a2b.tar.bz2 ghdl-a0d967a826d073df38a15e29e4879c676ce98a2b.zip |
synth-stmts: improve support for associations in function calls.
Diffstat (limited to 'src')
-rw-r--r-- | src/synth/synth-stmts.adb | 111 |
1 files changed, 92 insertions, 19 deletions
diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index 63354f00a..50a1c70a8 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -1234,6 +1234,74 @@ package body Synth.Stmts is Free_Alternative_Data_Array (Alts); end Synth_Selected_Signal_Assignment; + type Association_Iterator is record + Inter : Node; + First_Named_Assoc : Node; + Next_Assoc : Node; + end record; + + procedure Association_Iterate_Init (Iterator : out Association_Iterator; + Inter_Chain : Node; + Assoc_Chain : Node) is + begin + Iterator := (Inter => Inter_Chain, + First_Named_Assoc => Null_Node, + Next_Assoc => Assoc_Chain); + end Association_Iterate_Init; + + procedure Association_Iterate_Next (Iterator : in out Association_Iterator; + Inter : out Node; + Assoc : out Node) + is + Formal : Node; + begin + Inter := Iterator.Inter; + if Inter = Null_Node then + -- End of iterator. + Assoc := Null_Node; + return; + else + -- Advance to the next interface for the next call. + Iterator.Inter := Get_Chain (Iterator.Inter); + end if; + + if Iterator.First_Named_Assoc = Null_Node then + Assoc := Iterator.Next_Assoc; + if Assoc = Null_Node then + -- No more association: open association. + return; + end if; + Formal := Get_Formal (Assoc); + if Formal = Null_Node then + -- Association by position. + -- Update for the next call. + Iterator.Next_Assoc := Get_Chain (Assoc); + return; + end if; + Iterator.First_Named_Assoc := Assoc; + end if; + + -- Search by name. + Assoc := Iterator.First_Named_Assoc; + while Assoc /= Null_Node loop + Formal := Get_Formal (Assoc); + pragma Assert (Formal /= Null_Node); + Formal := Get_Interface_Of_Formal (Formal); + if Formal = Inter then + -- Found. + -- Optimize in case assocs are in order. + if Assoc = Iterator.First_Named_Assoc then + Iterator.First_Named_Assoc := Get_Chain (Assoc); + end if; + return; + end if; + Assoc := Get_Chain (Assoc); + end loop; + + -- Not found: open association. + return; + end Association_Iterate_Next; + procedure Synth_Subprogram_Association (Subprg_Inst : Synth_Instance_Acc; Caller_Inst : Synth_Instance_Acc; Inter_Chain : Node; @@ -1244,34 +1312,41 @@ package body Synth.Stmts is Inter : Node; Inter_Type : Type_Acc; Assoc : Node; - Assoc_Inter : Node; Actual : Node; Val : Value_Acc; Nbr_Inout : Natural; + Iterator : Association_Iterator; begin Set_Instance_Const (Subprg_Inst, True); Nbr_Inout := 0; - Assoc := Assoc_Chain; - Assoc_Inter := Inter_Chain; - while Is_Valid (Assoc) loop - Inter := Get_Association_Interface (Assoc, Assoc_Inter); + + -- Process in INTER order. + Association_Iterate_Init (Iterator, Inter_Chain, Assoc_Chain); + loop + Association_Iterate_Next (Iterator, Inter, Assoc); + exit when Inter = Null_Node; + Inter_Type := Get_Value_Type (Caller_Inst, Get_Type (Inter)); case Iir_Parameter_Modes (Get_Mode (Inter)) is when Iir_In_Mode => - case Get_Kind (Assoc) is - when Iir_Kind_Association_Element_Open => - Actual := Get_Default_Value (Inter); - Val := Synth_Expression_With_Type - (Subprg_Inst, Actual, Inter_Type); - when Iir_Kind_Association_Element_By_Expression => - Actual := Get_Actual (Assoc); - Val := Synth_Expression_With_Type - (Caller_Inst, Actual, Inter_Type); - when others => - raise Internal_Error; - end case; + if Assoc = Null_Node + or else Get_Kind (Assoc) = Iir_Kind_Association_Element_Open + then + Actual := Get_Default_Value (Inter); + Val := Synth_Expression_With_Type + (Subprg_Inst, Actual, Inter_Type); + else + case Get_Kind (Assoc) is + when Iir_Kind_Association_Element_By_Expression => + Actual := Get_Actual (Assoc); + Val := Synth_Expression_With_Type + (Caller_Inst, Actual, Inter_Type); + when others => + raise Internal_Error; + end case; + end if; when Iir_Out_Mode | Iir_Inout_Mode => Nbr_Inout := Nbr_Inout + 1; Actual := Get_Actual (Assoc); @@ -1322,8 +1397,6 @@ package body Synth.Stmts is when Iir_Kind_Interface_File_Declaration => raise Internal_Error; end case; - - Next_Association_Interface (Assoc, Assoc_Inter); end loop; end Synth_Subprogram_Association; |