diff options
author | Tristan Gingold <tgingold@free.fr> | 2015-06-05 22:04:42 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2015-06-05 22:04:42 +0200 |
commit | 463e00e93d8b2507519310789ea9e4fc668cc4ac (patch) | |
tree | 3292cbb3bd7ef34156c1768b7719e828078eeeab | |
parent | b250273b27b71e2096f05fe4669dae42d83f4e26 (diff) | |
download | ghdl-463e00e93d8b2507519310789ea9e4fc668cc4ac.tar.gz ghdl-463e00e93d8b2507519310789ea9e4fc668cc4ac.tar.bz2 ghdl-463e00e93d8b2507519310789ea9e4fc668cc4ac.zip |
Rework procedure calls, now use a record to pass parameters.
-rw-r--r-- | src/grt/grt-files.adb | 12 | ||||
-rw-r--r-- | src/grt/grt-files.ads | 12 | ||||
-rw-r--r-- | src/grt/grt-lib.adb | 12 | ||||
-rw-r--r-- | src/grt/grt-lib.ads | 12 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap2.adb | 154 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap4.adb | 27 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap4.ads | 3 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap6.adb | 35 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap8.adb | 388 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap9.adb | 3 | ||||
-rw-r--r-- | src/vhdl/translate/trans.ads | 20 |
11 files changed, 311 insertions, 367 deletions
diff --git a/src/grt/grt-files.adb b/src/grt/grt-files.adb index 14dde9702..46d3cedac 100644 --- a/src/grt/grt-files.adb +++ b/src/grt/grt-files.adb @@ -384,16 +384,15 @@ package body Grt.Files is end Ghdl_Text_Read_Length; procedure Ghdl_Untruncated_Text_Read - (Res : Ghdl_Untruncated_Text_Read_Result_Acc; - File : Ghdl_File_Index; - Str : Std_String_Ptr) + (Params : Ghdl_Untruncated_Text_Read_Params_Acc) is + Str : constant Std_String_Ptr := Params.Str; Stream : C_Files; Len : int; Idx : Ghdl_Index_Type; begin - Stream := Get_File (File); - Check_File_Mode (File, True); + Stream := Get_File (Params.File); + Check_File_Mode (Params.File, True); Len := int (Str.Bounds.Dim_1.Length); if fgets (Str.Base (0)'Address, Len, Stream) = Null_Address then Internal_Error ("ghdl_untruncated_text_read: end of file"); @@ -405,7 +404,7 @@ package body Grt.Files is exit; end if; end loop; - Res.Len := Std_Integer (Idx); + Params.Len := Std_Integer (Idx); end Ghdl_Untruncated_Text_Read; procedure File_Close (File : Ghdl_File_Index; Is_Text : Boolean) @@ -447,4 +446,3 @@ package body Grt.Files is fflush (Stream); end Ghdl_File_Flush; end Grt.Files; - diff --git a/src/grt/grt-files.ads b/src/grt/grt-files.ads index 14f998468..3fadc981e 100644 --- a/src/grt/grt-files.ads +++ b/src/grt/grt-files.ads @@ -75,17 +75,17 @@ package Grt.Files is function Ghdl_Text_Read_Length (File : Ghdl_File_Index; Str : Std_String_Ptr) return Std_Integer; - type Ghdl_Untruncated_Text_Read_Result is record + type Ghdl_Untruncated_Text_Read_Params is record + File : Ghdl_File_Index; + Str : Std_String_Ptr; Len : Std_Integer; end record; - type Ghdl_Untruncated_Text_Read_Result_Acc is - access Ghdl_Untruncated_Text_Read_Result; + type Ghdl_Untruncated_Text_Read_Params_Acc is + access Ghdl_Untruncated_Text_Read_Params; procedure Ghdl_Untruncated_Text_Read - (Res : Ghdl_Untruncated_Text_Read_Result_Acc; - File : Ghdl_File_Index; - Str : Std_String_Ptr); + (Params : Ghdl_Untruncated_Text_Read_Params_Acc); procedure Ghdl_Text_File_Close (File : Ghdl_File_Index); procedure Ghdl_File_Close (File : Ghdl_File_Index); diff --git a/src/grt/grt-lib.adb b/src/grt/grt-lib.adb index d2b095c67..b4505adb6 100644 --- a/src/grt/grt-lib.adb +++ b/src/grt/grt-lib.adb @@ -272,25 +272,25 @@ package body Grt.Lib is end Ghdl_Get_Resolution_Limit; procedure Ghdl_Control_Simulation - (Stop : Ghdl_B1; Has_Status : Ghdl_B1; Status : Std_Integer) is + (Params : Ghdl_Control_Simulation_Params_Ptr) is begin Report_H; -- Report_C (Grt.Options.Progname); Report_C ("simulation "); - if Stop then + if Params.Stop then Report_C ("stopped"); else Report_C ("finished"); end if; Report_C (" @"); Report_Now_C; - if Has_Status then + if Params.Has_Status then Report_C (" with status "); - Report_C (Integer (Status)); + Report_C (Integer (Params.Status)); end if; Report_E (""); - if Has_Status then - Exit_Status := Integer (Status); + if Params.Has_Status then + Exit_Status := Integer (Params.Status); end if; Exit_Simulation; end Ghdl_Control_Simulation; diff --git a/src/grt/grt-lib.ads b/src/grt/grt-lib.ads index 50be6a7a6..dcd2c55b7 100644 --- a/src/grt/grt-lib.ads +++ b/src/grt/grt-lib.ads @@ -94,8 +94,18 @@ package Grt.Lib is ); function Ghdl_Get_Resolution_Limit return Std_Time; + + type Ghdl_Control_Simulation_Params is record + Stop : Ghdl_B1; + Has_Status : Ghdl_B1; + Status : Std_Integer; + end record; + + type Ghdl_Control_Simulation_Params_Ptr is access + Ghdl_Control_Simulation_Params; + procedure Ghdl_Control_Simulation - (Stop : Ghdl_B1; Has_Status : Ghdl_B1; Status : Std_Integer); + (Params : Ghdl_Control_Simulation_Params_Ptr); private pragma Export (C, Ghdl_Memcpy, "__ghdl_memcpy"); diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb index e0c19c606..a43179e78 100644 --- a/src/vhdl/translate/trans-chap2.adb +++ b/src/vhdl/translate/trans-chap2.adb @@ -38,8 +38,8 @@ package body Trans.Chap2 is procedure Elab_Package (Spec : Iir_Package_Declaration); - type Name_String_Xlat_Array is array (Name_Id range <>) of - String (1 .. 4); + type Name_String_Xlat_Array is array (Name_Id range <>) of String (1 .. 4); + Operator_String_Xlat : constant Name_String_Xlat_Array (Std_Names.Name_Id_Operators) := (Std_Names.Name_Op_Equality => "OPEq", @@ -66,11 +66,10 @@ package body Trans.Chap2 is -- overload number if any. procedure Push_Subprg_Identifier (Spec : Iir; Mark : out Id_Mark_Type) is - Id : Name_Id; + Id : constant Name_Id := Get_Identifier (Spec); begin -- FIXME: name_shift_operators, name_logical_operators, -- name_word_operators, name_mod, name_rem - Id := Get_Identifier (Spec); if Id in Std_Names.Name_Id_Operators then Push_Identifier_Prefix (Mark, Operator_String_Xlat (Id), Get_Overload_Number (Spec)); @@ -109,7 +108,6 @@ package body Trans.Chap2 is end loop; end Elab_Subprogram_Interfaces; - -- Return the type of a subprogram interface. -- Return O_Tnode_Null if the parameter is passed through the -- interface record. @@ -141,21 +139,19 @@ package body Trans.Chap2 is procedure Translate_Subprogram_Declaration (Spec : Iir) is - Info : constant Subprg_Info_Acc := Get_Info (Spec); - Is_Func : constant Boolean := + Info : constant Subprg_Info_Acc := Get_Info (Spec); + Is_Func : constant Boolean := Get_Kind (Spec) = Iir_Kind_Function_Declaration; - Inter : Iir; - Inter_Type : Iir; - Arg_Info : Ortho_Info_Acc; - Tinfo : Type_Info_Acc; - Interface_List : O_Inter_List; - Has_Result_Record : Boolean; - El_List : O_Element_List; - Mark : Id_Mark_Type; - Rtype : Iir; - Id : O_Ident; - Storage : O_Storage; - Foreign : Foreign_Info_Type := Foreign_Bad; + Inter : Iir; + Arg_Info : Ortho_Info_Acc; + Tinfo : Type_Info_Acc; + Interface_List : O_Inter_List; + El_List : O_Element_List; + Mark : Id_Mark_Type; + Rtype : Iir; + Id : O_Ident; + Storage : O_Storage; + Foreign : Foreign_Info_Type := Foreign_Bad; begin -- Set the identifier prefix with the subprogram identifier and -- overload number if any. @@ -210,54 +206,37 @@ package body Trans.Chap2 is -- For parameters passed via copy and that needs a copy-out, -- gather them in a record. An access to the record is then -- passed to the procedure. - Has_Result_Record := False; Inter := Get_Interface_Declaration_Chain (Spec); - while Inter /= Null_Iir loop - Arg_Info := Add_Info (Inter, Kind_Interface); - Inter_Type := Get_Type (Inter); - Tinfo := Get_Info (Inter_Type); - if Get_Kind (Inter) = Iir_Kind_Interface_Variable_Declaration - and then Get_Mode (Inter) in Iir_Out_Modes - and then Tinfo.Type_Mode not in Type_Mode_By_Ref - and then Tinfo.Type_Mode /= Type_Mode_File - then - -- This interface is done via the result record. - -- Note: file passed through variables are vhdl87 files, - -- which are initialized at elaboration and thus - -- behave like an IN parameter. - if not Has_Result_Record then - -- Create the record. - Start_Record_Type (El_List); - Has_Result_Record := True; - end if; - -- Add a field to the record. + if Inter /= Null_Iir then + Start_Record_Type (El_List); + while Inter /= Null_Iir loop + Arg_Info := Add_Info (Inter, Kind_Interface); New_Record_Field (El_List, Arg_Info.Interface_Field, Create_Identifier_Without_Prefix (Inter), - Tinfo.Ortho_Type (Mode_Value)); - else - Arg_Info.Interface_Field := O_Fnode_Null; - end if; - Inter := Get_Chain (Inter); - end loop; - if Has_Result_Record then + Translate_Interface_Type (Inter)); + Inter := Get_Chain (Inter); + end loop; -- Declare the record type and an access to the record. - Finish_Record_Type (El_List, Info.Res_Record_Type); - New_Type_Decl (Create_Identifier ("RESTYPE"), - Info.Res_Record_Type); - Info.Res_Record_Ptr := New_Access_Type (Info.Res_Record_Type); - New_Type_Decl (Create_Identifier ("RESPTR"), - Info.Res_Record_Ptr); + Finish_Record_Type (El_List, Info.Subprg_Params_Type); + New_Type_Decl (Create_Identifier ("PARAMSTYPE"), + Info.Subprg_Params_Type); + Info.Subprg_Params_Ptr := + New_Access_Type (Info.Subprg_Params_Type); + New_Type_Decl (Create_Identifier ("PARAMSPTR"), + Info.Subprg_Params_Ptr); else - Info.Res_Interface := O_Dnode_Null; + Info.Subprg_Params_Type := O_Tnode_Null; + Info.Subprg_Params_Ptr := O_Tnode_Null; end if; Start_Procedure_Decl (Interface_List, Id, Storage); - if Has_Result_Record then - -- Add the record parameter. + if Info.Subprg_Params_Type /= O_Tnode_Null then New_Interface_Decl (Interface_List, Info.Res_Interface, - Get_Identifier ("RESULT"), - Info.Res_Record_Ptr); + Get_Identifier ("PARAMS"), + Info.Subprg_Params_Ptr); + else + Info.Res_Interface := O_Dnode_Null; end if; end if; @@ -267,27 +246,21 @@ package body Trans.Chap2 is end if; -- Translate interfaces. - Inter := Get_Interface_Declaration_Chain (Spec); - while Inter /= Null_Iir loop - if Is_Func then + if Is_Func then + Inter := Get_Interface_Declaration_Chain (Spec); + while Inter /= Null_Iir loop -- Create the info. Arg_Info := Add_Info (Inter, Kind_Interface); Arg_Info.Interface_Field := O_Fnode_Null; - else - -- The info was already created (just above) - Arg_Info := Get_Info (Inter); - end if; - if Arg_Info.Interface_Field = O_Fnode_Null then - -- Not via the RESULT parameter. Arg_Info.Interface_Type := Translate_Interface_Type (Inter); New_Interface_Decl (Interface_List, Arg_Info.Interface_Node, Create_Identifier_Without_Prefix (Inter), Arg_Info.Interface_Type); - end if; - Inter := Get_Chain (Inter); - end loop; + Inter := Get_Chain (Inter); + end loop; + end if; Finish_Subprogram_Decl (Interface_List, Info.Ortho_Func); -- Call the hook for foreign subprograms. @@ -411,10 +384,10 @@ package body Trans.Chap2 is Push_Instance_Factory (Info.Subprg_Frame_Scope'Access); Add_Subprg_Instance_Field (Upframe_Field); - if Info.Res_Record_Ptr /= O_Tnode_Null then - Info.Res_Record_Var := + if Info.Subprg_Params_Ptr /= O_Tnode_Null then + Info.Subprg_Params_Var := Create_Var (Create_Var_Identifier ("RESULT"), - Info.Res_Record_Ptr); + Info.Subprg_Params_Ptr); end if; -- Create fields for parameters. @@ -501,14 +474,14 @@ package body Trans.Chap2 is Subprgs.Set_Subprg_Instance_Field (Frame_Ptr, Upframe_Field, Info.Subprg_Instance); - if Info.Res_Record_Type /= O_Tnode_Null then + if Info.Subprg_Params_Type /= O_Tnode_Null then -- Initialize the RESULT field - New_Assign_Stmt (Get_Var (Info.Res_Record_Var), + New_Assign_Stmt (Get_Var (Info.Subprg_Params_Var), New_Obj_Value (Info.Res_Interface)); -- Do not reference the RESULT field in the subprogram body, -- directly reference the RESULT parameter. -- FIXME: has a flag (see below for parameters). - Info.Res_Record_Var := Null_Var; + Info.Subprg_Params_Var := Null_Var; end if; -- Copy parameters to FRAME. @@ -535,31 +508,6 @@ package body Trans.Chap2 is end; end if; - -- Init out parameters passed by value/copy. - declare - Inter : Iir; - Inter_Type : Iir; - Type_Info : Type_Info_Acc; - begin - Inter := Get_Interface_Declaration_Chain (Spec); - while Inter /= Null_Iir loop - if Get_Kind (Inter) = Iir_Kind_Interface_Variable_Declaration - and then Get_Mode (Inter) = Iir_Out_Mode - then - Inter_Type := Get_Type (Inter); - Type_Info := Get_Info (Inter_Type); - if (Type_Info.Type_Mode in Type_Mode_By_Value - or Type_Info.Type_Mode in Type_Mode_By_Copy) - and then Type_Info.Type_Mode /= Type_Mode_File - then - Chap4.Init_Object - (Chap6.Translate_Name (Inter), Inter_Type); - end if; - end if; - Inter := Get_Chain (Inter); - end loop; - end; - Chap4.Elab_Declaration_Chain (Subprg, Final); -- If finalization is required, create a dummy loop around the @@ -922,9 +870,9 @@ package body Trans.Chap2 is Use_Stack2 => Src.Use_Stack2, Ortho_Func => Src.Ortho_Func, Res_Interface => Src.Res_Interface, - Res_Record_Var => Instantiate_Var (Src.Res_Record_Var), - Res_Record_Type => Src.Res_Record_Type, - Res_Record_Ptr => Src.Res_Record_Ptr, + Subprg_Params_Var => Instantiate_Var (Src.Subprg_Params_Var), + Subprg_Params_Type => Src.Subprg_Params_Type, + Subprg_Params_Ptr => Src.Subprg_Params_Ptr, Subprg_Frame_Scope => Dest.Subprg_Frame_Scope, Subprg_Instance => Instantiate_Subprg_Instance (Src.Subprg_Instance), diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb index 2e330338e..d9de806eb 100644 --- a/src/vhdl/translate/trans-chap4.adb +++ b/src/vhdl/translate/trans-chap4.adb @@ -358,19 +358,28 @@ package body Trans.Chap4 is New_Procedure_Call (Assoc); end Fini_Protected_Object; - procedure Init_Object (Obj : Mnode; Obj_Type : Iir) + function Get_Scalar_Initial_Value (Atype : Iir) return O_Enode is - Tinfo : Type_Info_Acc; + Tinfo : constant Type_Info_Acc := Get_Info (Atype); begin - Tinfo := Get_Type_Info (Obj); case Tinfo.Type_Mode is when Type_Mode_Scalar => - New_Assign_Stmt - (M2Lv (Obj), Chap14.Translate_Left_Type_Attribute (Obj_Type)); + return Chap14.Translate_Left_Type_Attribute (Atype); when Type_Mode_Acc => - New_Assign_Stmt - (M2Lv (Obj), - New_Lit (New_Null_Access (Tinfo.Ortho_Type (Mode_Value)))); + return New_Lit (New_Null_Access (Tinfo.Ortho_Type (Mode_Value))); + when others => + Error_Kind ("get_scalar_initial_value", Atype); + end case; + end Get_Scalar_Initial_Value; + + procedure Init_Object (Obj : Mnode; Obj_Type : Iir) + is + Tinfo : constant Type_Info_Acc := Get_Type_Info (Obj); + begin + case Tinfo.Type_Mode is + when Type_Mode_Scalar + | Type_Mode_Acc => + New_Assign_Stmt (M2Lv (Obj), Get_Scalar_Initial_Value (Obj_Type)); when Type_Mode_Fat_Acc => declare Dinfo : Type_Info_Acc; @@ -814,7 +823,7 @@ package body Trans.Chap4 is if Data.Has_Val then Init_Val := M2E (Data.Val); else - Init_Val := Chap14.Translate_Left_Type_Attribute (Targ_Type); + Init_Val := Get_Scalar_Initial_Value (Targ_Type); end if; Start_Association (Assoc, Create_Subprg); diff --git a/src/vhdl/translate/trans-chap4.ads b/src/vhdl/translate/trans-chap4.ads index 129942437..6f9b8aefc 100644 --- a/src/vhdl/translate/trans-chap4.ads +++ b/src/vhdl/translate/trans-chap4.ads @@ -87,6 +87,9 @@ package Trans.Chap4 is -- Allocate the storage for OBJ, if necessary. procedure Elab_Object_Storage (Obj : Iir); + -- For a scalar or access type ATYPE, return the default initial value. + function Get_Scalar_Initial_Value (Atype : Iir) return O_Enode; + -- Initialize NAME/OBJ with VALUE. procedure Elab_Object_Init (Name : Mnode; Obj : Iir; Value : Iir); diff --git a/src/vhdl/translate/trans-chap6.adb b/src/vhdl/translate/trans-chap6.adb index 4b89cecc2..96e7b394f 100644 --- a/src/vhdl/translate/trans-chap6.adb +++ b/src/vhdl/translate/trans-chap6.adb @@ -771,18 +771,17 @@ package body Trans.Chap6 is Linter : O_Lnode; begin if Info.Interface_Node = O_Dnode_Null then - -- The parameter is passed via a field of the RESULT + -- The parameter is passed via a field of the PARAMS -- record parameter. - if Subprg_Info.Res_Record_Var = Null_Var then + if Subprg_Info.Subprg_Params_Var = Null_Var then + -- Direct access to the parameter. Linter := New_Obj (Subprg_Info.Res_Interface); else - -- Unnesting case. - Linter := Get_Var (Subprg_Info.Res_Record_Var); + -- Unnesting case: upscope access. + Linter := Get_Var (Subprg_Info.Subprg_Params_Var); end if; - return Lv2M (New_Selected_Element - (New_Acc_Value (Linter), - Info.Interface_Field), - Type_Info, Kind); + Linter := New_Selected_Element + (New_Acc_Value (Linter), Info.Interface_Field); else -- Unnesting case: the parameter was copied in the -- subprogram frame so that nested subprograms can @@ -790,17 +789,17 @@ package body Trans.Chap6 is Linter := New_Selected_Element (Get_Instance_Ref (Subprg_Info.Subprg_Frame_Scope), Info.Interface_Field); - case Type_Info.Type_Mode is - when Type_Mode_Unknown => - raise Internal_Error; - when Type_Mode_By_Value => - return Lv2M (Linter, Type_Info, Kind); - when Type_Mode_By_Copy - | Type_Mode_By_Ref => - -- Parameter is passed by reference. - return Lp2M (Linter, Type_Info, Kind); - end case; end if; + case Type_Info.Type_Mode is + when Type_Mode_Unknown => + raise Internal_Error; + when Type_Mode_By_Value => + return Lv2M (Linter, Type_Info, Kind); + when Type_Mode_By_Copy + | Type_Mode_By_Ref => + -- Parameter is passed by reference. + return Lp2M (Linter, Type_Info, Kind); + end case; end; end if; when others => diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb index 283ffbcdb..8a3711ee2 100644 --- a/src/vhdl/translate/trans-chap8.adb +++ b/src/vhdl/translate/trans-chap8.adb @@ -1608,11 +1608,11 @@ package body Trans.Chap8 is end case; end Translate_Implicit_Procedure_Call; - function Do_Conversion (Conv : Iir; Expr : Iir; Src : Mnode) return O_Enode - is + function Do_Conversion (Conv : Iir; Expr : Iir; Src : O_Enode) + return O_Enode is begin if Conv = Null_Iir then - return M2E (Src); + return Src; -- case Get_Type_Info (Dest).Type_Mode is -- when Type_Mode_Thin => -- New_Assign_Stmt (M2Lv (Dest), M2E (Src)); @@ -1647,7 +1647,7 @@ package body Trans.Chap8 is Subprgs.Add_Subprg_Instance_Assoc (Constr, Conv_Info.Subprg_Instance); - New_Association (Constr, M2E (Src)); + New_Association (Constr, Src); if Conv_Info.Res_Interface /= O_Dnode_Null then -- Composite result. @@ -1660,28 +1660,65 @@ package body Trans.Chap8 is end; when Iir_Kind_Type_Conversion => return Chap7.Translate_Type_Conversion - (M2E (Src), Get_Type (Expr), - Get_Type (Conv), Null_Iir); + (Src, Get_Type (Expr), Get_Type (Conv), Null_Iir); when others => Error_Kind ("do_conversion", Conv); end case; end if; end Do_Conversion; + -- Translate the formal name FORMAL_NAME of an individual association but + -- replace the interface name by INTER_VAR. FORMAL_INFO is the info of + -- the interface. This is used to access to a sub-element of the variable + -- representing the whole actual. + function Translate_Individual_Association_Formal + (Formal_Name : Iir; + Formal_Info : Ortho_Info_Acc; + Inter_Var : Mnode) + return Mnode + is + Prev_Node : O_Dnode; + Prev_Field : O_Fnode; + Res : Mnode; + begin + -- Change the formal variable so that it is the local variable + -- that will be passed to the subprogram. + Prev_Node := Formal_Info.Interface_Node; + Prev_Field := Formal_Info.Interface_Field; + + -- We need a pointer since the interface is by reference. + Formal_Info.Interface_Node := M2Dp (Inter_Var); + Formal_Info.Interface_Field := O_Fnode_Null; + + Res := Chap6.Translate_Name (Formal_Name); + + Formal_Info.Interface_Node := Prev_Node; + Formal_Info.Interface_Field := Prev_Field; + + return Res; + end Translate_Individual_Association_Formal; + function Translate_Subprogram_Call (Imp : Iir; Assoc_Chain : Iir; Obj : Iir) return O_Enode is Is_Procedure : constant Boolean := Get_Kind (Imp) = Iir_Kind_Procedure_Declaration; Is_Function : constant Boolean := not Is_Procedure; + Info : constant Subprg_Info_Acc := Get_Info (Imp); + type Mnode_Array is array (Natural range <>) of Mnode; type O_Enode_Array is array (Natural range <>) of O_Enode; Nbr_Assoc : constant Natural := Iir_Chains.Get_Chain_Length (Assoc_Chain); + + -- References to the formals (for copy-out), and variables for whole + -- actual of individual associations. Params : Mnode_Array (0 .. Nbr_Assoc - 1); + + -- The values of actuals. E_Params : O_Enode_Array (0 .. Nbr_Assoc - 1); - Info : constant Subprg_Info_Acc := Get_Info (Imp); - Copy_Out : O_Dnode; + + Params_Var : O_Dnode; Res : Mnode; El : Iir; Pos : Natural; @@ -1689,17 +1726,17 @@ package body Trans.Chap8 is Act : Iir; Actual_Type : Iir; Formal : Iir; + Mode : Iir_Mode; Base_Formal : Iir; Formal_Type : Iir; Ftype_Info : Type_Info_Acc; - Ftype_Binfo : Type_Info_Acc; Formal_Info : Ortho_Info_Acc; Val : O_Enode; Param : Mnode; + Param_Type : Iir; Last_Individual : Natural; Ptr : O_Lnode; In_Conv : Iir; - In_Expr : Iir; Out_Conv : Iir; Out_Expr : Iir; Formal_Object_Kind : Object_Kind_Type; @@ -1724,12 +1761,11 @@ package body Trans.Chap8 is end; end if; - -- Create an in-out result record for in-out arguments passed by - -- value. - if Is_Procedure and then Info.Res_Record_Type /= O_Tnode_Null then - Copy_Out := Create_Temp (Info.Res_Record_Type); + -- Create the variable containing the parameters (only for procedures). + if Is_Procedure and then Info.Subprg_Params_Type /= O_Tnode_Null then + Params_Var := Create_Temp (Info.Subprg_Params_Type); else - Copy_Out := O_Dnode_Null; + Params_Var := O_Dnode_Null; end if; -- Evaluate in-out parameters and parameters passed by ref, since @@ -1742,145 +1778,138 @@ package body Trans.Chap8 is Params (Pos) := Mnode_Null; E_Params (Pos) := O_Enode_Null; - Formal := Get_Formal (El); - if Get_Kind (Formal) in Iir_Kinds_Denoting_Name then - Formal := Get_Named_Entity (Formal); - end if; + Formal := Strip_Denoting_Name (Get_Formal (El)); Base_Formal := Get_Association_Interface (El); Formal_Type := Get_Type (Formal); Formal_Info := Get_Info (Base_Formal); + Ftype_Info := Get_Info (Formal_Type); + if Get_Kind (Base_Formal) = Iir_Kind_Interface_Signal_Declaration then Formal_Object_Kind := Mode_Signal; else Formal_Object_Kind := Mode_Value; end if; - Ftype_Info := Get_Info (Formal_Type); - Ftype_Binfo := Get_Info (Get_Base_Type (Formal_Type)); case Get_Kind (El) is when Iir_Kind_Association_Element_Open => Act := Get_Default_Value (Formal); In_Conv := Null_Iir; - Out_Conv := Null_Iir; when Iir_Kind_Association_Element_By_Expression => Act := Get_Actual (El); In_Conv := Get_In_Conversion (El); - Out_Conv := Get_Out_Conversion (El); when Iir_Kind_Association_Element_By_Individual => Actual_Type := Get_Actual_Type (El); - -- A non-composite type cannot be associated by element. - pragma Assert (Formal_Info.Interface_Field = O_Fnode_Null); - if Ftype_Info.Type_Mode = Type_Mode_Fat_Array then + -- Create the constraints and then the object. Chap3.Create_Array_Subtype (Actual_Type, True); Bounds := Chap3.Get_Array_Type_Bounds (Actual_Type); Param := Create_Temp (Ftype_Info, Formal_Object_Kind); Chap3.Translate_Object_Allocation (Param, Alloc_Stack, Formal_Type, Bounds); else + -- Create the object. Param := Create_Temp (Ftype_Info, Formal_Object_Kind); Chap4.Allocate_Complex_Object (Formal_Type, Alloc_Stack, Param); end if; + + -- Save the object as it will be used by the following + -- associations. Last_Individual := Pos; Params (Pos) := Param; + + if Formal_Info.Interface_Field /= O_Fnode_Null then + -- Set the PARAMS field. + Ptr := New_Selected_Element + (New_Obj (Params_Var), Formal_Info.Interface_Field); + New_Assign_Stmt (Ptr, M2E (Param)); + end if; + goto Continue; when others => Error_Kind ("translate_procedure_call", El); end case; Actual_Type := Get_Type (Act); - if Formal_Info.Interface_Field /= O_Fnode_Null then - -- Copy-out argument. - -- This is not a composite type. - Param := Chap6.Translate_Name (Act); - pragma Assert (Get_Object_Kind (Param) = Mode_Value); - Params (Pos) := Stabilize (Param); - if In_Conv /= Null_Iir - or else Get_Mode (Formal) = Iir_Inout_Mode - then - -- Arguments may be assigned if there is an in conversion. - Ptr := New_Selected_Element - (New_Obj (Copy_Out), Formal_Info.Interface_Field); - Param := Lv2M (Ptr, Ftype_Info, Mode_Value); - if In_Conv /= Null_Iir then - In_Expr := In_Conv; + -- Evaluate the actual. + Param_Type := Actual_Type; + case Get_Kind (Base_Formal) is + when Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_File_Declaration => + -- No conversion here. + pragma Assert (In_Conv = Null_Iir); + Val := Chap7.Translate_Expression (Act, Formal_Type); + Param_Type := Formal_Type; + when Iir_Kind_Interface_Signal_Declaration => + -- No conversion. + Param := Chap6.Translate_Name (Act); + Val := M2E (Param); + when Iir_Kind_Interface_Variable_Declaration => + Mode := Get_Mode (Base_Formal); + if Mode = Iir_In_Mode then + Val := Chap7.Translate_Expression (Act); else - In_Expr := Act; - end if; - Chap7.Translate_Assign - (Param, - Do_Conversion (In_Conv, Act, Params (Pos)), - In_Expr, - Formal_Type, El); - end if; - elsif Ftype_Binfo.Type_Mode not in Type_Mode_By_Value then - -- Passed by reference. - case Get_Kind (Base_Formal) is - when Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Interface_File_Declaration => - -- No conversion here. - E_Params (Pos) := - Chap7.Translate_Expression (Act, Formal_Type); - when Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_Signal_Declaration => Param := Chap6.Translate_Name (Act); - -- Atype may not have been set (eg: slice). - if Base_Formal /= Formal then + if Base_Formal /= Formal + or else Ftype_Info.Type_Mode in Type_Mode_By_Value + then + -- For out/inout, we need to keep the reference for the + -- copy-out. Stabilize (Param); Params (Pos) := Param; end if; - E_Params (Pos) := M2E (Param); - if Formal_Type /= Actual_Type then - -- Implicit array conversion or subtype check. - E_Params (Pos) := Chap7.Translate_Implicit_Conv - (E_Params (Pos), Actual_Type, Formal_Type, - Get_Object_Kind (Param), Act); + if In_Conv = Null_Iir + and then Mode = Iir_Out_Mode + and then Ftype_Info.Type_Mode in Type_Mode_Thin + and then Ftype_Info.Type_Mode /= Type_Mode_File + then + -- Scalar OUT interface. Just give an initial value. + -- FIXME: individual association ?? + Val := Chap4.Get_Scalar_Initial_Value (Formal_Type); + Param_Type := Formal_Type; + else + Val := M2E (Param); end if; - when others => - Error_Kind ("translate_procedure_call(2)", Formal); - end case; + end if; + if In_Conv /= Null_Iir then + Val := Do_Conversion (In_Conv, Act, Val); + Act := In_Conv; + Param_Type := Get_Type (In_Conv); + end if; + when others => + Error_Kind ("translate_procedure_call(2)", Formal); + end case; + + -- Implicit conversion to formal type. + if Param_Type /= Formal_Type then + -- Implicit array conversion or subtype check. + Val := Chap7.Translate_Implicit_Conv + (Val, Param_Type, Formal_Type, Formal_Object_Kind, Act); + end if; + if Get_Kind (Base_Formal) /= Iir_Kind_Interface_Signal_Declaration + then + Val := Chap3.Maybe_Insert_Scalar_Check (Val, Act, Formal_Type); end if; + + -- Assign actual, if needed. if Base_Formal /= Formal then - -- Individual association. - if Ftype_Binfo.Type_Mode not in Type_Mode_By_Value then - -- Not by-value actual already translated. - Val := E_Params (Pos); - else - -- By value association. - Act := Get_Actual (El); - if Get_Kind (Base_Formal) - = Iir_Kind_Interface_Constant_Declaration - then - Val := Chap7.Translate_Expression (Act, Formal_Type); - else - Params (Pos) := Chap6.Translate_Name (Act); - -- Since signals are passed by reference, they are not - -- copied back, so do not stabilize them (furthermore, - -- it is not possible to stabilize them). - if Formal_Object_Kind = Mode_Value then - Params (Pos) := Stabilize (Params (Pos)); - end if; - Val := M2E (Params (Pos)); - end if; - end if; - -- Assign formal. - -- Change the formal variable so that it is the local variable - -- that will be passed to the subprogram. - declare - Prev_Node : O_Dnode; - begin - Prev_Node := Formal_Info.Interface_Node; - -- We need a pointer since the interface is by reference. - Formal_Info.Interface_Node := - M2Dp (Params (Last_Individual)); - Param := Chap6.Translate_Name (Formal); - Formal_Info.Interface_Node := Prev_Node; - end; - Chap7.Translate_Assign (Param, Val, Act, Formal_Type, El); + -- Individual association: assign the individual actual to the + -- whole actual. + Param := Translate_Individual_Association_Formal + (Formal, Formal_Info, Params (Last_Individual)); + Chap7.Translate_Assign + (Param, Val, Act, Formal_Type, El); + elsif Formal_Info.Interface_Field /= O_Fnode_Null then + -- Set the PARAMS field. + Ptr := New_Selected_Element + (New_Obj (Params_Var), Formal_Info.Interface_Field); + New_Assign_Stmt (Ptr, Val); + else + E_Params (Pos) := Val; end if; + << Continue >> null; El := Get_Chain (El); Pos := Pos + 1; @@ -1894,14 +1923,17 @@ package body Trans.Chap8 is New_Association (Constr, M2E (Res)); end if; - if Copy_Out /= O_Dnode_Null then - New_Association - (Constr, New_Address (New_Obj (Copy_Out), Info.Res_Record_Ptr)); + if Params_Var /= O_Dnode_Null then + -- Parameters record (for procedures). + New_Association (Constr, New_Address (New_Obj (Params_Var), + Info.Subprg_Params_Ptr)); end if; if Obj /= Null_Iir then + -- Protected object. New_Association (Constr, M2E (Chap6.Translate_Name (Obj))); else + -- Instance. Subprgs.Add_Subprg_Instance_Assoc (Constr, Info.Subprg_Instance); end if; @@ -1909,64 +1941,17 @@ package body Trans.Chap8 is El := Assoc_Chain; Pos := 0; while El /= Null_Iir loop - Formal := Get_Formal (El); - if Get_Kind (Formal) in Iir_Kinds_Denoting_Name then - Formal := Get_Named_Entity (Formal); - end if; + Formal := Strip_Denoting_Name (Get_Formal (El)); Base_Formal := Get_Association_Interface (El); Formal_Info := Get_Info (Base_Formal); - Formal_Type := Get_Type (Formal); - Ftype_Info := Get_Info (Formal_Type); - if Get_Kind (El) = Iir_Kind_Association_Element_By_Individual then - Last_Individual := Pos; - New_Association (Constr, M2E (Params (Pos))); - elsif Base_Formal /= Formal then - -- Individual association. - null; - elsif Formal_Info.Interface_Field = O_Fnode_Null then - if Ftype_Info.Type_Mode in Type_Mode_By_Value then - -- Parameter passed by value. - if E_Params (Pos) /= O_Enode_Null then - Val := E_Params (Pos); - raise Internal_Error; - else - case Get_Kind (El) is - when Iir_Kind_Association_Element_Open => - Act := Get_Default_Value (Formal); - In_Conv := Null_Iir; - when Iir_Kind_Association_Element_By_Expression => - Act := Get_Actual (El); - In_Conv := Get_In_Conversion (El); - when others => - Error_Kind ("translate_procedure_call(2)", El); - end case; - case Get_Kind (Formal) is - when Iir_Kind_Interface_Signal_Declaration => - Param := Chap6.Translate_Name (Act); - -- This is a scalar. - Val := M2E (Param); - when others => - if In_Conv = Null_Iir then - Val := Chap7.Translate_Expression - (Act, Formal_Type); - Val := Chap3.Maybe_Insert_Scalar_Check - (Val, Act, Formal_Type); - else - Actual_Type := Get_Type (Act); - Val := Do_Conversion - (In_Conv, - Act, - E2M (Chap7.Translate_Expression (Act, - Actual_Type), - Get_Info (Actual_Type), - Mode_Value)); - end if; - end case; - end if; - New_Association (Constr, Val); - else - -- Parameter passed by ref, which was already computed. + if Formal_Info.Interface_Field = O_Fnode_Null then + -- Not a PARAMS field. + if Get_Kind (El) = Iir_Kind_Association_Element_By_Individual then + -- Pass the whole data for an individual association. + New_Association (Constr, M2E (Params (Pos))); + elsif Base_Formal = Formal then + -- Whole association. New_Association (Constr, E_Params (Pos)); end if; end if; @@ -1974,6 +1959,7 @@ package body Trans.Chap8 is Pos := Pos + 1; end loop; + -- Subprogram call. if Is_Procedure then New_Procedure_Call (Constr); else @@ -1990,49 +1976,43 @@ package body Trans.Chap8 is El := Assoc_Chain; Pos := 0; while El /= Null_Iir loop - Formal := Get_Formal (El); - Base_Formal := Get_Association_Interface (El); - Formal_Type := Get_Type (Formal); - Ftype_Info := Get_Info (Formal_Type); - Formal_Info := Get_Info (Base_Formal); - if Get_Kind (Base_Formal) = Iir_Kind_Interface_Variable_Declaration - and then Get_Mode (Base_Formal) in Iir_Out_Modes - and then Params (Pos) /= Mnode_Null - then - if Formal_Info.Interface_Field /= O_Fnode_Null then - -- OUT parameters. - Out_Conv := Get_Out_Conversion (El); - if Out_Conv = Null_Iir then - Out_Expr := Formal; - else - Out_Expr := Out_Conv; - end if; + if Get_Kind (El) = Iir_Kind_Association_Element_By_Individual then + Last_Individual := Pos; + elsif Params (Pos) /= Mnode_Null then + Formal := Strip_Denoting_Name (Get_Formal (El)); + Base_Formal := Get_Association_Interface (El); + + pragma Assert (Get_Kind (Base_Formal) + = Iir_Kind_Interface_Variable_Declaration); + pragma Assert (Get_Mode (Base_Formal) in Iir_Out_Modes); + + Formal_Type := Get_Type (Formal); + Ftype_Info := Get_Info (Formal_Type); + Formal_Info := Get_Info (Base_Formal); + + -- Extract the value + if Base_Formal /= Formal then + -- By individual, copy back. + Param := Translate_Individual_Association_Formal + (Formal, Formal_Info, Params (Last_Individual)); + else + pragma Assert (Formal_Info.Interface_Field /= O_Fnode_Null); Ptr := New_Selected_Element - (New_Obj (Copy_Out), Formal_Info.Interface_Field); + (New_Obj (Params_Var), Formal_Info.Interface_Field); Param := Lv2M (Ptr, Ftype_Info, Mode_Value); - Chap7.Translate_Assign (Params (Pos), - Do_Conversion (Out_Conv, Formal, - Param), - Out_Expr, - Get_Type (Get_Actual (El)), El); - elsif Base_Formal /= Formal then - -- By individual. - -- Copy back. - Act := Get_Actual (El); - declare - Prev_Node : O_Dnode; - begin - Prev_Node := Formal_Info.Interface_Node; - -- We need a pointer since the interface is by reference. - Formal_Info.Interface_Node := - M2Dp (Params (Last_Individual)); - Val := Chap7.Translate_Expression - (Formal, Get_Type (Act)); - Formal_Info.Interface_Node := Prev_Node; - end; - Chap7.Translate_Assign - (Params (Pos), Val, Formal, Get_Type (Act), El); end if; + + Out_Conv := Get_Out_Conversion (El); + if Out_Conv = Null_Iir then + Out_Expr := Formal; + Val := M2E (Param); + else + Out_Expr := Out_Conv; + Val := Do_Conversion (Out_Conv, Formal, M2E (Param)); + end if; + + Chap7.Translate_Assign + (Params (Pos), Val, Out_Expr, Get_Type (Get_Actual (El)), El); end if; El := Get_Chain (El); Pos := Pos + 1; diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb index 146bb818a..86faf6a3d 100644 --- a/src/vhdl/translate/trans-chap9.adb +++ b/src/vhdl/translate/trans-chap9.adb @@ -35,7 +35,6 @@ with Trans.Chap5; with Trans.Chap6; with Trans.Chap7; with Trans.Chap8; -with Trans.Chap14; with Trans.Rtis; with Translation; use Translation; with Trans_Decls; use Trans_Decls; @@ -1826,7 +1825,7 @@ package body Trans.Chap9 is if Data.Has_Val then Init_Val := M2E (Data.Val); else - Init_Val := Chap14.Translate_Left_Type_Attribute (Targ_Type); + Init_Val := Chap4.Get_Scalar_Initial_Value (Targ_Type); end if; New_Association (Assoc, New_Convert_Ov (Init_Val, Conv)); New_Procedure_Call (Assoc); diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads index a97dcf706..4e778de1b 100644 --- a/src/vhdl/translate/trans.ads +++ b/src/vhdl/translate/trans.ads @@ -1104,19 +1104,17 @@ package Trans is -- given via an (hidden to the user) interface. Furthermore, -- the function is translated into a procedure. -- For a procedure: - -- If there are copy-out interfaces, they are gathered in a - -- record and a pointer to the record is passed to the - -- procedure. RES_INTERFACE is the interface for this pointer. + -- Interface for parameters. Res_Interface : O_Dnode := O_Dnode_Null; - -- Field in the frame for a pointer to the RESULT structure. - Res_Record_Var : Var_Type := Null_Var; + -- Field in the frame for a pointer to the PARAMS structure. This + -- is necessary when nested subprograms need to access to + -- paramters. of this subprogram. + Subprg_Params_Var : Var_Type := Null_Var; - -- For a procedure: record containing inout/out scalar parameters. - -- Type definition for the record. - Res_Record_Type : O_Tnode := O_Tnode_Null; - -- Type definition for access to the record. - Res_Record_Ptr : O_Tnode := O_Tnode_Null; + -- For a procedure, record containing the parameters. + Subprg_Params_Type : O_Tnode := O_Tnode_Null; + Subprg_Params_Ptr : O_Tnode := O_Tnode_Null; -- Access to the declarations within this subprogram. Subprg_Frame_Scope : aliased Var_Scope_Type; @@ -1168,7 +1166,7 @@ package Trans is -- Node: null, Field: null: not possible -- Node: null, Field: not null: field in RESULT record Interface_Node : O_Dnode := O_Dnode_Null; - -- Field of the result record for copy-out arguments of procedure. + -- Field of the PARAMS record for arguments of procedure. -- In that case, Interface_Node must be null. Interface_Field : O_Fnode; -- Type of the interface. |