diff options
| -rw-r--r-- | canon.adb | 63 | ||||
| -rw-r--r-- | canon.ads | 3 | ||||
| -rw-r--r-- | translate/ghdldrv/ghdlsimul.adb | 1 | ||||
| -rw-r--r-- | translate/translation.adb | 24 |
4 files changed, 27 insertions, 64 deletions
@@ -48,9 +48,8 @@ package body Canon is (Interface_Chain: Iir; Association_Chain: Iir; Loc : Iir) return Iir; - function Canon_Association_Chain_And_Actuals - (Interface_Chain : Iir; Association_Chain : Iir; Loc : Iir) - return Iir; + -- Like Canon_Subprogram_Call, but recurse on actuals. + procedure Canon_Subprogram_Call_And_Actuals (Call : Iir); -- Canonicalize block configuration CONF. -- TOP is used to added dependences to the design unit which CONF @@ -612,23 +611,10 @@ package body Canon is end if; when Iir_Kind_Function_Call => - declare - Imp : Iir; - Assoc_Chain : Iir; - begin - Imp := Get_Implementation (Expr); - if Get_Kind (Imp) /= Iir_Kind_Implicit_Function_Declaration then - Assoc_Chain := Canon_Association_Chain_And_Actuals - (Get_Interface_Declaration_Chain (Imp), - Get_Parameter_Association_Chain (Expr), - Expr); - Set_Parameter_Association_Chain (Expr, Assoc_Chain); - else - -- FIXME: - -- should canon concatenation. - null; - end if; - end; + Canon_Subprogram_Call_And_Actuals (Expr); + -- FIXME: + -- should canon concatenation. + when Iir_Kind_Type_Conversion | Iir_Kind_Qualified_Expression => Canon_Expression (Get_Expression (Expr)); @@ -843,19 +829,7 @@ package body Canon is end loop; end Canon_Association_Chain_Actuals; - function Canon_Association_Chain_And_Actuals - (Interface_Chain : Iir; Association_Chain : Iir; Loc : Iir) - return Iir - is - Res : Iir; - begin - Res := Canon_Association_Chain - (Interface_Chain, Association_Chain, Loc); - Canon_Association_Chain_Actuals (Res); - return Res; - end Canon_Association_Chain_And_Actuals; - - function Canon_Subprogram_Call (Call : Iir) return Iir + procedure Canon_Subprogram_Call (Call : Iir) is Imp : Iir; Assoc_Chain : Iir; @@ -866,9 +840,14 @@ package body Canon is Assoc_Chain := Get_Parameter_Association_Chain (Call); Assoc_Chain := Canon_Association_Chain (Inter_Chain, Assoc_Chain, Call); Set_Parameter_Association_Chain (Call, Assoc_Chain); - return Assoc_Chain; end Canon_Subprogram_Call; + procedure Canon_Subprogram_Call_And_Actuals (Call : Iir) is + begin + Canon_Subprogram_Call (Call); + Canon_Association_Chain_Actuals (Get_Parameter_Association_Chain (Call)); + end Canon_Subprogram_Call_And_Actuals; + -- Create a default association list for INTERFACE_LIST. -- The default is a list of interfaces associated with open. function Canon_Default_Association_Chain (Interface_Chain : Iir) @@ -938,17 +917,6 @@ package body Canon is -- Inner loop if any; used to canonicalize exit/next statement. Cur_Loop : Iir; - procedure Canon_Procedure_Call (Call : Iir_Procedure_Call) - is - Assoc_Chain : Iir; - begin - Assoc_Chain := Canon_Association_Chain_And_Actuals - (Get_Interface_Declaration_Chain (Get_Implementation (Call)), - Get_Parameter_Association_Chain (Call), - Call); - Set_Parameter_Association_Chain (Call, Assoc_Chain); - end Canon_Procedure_Call; - procedure Canon_Sequential_Stmts (First : Iir) is Stmt: Iir; @@ -1060,7 +1028,7 @@ package body Canon is end if; when Iir_Kind_Procedure_Call_Statement => - Canon_Procedure_Call (Get_Procedure_Call (Stmt)); + Canon_Subprogram_Call_And_Actuals (Get_Procedure_Call (Stmt)); when Iir_Kind_Null_Statement => null; @@ -1249,9 +1217,6 @@ package body Canon is end case; Assoc := Get_Chain (Assoc); end loop; - if Get_Nbr_Elements (Sensitivity_List) = 0 then - Destroy_Iir_List (Sensitivity_List); - end if; if Is_Sensitized then Set_Sensitivity_List (Proc, Sensitivity_List); else @@ -49,8 +49,7 @@ package Canon is return Iir_Design_Unit; -- Canonicalize a subprogram call. - -- Return the new association chain. - function Canon_Subprogram_Call (Call : Iir) return Iir; + procedure Canon_Subprogram_Call (Call : Iir); -- Compute the sensivity list of EXPR and add it to SENSIVITY_LIST. -- If IS_TARGET is true, the longuest static prefix of the signal name diff --git a/translate/ghdldrv/ghdlsimul.adb b/translate/ghdldrv/ghdlsimul.adb index 9cc36717e..0e8f29660 100644 --- a/translate/ghdldrv/ghdlsimul.adb +++ b/translate/ghdldrv/ghdlsimul.adb @@ -67,6 +67,7 @@ package body Ghdlsimul is Annotations.Annotate (Std_Package.Std_Standard_Unit); Canon.Canon_Flag_Add_Labels := True; + Canon.Canon_Flag_Sequentials_Stmts := True; end Compile_Init; procedure Compile_Elab diff --git a/translate/translation.adb b/translate/translation.adb index d8d1cc504..50e047c11 100644 --- a/translate/translation.adb +++ b/translate/translation.adb @@ -6209,8 +6209,7 @@ package body Translation is Info.Type_Mode := Type_Mode_File; end Translate_File_Type; - function Get_File_Signature_Length (Def : Iir) return Natural - is + function Get_File_Signature_Length (Def : Iir) return Natural is begin case Get_Kind (Def) is when Iir_Kinds_Scalar_Type_Definition => @@ -6282,17 +6281,16 @@ package body Translation is procedure Create_File_Type_Var (Def : Iir_File_Type_Definition) is - Type_Name : Iir; + Type_Name : constant Iir := Get_Type_Mark (Def); Info : Type_Info_Acc; begin - Type_Name := Get_Type_Mark (Def); if Get_Kind (Type_Name) in Iir_Kinds_Scalar_Type_Definition then return; end if; declare Len : constant Natural := Get_File_Signature_Length (Type_Name); Sig : String (1 .. Len + 2); - Off : Natural := 1; + Off : Natural := Sig'First; begin Get_File_Signature (Type_Name, Sig, Off); Sig (Len + 1) := '.'; @@ -13662,7 +13660,8 @@ package body Translation is -- FIXME : to be done raise Internal_Error; else - Assoc_Chain := Canon.Canon_Subprogram_Call (Name); + Canon.Canon_Subprogram_Call (Name); + Assoc_Chain := Get_Parameter_Association_Chain (Name); Obj := Get_Method_Object (Name); return E2M (Chap7.Translate_Function_Call (Imp, Assoc_Chain, Obj), @@ -16733,7 +16732,8 @@ package body Translation is (Imp, Left, Right, Res_Type, Expr); end; else - Assoc_Chain := Canon.Canon_Subprogram_Call (Expr); + Canon.Canon_Subprogram_Call (Expr); + Assoc_Chain := Get_Parameter_Association_Chain (Expr); Res := Translate_Function_Call (Imp, Assoc_Chain, Get_Method_Object (Expr)); Expr_Type := Get_Return_Type (Imp); @@ -20323,8 +20323,8 @@ package body Translation is Iir_Chains.Get_Chain_Length (Assoc_Chain); Params : Mnode_Array (0 .. Nbr_Assoc - 1); E_Params : O_Enode_Array (0 .. Nbr_Assoc - 1); - Imp : Iir; - Info : Subprg_Info_Acc; + Imp : constant Iir := Get_Implementation (Stmt); + Info : constant Subprg_Info_Acc := Get_Info (Imp); Res : O_Dnode; El : Iir; Pos : Natural; @@ -20346,9 +20346,6 @@ package body Translation is Bounds : O_Enode; Obj : Iir; begin - Imp := Get_Implementation (Stmt); - Info := Get_Info (Imp); - -- Create an in-out result record for in-out arguments passed by -- value. if Info.Res_Record_Type /= O_Tnode_Null then @@ -21564,7 +21561,8 @@ package body Translation is Imp : Iir; begin Call := Get_Procedure_Call (Stmt); - Assocs := Canon.Canon_Subprogram_Call (Call); + Canon.Canon_Subprogram_Call (Call); + Assocs := Get_Parameter_Association_Chain (Call); Imp := Get_Implementation (Call); if Get_Kind (Imp) = Iir_Kind_Implicit_Procedure_Declaration then |