diff options
| author | Tristan Gingold | 2014-11-09 18:31:54 +0100 |
|---|---|---|
| committer | Tristan Gingold | 2014-11-09 18:31:54 +0100 |
| commit | fe94cb3cc3fd4517271faa9046c74b0c455aeb79 (patch) | |
| tree | 17ba28586cb5eb22d530c568d917931f309d871f /src/vhdl/translate/trans-chap4.adb | |
| parent | 3c9a77e9e6f3b8047080f7d8c11bb9881cabf968 (diff) | |
| download | ghdl-fe94cb3cc3fd4517271faa9046c74b0c455aeb79.tar.gz ghdl-fe94cb3cc3fd4517271faa9046c74b0c455aeb79.tar.bz2 ghdl-fe94cb3cc3fd4517271faa9046c74b0c455aeb79.zip | |
Split translation into child packages.
Diffstat (limited to 'src/vhdl/translate/trans-chap4.adb')
| -rw-r--r-- | src/vhdl/translate/trans-chap4.adb | 2735 |
1 files changed, 2735 insertions, 0 deletions
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb new file mode 100644 index 0000000..7b18f57 --- /dev/null +++ b/src/vhdl/translate/trans-chap4.adb @@ -0,0 +1,2735 @@ +-- Iir to ortho translator. +-- Copyright (C) 2002 - 2014 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with GCC; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Errorout; use Errorout; +with Files_Map; +with Iirs_Utils; use Iirs_Utils; +with Std_Package; use Std_Package; +with Translation; use Translation; +with Trans.Chap2; +with Trans.Chap3; +with Trans.Chap5; +with Trans.Chap6; +with Trans.Chap7; +with Trans.Chap14; +with Trans.Rtis; +with Trans.Helpers2; use Trans.Helpers2; +with Trans_Decls; use Trans_Decls; +with Trans.Foreach_Non_Composite; + +package body Trans.Chap4 is + use Trans.Helpers; + + -- Get the ortho type for an object of mode MODE. + function Get_Object_Type (Tinfo : Type_Info_Acc; Kind : Object_Kind_Type) + return O_Tnode is + begin + if Is_Complex_Type (Tinfo) then + case Tinfo.Type_Mode is + when Type_Mode_Fat_Array => + return Tinfo.Ortho_Type (Kind); + when Type_Mode_Record + | Type_Mode_Array + | Type_Mode_Protected => + -- For a complex type, use a pointer. + return Tinfo.Ortho_Ptr_Type (Kind); + when others => + raise Internal_Error; + end case; + else + return Tinfo.Ortho_Type (Kind); + end if; + end Get_Object_Type; + + procedure Create_Object (El : Iir) + is + Obj_Type : O_Tnode; + Info : Object_Info_Acc; + Tinfo : Type_Info_Acc; + Def : Iir; + Val : Iir; + Storage : O_Storage; + Deferred : Iir; + begin + Def := Get_Type (El); + Val := Get_Default_Value (El); + + -- Be sure the object type was translated. + if Get_Kind (El) = Iir_Kind_Constant_Declaration + and then Get_Deferred_Declaration_Flag (El) = False + and then Get_Deferred_Declaration (El) /= Null_Iir + then + -- This is a full constant declaration which complete a previous + -- incomplete constant declaration. + -- + -- Do not create the subtype of this full constant declaration, + -- since it was already created by the deferred declaration. + -- Use the type of the deferred declaration. + Deferred := Get_Deferred_Declaration (El); + Def := Get_Type (Deferred); + Info := Get_Info (Deferred); + Set_Info (El, Info); + else + Chap3.Translate_Object_Subtype (El); + Info := Add_Info (El, Kind_Object); + end if; + + Tinfo := Get_Info (Def); + Obj_Type := Get_Object_Type (Tinfo, Mode_Value); + + case Get_Kind (El) is + when Iir_Kind_Variable_Declaration + | Iir_Kind_Interface_Constant_Declaration => + Info.Object_Var := + Create_Var (Create_Var_Identifier (El), Obj_Type); + when Iir_Kind_Constant_Declaration => + if Get_Deferred_Declaration (El) /= Null_Iir then + -- This is a full constant declaration (in a body) of a + -- deferred constant declaration (in a package). + Storage := O_Storage_Public; + else + Storage := Global_Storage; + end if; + if Info.Object_Var = Null_Var then + -- Not a full constant declaration (ie a value for an + -- already declared constant). + -- Must create the declaration. + if Chap7.Is_Static_Constant (El) then + Info.Object_Static := True; + Info.Object_Var := Create_Global_Const + (Create_Identifier (El), Obj_Type, Global_Storage, + O_Cnode_Null); + else + Info.Object_Static := False; + Info.Object_Var := Create_Var + (Create_Var_Identifier (El), + Obj_Type, Global_Storage); + end if; + end if; + if Get_Deferred_Declaration (El) = Null_Iir + and then Info.Object_Static + and then Storage /= O_Storage_External + then + -- Deferred constant are never considered as locally static. + -- FIXME: to be improved ? + + -- open_temp/close_temp only required for transient types. + Open_Temp; + Define_Global_Const + (Info.Object_Var, + Chap7.Translate_Static_Expression (Val, Def)); + Close_Temp; + end if; + when others => + Error_Kind ("create_objet", El); + end case; + end Create_Object; + + procedure Create_Signal (Decl : Iir) + is + Sig_Type_Def : constant Iir := Get_Type (Decl); + Sig_Type : O_Tnode; + Type_Info : Type_Info_Acc; + Info : Ortho_Info_Acc; + begin + Chap3.Translate_Object_Subtype (Decl); + + Type_Info := Get_Info (Sig_Type_Def); + Sig_Type := Get_Object_Type (Type_Info, Mode_Signal); + pragma Assert (Sig_Type /= O_Tnode_Null); + + Info := Add_Info (Decl, Kind_Object); + + Info.Object_Var := + Create_Var (Create_Var_Identifier (Decl), Sig_Type); + + case Get_Kind (Decl) is + when Iir_Kind_Signal_Declaration + | Iir_Kind_Interface_Signal_Declaration => + Rtis.Generate_Signal_Rti (Decl); + when Iir_Kind_Guard_Signal_Declaration => + -- No name created for guard signal. + null; + when others => + Error_Kind ("create_signal", Decl); + end case; + end Create_Signal; + + procedure Create_Implicit_Signal (Decl : Iir) + is + Sig_Type : O_Tnode; + Type_Info : Type_Info_Acc; + Info : Ortho_Info_Acc; + Sig_Type_Def : Iir; + begin + Sig_Type_Def := Get_Type (Decl); + -- This has been disabled since DECL can have an anonymous subtype, + -- and DECL has no identifiers, which causes translate_object_subtype + -- to crash. + -- Note: DECL can only be a iir_kind_delayed_attribute. + --Chap3.Translate_Object_Subtype (Decl); + Type_Info := Get_Info (Sig_Type_Def); + Sig_Type := Type_Info.Ortho_Type (Mode_Signal); + if Sig_Type = O_Tnode_Null then + raise Internal_Error; + end if; + + Info := Add_Info (Decl, Kind_Object); + + Info.Object_Var := Create_Var (Create_Uniq_Identifier, Sig_Type); + end Create_Implicit_Signal; + + procedure Create_File_Object (El : Iir_File_Declaration) + is + Obj_Type : O_Tnode; + Info : Ortho_Info_Acc; + Obj_Type_Def : Iir; + begin + Obj_Type_Def := Get_Type (El); + Obj_Type := Get_Ortho_Type (Obj_Type_Def, Mode_Value); + + Info := Add_Info (El, Kind_Object); + + Info.Object_Var := Create_Var (Create_Var_Identifier (El), Obj_Type); + end Create_File_Object; + + procedure Create_Package_Interface (Inter : Iir) + is + Info : Ortho_Info_Acc; + Pkg : constant Iir := Get_Named_Entity + (Get_Uninstantiated_Package_Name (Inter)); + Pkg_Info : constant Ortho_Info_Acc := Get_Info (Pkg); + begin + Chap2.Instantiate_Info_Package (Inter); + Info := Get_Info (Inter); + + -- The spec + Info.Package_Instance_Spec_Var := + Create_Var (Create_Var_Identifier (Inter, "SPEC", 0), + Pkg_Info.Package_Spec_Ptr_Type); + Set_Scope_Via_Var_Ptr + (Info.Package_Instance_Spec_Scope, + Info.Package_Instance_Spec_Var); + + -- The body + Info.Package_Instance_Body_Var := + Create_Var (Create_Var_Identifier (Inter, "BODY", 0), + Pkg_Info.Package_Body_Ptr_Type); + Set_Scope_Via_Var_Ptr + (Info.Package_Instance_Body_Scope, + Info.Package_Instance_Body_Var); + end Create_Package_Interface; + + procedure Allocate_Complex_Object (Obj_Type : Iir; + Alloc_Kind : Allocation_Kind; + Var : in out Mnode) + is + Type_Info : constant Type_Info_Acc := Get_Type_Info (Var); + Kind : constant Object_Kind_Type := Get_Object_Kind (Var); + Targ : Mnode; + begin + if Type_Info.Type_Mode = Type_Mode_Fat_Array then + -- Cannot allocate unconstrained object (since size is unknown). + raise Internal_Error; + end if; + + if not Is_Complex_Type (Type_Info) then + -- Object is not complex. + return; + end if; + + if Type_Info.C (Kind).Builder_Need_Func + and then not Is_Stable (Var) + then + Targ := Create_Temp (Type_Info, Kind); + else + Targ := Var; + end if; + + -- Allocate variable. + New_Assign_Stmt + (M2Lp (Targ), + Gen_Alloc (Alloc_Kind, + Chap3.Get_Object_Size (Var, Obj_Type), + Type_Info.Ortho_Ptr_Type (Kind))); + + if Type_Info.C (Kind).Builder_Need_Func then + -- Build the type. + Chap3.Gen_Call_Type_Builder (Targ, Obj_Type); + if not Is_Stable (Var) then + New_Assign_Stmt (M2Lp (Var), M2Addr (Targ)); + Var := Targ; + end if; + end if; + end Allocate_Complex_Object; + + -- Note : OBJ can be a tree. + -- FIXME: should use translate_aggregate_others. + procedure Init_Array_Object (Obj : Mnode; Obj_Type : Iir) + is + Sobj : Mnode; + + -- Type of the object. + Type_Info : Type_Info_Acc; + + -- Iterator for the elements. + Index : O_Dnode; + + Upper_Limit : O_Enode; + Upper_Var : O_Dnode; + + Label : O_Snode; + begin + Type_Info := Get_Info (Obj_Type); + + -- Iterate on all elements of the object. + Open_Temp; + + if Type_Info.Type_Mode = Type_Mode_Fat_Array then + Sobj := Stabilize (Obj); + else + Sobj := Obj; + end if; + Upper_Limit := Chap3.Get_Array_Length (Sobj, Obj_Type); + + if Type_Info.Type_Mode /= Type_Mode_Array then + Upper_Var := Create_Temp_Init (Ghdl_Index_Type, Upper_Limit); + else + Upper_Var := O_Dnode_Null; + end if; + + Index := Create_Temp (Ghdl_Index_Type); + Init_Var (Index); + Start_Loop_Stmt (Label); + if Upper_Var /= O_Dnode_Null then + Upper_Limit := New_Obj_Value (Upper_Var); + end if; + Gen_Exit_When (Label, + New_Compare_Op (ON_Eq, + New_Obj_Value (Index), Upper_Limit, + Ghdl_Bool_Type)); + Init_Object (Chap3.Index_Base (Chap3.Get_Array_Base (Sobj), + Obj_Type, + New_Obj_Value (Index)), + Get_Element_Subtype (Obj_Type)); + Inc_Var (Index); + Finish_Loop_Stmt (Label); + + Close_Temp; + end Init_Array_Object; + + procedure Init_Protected_Object (Obj : Mnode; Obj_Type : Iir) + is + Assoc : O_Assoc_List; + Info : Type_Info_Acc; + begin + Info := Get_Info (Obj_Type); + + -- Call the initializer. + Start_Association (Assoc, Info.T.Prot_Init_Subprg); + Subprgs.Add_Subprg_Instance_Assoc (Assoc, Info.T.Prot_Init_Instance); + -- Use of M2Lp is a little bit fragile (not sure we get the + -- variable, but should work: we didn't stabilize it). + New_Assign_Stmt (M2Lp (Obj), New_Function_Call (Assoc)); + end Init_Protected_Object; + + procedure Fini_Protected_Object (Decl : Iir) + is + Obj : Mnode; + Assoc : O_Assoc_List; + Info : Type_Info_Acc; + begin + Info := Get_Info (Get_Type (Decl)); + + Obj := Chap6.Translate_Name (Decl); + -- Call the Finalizator. + Start_Association (Assoc, Info.T.Prot_Final_Subprg); + New_Association (Assoc, M2E (Obj)); + New_Procedure_Call (Assoc); + end Fini_Protected_Object; + + procedure Init_Object (Obj : Mnode; Obj_Type : Iir) + is + Tinfo : Type_Info_Acc; + 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)); + when Type_Mode_Acc => + New_Assign_Stmt + (M2Lv (Obj), + New_Lit (New_Null_Access (Tinfo.Ortho_Type (Mode_Value)))); + when Type_Mode_Fat_Acc => + declare + Dinfo : Type_Info_Acc; + Sobj : Mnode; + begin + Open_Temp; + Sobj := Stabilize (Obj); + Dinfo := Get_Info (Get_Designated_Type (Obj_Type)); + New_Assign_Stmt + (New_Selected_Element (M2Lv (Sobj), + Dinfo.T.Bounds_Field (Mode_Value)), + New_Lit (New_Null_Access (Dinfo.T.Bounds_Ptr_Type))); + New_Assign_Stmt + (New_Selected_Element (M2Lv (Sobj), + Dinfo.T.Base_Field (Mode_Value)), + New_Lit (New_Null_Access + (Dinfo.T.Base_Ptr_Type (Mode_Value)))); + Close_Temp; + end; + when Type_Mode_Arrays => + Init_Array_Object (Obj, Obj_Type); + when Type_Mode_Record => + declare + Sobj : Mnode; + El : Iir_Element_Declaration; + List : Iir_List; + begin + Open_Temp; + Sobj := Stabilize (Obj); + List := Get_Elements_Declaration_List + (Get_Base_Type (Obj_Type)); + for I in Natural loop + El := Get_Nth_Element (List, I); + exit when El = Null_Iir; + Init_Object (Chap6.Translate_Selected_Element (Sobj, El), + Get_Type (El)); + end loop; + Close_Temp; + end; + when Type_Mode_Protected => + Init_Protected_Object (Obj, Obj_Type); + when Type_Mode_Unknown + | Type_Mode_File => + raise Internal_Error; + end case; + end Init_Object; + + procedure Elab_Object_Storage (Obj : Iir) + is + Obj_Type : constant Iir := Get_Type (Obj); + Obj_Info : constant Object_Info_Acc := Get_Info (Obj); + + Name_Node : Mnode; + + Type_Info : Type_Info_Acc; + Alloc_Kind : Allocation_Kind; + begin + -- Elaborate subtype. + Chap3.Elab_Object_Subtype (Obj_Type); + + Type_Info := Get_Info (Obj_Type); + + -- FIXME: the object type may be a fat array! + -- FIXME: fat array + aggregate ? + + if Type_Info.Type_Mode = Type_Mode_Protected then + -- Protected object will be created by its INIT function. + return; + end if; + + if Is_Complex_Type (Type_Info) + and then Type_Info.Type_Mode /= Type_Mode_Fat_Array + then + -- FIXME: avoid allocation if the value is a string and + -- the object is a constant + Name_Node := Get_Var (Obj_Info.Object_Var, Type_Info, Mode_Value); + Alloc_Kind := Get_Alloc_Kind_For_Var (Obj_Info.Object_Var); + Allocate_Complex_Object (Obj_Type, Alloc_Kind, Name_Node); + end if; + end Elab_Object_Storage; + + -- Generate code to create object OBJ and initialize it with value VAL. + procedure Elab_Object_Init (Name : Mnode; Obj : Iir; Value : Iir) + is + Obj_Type : constant Iir := Get_Type (Obj); + Type_Info : constant Type_Info_Acc := Get_Info (Obj_Type); + Obj_Info : constant Object_Info_Acc := Get_Info (Obj); + + Name_Node : Mnode; + Value_Node : O_Enode; + + Alloc_Kind : Allocation_Kind; + begin + -- Elaborate subtype. + Alloc_Kind := Get_Alloc_Kind_For_Var (Obj_Info.Object_Var); + + -- Note: no temporary variable region is created, as the allocation + -- may be performed on the stack. + + if Value = Null_Iir then + -- Performs default initialization. + Open_Temp; + Init_Object (Name, Obj_Type); + Close_Temp; + elsif Get_Kind (Value) = Iir_Kind_Aggregate then + if Type_Info.Type_Mode = Type_Mode_Fat_Array then + -- Allocate. + declare + Aggr_Type : Iir; + begin + Aggr_Type := Get_Type (Value); + Chap3.Create_Array_Subtype (Aggr_Type, True); + Name_Node := Stabilize (Name); + New_Assign_Stmt + (M2Lp (Chap3.Get_Array_Bounds (Name_Node)), + M2Addr (Chap3.Get_Array_Type_Bounds (Aggr_Type))); + Chap3.Allocate_Fat_Array_Base + (Alloc_Kind, Name_Node, Get_Base_Type (Aggr_Type)); + end; + else + Name_Node := Name; + end if; + Chap7.Translate_Aggregate (Name_Node, Obj_Type, Value); + else + Value_Node := Chap7.Translate_Expression (Value, Obj_Type); + + if Type_Info.Type_Mode = Type_Mode_Fat_Array then + declare + S : Mnode; + begin + Name_Node := Stabilize (Name); + S := Stabilize (E2M (Value_Node, Type_Info, Mode_Value)); + + if Get_Kind (Value) = Iir_Kind_String_Literal + and then Get_Kind (Obj) = Iir_Kind_Constant_Declaration + then + -- No need to allocate space for the object. + Copy_Fat_Pointer (Name_Node, S); + else + Chap3.Translate_Object_Allocation + (Name_Node, Alloc_Kind, Obj_Type, + Chap3.Get_Array_Bounds (S)); + Chap3.Translate_Object_Copy + (Name_Node, M2Addr (S), Obj_Type); + end if; + end; + else + Chap3.Translate_Object_Copy (Name, Value_Node, Obj_Type); + end if; + Destroy_Local_Transient_Types; + end if; + end Elab_Object_Init; + + -- Generate code to create object OBJ and initialize it with value VAL. + procedure Elab_Object_Value (Obj : Iir; Value : Iir) + is + Name : Mnode; + begin + Elab_Object_Storage (Obj); + Name := Get_Var (Get_Info (Obj).Object_Var, + Get_Info (Get_Type (Obj)), Mode_Value); + Elab_Object_Init (Name, Obj, Value); + end Elab_Object_Value; + + -- Create code to elaborate OBJ. + procedure Elab_Object (Obj : Iir) + is + Value : Iir; + Obj1 : Iir; + begin + -- A locally static constant is pre-elaborated. + -- (only constant can be locally static). + if Get_Expr_Staticness (Obj) = Locally + and then Get_Deferred_Declaration (Obj) = Null_Iir + then + return; + end if; + + -- Set default value. + if Get_Kind (Obj) = Iir_Kind_Constant_Declaration then + if Get_Info (Obj).Object_Static then + return; + end if; + if Get_Deferred_Declaration_Flag (Obj) then + -- No code generation for a deferred constant. + return; + end if; + Obj1 := Get_Deferred_Declaration (Obj); + if Obj1 = Null_Iir then + Obj1 := Obj; + end if; + else + Obj1 := Obj; + end if; + + New_Debug_Line_Stmt (Get_Line_Number (Obj)); + + -- Still use the default value of the not deferred constant. + -- FIXME: what about composite types. + Value := Get_Default_Value (Obj); + Elab_Object_Value (Obj1, Value); + end Elab_Object; + + procedure Fini_Object (Obj : Iir) + is + Obj_Type : Iir; + Type_Info : Type_Info_Acc; + begin + Obj_Type := Get_Type (Obj); + Type_Info := Get_Info (Obj_Type); + if Type_Info.Type_Mode = Type_Mode_Fat_Array then + declare + V : Mnode; + begin + Open_Temp; + V := Chap6.Translate_Name (Obj); + Stabilize (V); + Chap3.Gen_Deallocate + (New_Value (M2Lp (Chap3.Get_Array_Bounds (V)))); + Chap3.Gen_Deallocate + (New_Value (M2Lp (Chap3.Get_Array_Base (V)))); + Close_Temp; + end; + elsif Is_Complex_Type (Type_Info) then + Chap3.Gen_Deallocate + (New_Value (M2Lp (Chap6.Translate_Name (Obj)))); + end if; + end Fini_Object; + + function Get_Nbr_Signals (Sig : Mnode; Sig_Type : Iir) return O_Enode + is + Info : constant Type_Info_Acc := Get_Info (Sig_Type); + begin + case Info.Type_Mode is + when Type_Mode_Scalar => + -- Note: here we discard SIG... + return New_Lit (Ghdl_Index_1); + when Type_Mode_Arrays => + declare + Len : O_Dnode; + If_Blk : O_If_Block; + Ssig : Mnode; + begin + Ssig := Stabilize (Sig); + Len := Create_Temp_Init + (Ghdl_Index_Type, + Chap3.Get_Array_Length (Ssig, Sig_Type)); + Start_If_Stmt (If_Blk, + New_Compare_Op (ON_Neq, + New_Obj_Value (Len), + New_Lit (Ghdl_Index_0), + Ghdl_Bool_Type)); + New_Assign_Stmt + (New_Obj (Len), + New_Dyadic_Op + (ON_Mul_Ov, + New_Obj_Value (Len), + Get_Nbr_Signals + (Chap3.Index_Base + (Chap3.Get_Array_Base (Ssig), Sig_Type, + New_Lit (Ghdl_Index_0)), + Get_Element_Subtype (Sig_Type)))); + Finish_If_Stmt (If_Blk); + + return New_Obj_Value (Len); + end; + when Type_Mode_Record => + declare + List : Iir_List; + El : Iir; + Res : O_Enode; + E : O_Enode; + Sig_El : Mnode; + Ssig : Mnode; + begin + List := + Get_Elements_Declaration_List (Get_Base_Type (Sig_Type)); + Ssig := Stabilize (Sig); + Res := O_Enode_Null; + for I in Natural loop + El := Get_Nth_Element (List, I); + exit when El = Null_Iir; + Sig_El := Chap6.Translate_Selected_Element (Ssig, El); + E := Get_Nbr_Signals (Sig_El, Get_Type (El)); + if Res /= O_Enode_Null then + Res := New_Dyadic_Op (ON_Add_Ov, Res, E); + else + Res := E; + end if; + end loop; + if Res = O_Enode_Null then + -- Empty records. + Res := New_Lit (Ghdl_Index_0); + end if; + return Res; + end; + when Type_Mode_Unknown + | Type_Mode_File + | Type_Mode_Acc + | Type_Mode_Fat_Acc + | Type_Mode_Protected => + raise Internal_Error; + end case; + end Get_Nbr_Signals; + + -- Get the leftest signal of SIG. + -- The leftest signal of + -- a scalar signal is itself, + -- an array signal is the leftest, + -- a record signal is the first element. + function Get_Leftest_Signal (Sig: Mnode; Sig_Type : Iir) + return Mnode + is + Res : Mnode; + Res_Type : Iir; + Info : Type_Info_Acc; + begin + Res := Sig; + Res_Type := Sig_Type; + loop + Info := Get_Type_Info (Res); + case Info.Type_Mode is + when Type_Mode_Scalar => + return Res; + when Type_Mode_Arrays => + Res := Chap3.Index_Base + (Chap3.Get_Array_Base (Res), Res_Type, + New_Lit (Ghdl_Index_0)); + Res_Type := Get_Element_Subtype (Res_Type); + when Type_Mode_Record => + declare + Element : Iir; + begin + Element := Get_First_Element + (Get_Elements_Declaration_List + (Get_Base_Type (Res_Type))); + Res := Chap6.Translate_Selected_Element (Res, Element); + Res_Type := Get_Type (Element); + end; + when Type_Mode_Unknown + | Type_Mode_File + | Type_Mode_Acc + | Type_Mode_Fat_Acc + | Type_Mode_Protected => + raise Internal_Error; + end case; + end loop; + end Get_Leftest_Signal; + + -- Add func and instance. + procedure Add_Associations_For_Resolver + (Assoc : in out O_Assoc_List; Func_Decl : Iir) + is + Func_Info : constant Subprg_Info_Acc := Get_Info (Func_Decl); + Resolv_Info : constant Subprg_Resolv_Info_Acc := + Func_Info.Subprg_Resolv; + Val : O_Enode; + begin + New_Association + (Assoc, New_Lit (New_Subprogram_Address (Resolv_Info.Resolv_Func, + Ghdl_Ptr_Type))); + if Subprgs.Has_Subprg_Instance (Resolv_Info.Var_Instance) then + Val := New_Convert_Ov + (Subprgs.Get_Subprg_Instance (Resolv_Info.Var_Instance), + Ghdl_Ptr_Type); + else + Val := New_Lit (New_Null_Access (Ghdl_Ptr_Type)); + end if; + New_Association (Assoc, Val); + end Add_Associations_For_Resolver; + + type O_If_Block_Acc is access O_If_Block; + + type Elab_Signal_Data is record + -- Default value of the signal. + Val : Mnode; + -- If statement for a block of signals. + If_Stmt : O_If_Block_Acc; + -- True if the default value is set. + Has_Val : Boolean; + -- True if a resolution function was already attached. + Already_Resolved : Boolean; + -- True if the signal may already have been created. + Check_Null : Boolean; + end record; + + procedure Elab_Signal_Non_Composite (Targ : Mnode; + Targ_Type : Iir; + Data : Elab_Signal_Data) + is + Type_Info : constant Type_Info_Acc := Get_Info (Targ_Type); + Create_Subprg : O_Dnode; + Conv : O_Tnode; + Res : O_Enode; + Assoc : O_Assoc_List; + Init_Val : O_Enode; + -- For the resolution function (if any). + Func : Iir; + If_Stmt : O_If_Block; + Targ_Ptr : O_Dnode; + begin + if Data.Check_Null then + Targ_Ptr := Create_Temp_Init + (Ghdl_Signal_Ptr_Ptr, + New_Unchecked_Address (M2Lv (Targ), Ghdl_Signal_Ptr_Ptr)); + Start_If_Stmt + (If_Stmt, + New_Compare_Op (ON_Eq, + New_Value (New_Acc_Value (New_Obj (Targ_Ptr))), + New_Lit (New_Null_Access (Ghdl_Signal_Ptr)), + Ghdl_Bool_Type)); + end if; + + case Type_Info.Type_Mode is + when Type_Mode_B1 => + Create_Subprg := Ghdl_Create_Signal_B1; + Conv := Ghdl_Bool_Type; + when Type_Mode_E8 => + Create_Subprg := Ghdl_Create_Signal_E8; + Conv := Ghdl_I32_Type; + when Type_Mode_E32 => + Create_Subprg := Ghdl_Create_Signal_E32; + Conv := Ghdl_I32_Type; + when Type_Mode_I32 + | Type_Mode_P32 => + Create_Subprg := Ghdl_Create_Signal_I32; + Conv := Ghdl_I32_Type; + when Type_Mode_P64 + | Type_Mode_I64 => + Create_Subprg := Ghdl_Create_Signal_I64; + Conv := Ghdl_I64_Type; + when Type_Mode_F64 => + Create_Subprg := Ghdl_Create_Signal_F64; + Conv := Ghdl_Real_Type; + when others => + Error_Kind ("elab_signal_non_composite", Targ_Type); + end case; + + if Data.Has_Val then + Init_Val := M2E (Data.Val); + else + Init_Val := Chap14.Translate_Left_Type_Attribute (Targ_Type); + end if; + + Start_Association (Assoc, Create_Subprg); + New_Association (Assoc, New_Convert_Ov (Init_Val, Conv)); + + if Get_Kind (Targ_Type) in Iir_Kinds_Subtype_Definition then + Func := Has_Resolution_Function (Targ_Type); + else + Func := Null_Iir; + end if; + if Func /= Null_Iir and then not Data.Already_Resolved then + Add_Associations_For_Resolver (Assoc, Func); + else + New_Association (Assoc, New_Lit (New_Null_Access (Ghdl_Ptr_Type))); + New_Association (Assoc, New_Lit (New_Null_Access (Ghdl_Ptr_Type))); + end if; + + Res := New_Function_Call (Assoc); + + if Data.Check_Null then + New_Assign_Stmt (New_Acc_Value (New_Obj (Targ_Ptr)), Res); + Finish_If_Stmt (If_Stmt); + else + New_Assign_Stmt + (M2Lv (Targ), + New_Convert_Ov (Res, Type_Info.Ortho_Type (Mode_Signal))); + end if; + end Elab_Signal_Non_Composite; + + function Elab_Signal_Prepare_Composite + (Targ : Mnode; Targ_Type : Iir; Data : Elab_Signal_Data) + return Elab_Signal_Data + is + Assoc : O_Assoc_List; + Func : Iir; + Res : Elab_Signal_Data; + begin + Res := Data; + if Get_Kind (Targ_Type) in Iir_Kinds_Subtype_Definition then + Func := Has_Resolution_Function (Targ_Type); + if Func /= Null_Iir and then not Data.Already_Resolved then + if Data.Check_Null then + Res.If_Stmt := new O_If_Block; + Start_If_Stmt + (Res.If_Stmt.all, + New_Compare_Op + (ON_Eq, + New_Convert_Ov (M2E (Get_Leftest_Signal (Targ, + Targ_Type)), + Ghdl_Signal_Ptr), + New_Lit (New_Null_Access (Ghdl_Signal_Ptr)), + Ghdl_Bool_Type)); + --Res.Check_Null := False; + end if; + -- Add resolver. + Start_Association (Assoc, Ghdl_Signal_Create_Resolution); + Add_Associations_For_Resolver (Assoc, Func); + New_Association + (Assoc, New_Convert_Ov (M2Addr (Targ), Ghdl_Ptr_Type)); + New_Association (Assoc, Get_Nbr_Signals (Targ, Targ_Type)); + New_Procedure_Call (Assoc); + Res.Already_Resolved := True; + end if; + end if; + if Data.Has_Val then + if Get_Type_Info (Data.Val).Type_Mode = Type_Mode_Record then + Res.Val := Stabilize (Data.Val); + else + Res.Val := Chap3.Get_Array_Base (Data.Val); + end if; + end if; + return Res; + end Elab_Signal_Prepare_Composite; + + procedure Elab_Signal_Finish_Composite (Data : in out Elab_Signal_Data) + is + procedure Free is new Ada.Unchecked_Deallocation + (Object => O_If_Block, Name => O_If_Block_Acc); + begin + if Data.If_Stmt /= null then + Finish_If_Stmt (Data.If_Stmt.all); + Free (Data.If_Stmt); + end if; + end Elab_Signal_Finish_Composite; + + function Elab_Signal_Update_Array (Data : Elab_Signal_Data; + Targ_Type : Iir; + Index : O_Dnode) + return Elab_Signal_Data + is + begin + if not Data.Has_Val then + return Data; + else + return Elab_Signal_Data' + (Val => Chap3.Index_Base (Data.Val, Targ_Type, + New_Obj_Value (Index)), + Has_Val => True, + If_Stmt => null, + Already_Resolved => Data.Already_Resolved, + Check_Null => Data.Check_Null); + end if; + end Elab_Signal_Update_Array; + + function Elab_Signal_Update_Record (Data : Elab_Signal_Data; + Targ_Type : Iir; + El : Iir_Element_Declaration) + return Elab_Signal_Data + is + pragma Unreferenced (Targ_Type); + begin + if not Data.Has_Val then + return Data; + else + return Elab_Signal_Data' + (Val => Chap6.Translate_Selected_Element (Data.Val, El), + Has_Val => True, + If_Stmt => null, + Already_Resolved => Data.Already_Resolved, + Check_Null => Data.Check_Null); + end if; + end Elab_Signal_Update_Record; + + procedure Elab_Signal is new Foreach_Non_Composite + (Data_Type => Elab_Signal_Data, + Composite_Data_Type => Elab_Signal_Data, + Do_Non_Composite => Elab_Signal_Non_Composite, + Prepare_Data_Array => Elab_Signal_Prepare_Composite, + Update_Data_Array => Elab_Signal_Update_Array, + Finish_Data_Array => Elab_Signal_Finish_Composite, + Prepare_Data_Record => Elab_Signal_Prepare_Composite, + Update_Data_Record => Elab_Signal_Update_Record, + Finish_Data_Record => Elab_Signal_Finish_Composite); + + -- Elaborate signal subtypes and allocate the storage for the object. + procedure Elab_Signal_Declaration_Storage (Decl : Iir) + is + Sig_Type : Iir; + Type_Info : Type_Info_Acc; + Name_Node : Mnode; + begin + New_Debug_Line_Stmt (Get_Line_Number (Decl)); + + Open_Temp; + + Sig_Type := Get_Type (Decl); + Chap3.Elab_Object_Subtype (Sig_Type); + Type_Info := Get_Info (Sig_Type); + + if Type_Info.Type_Mode = Type_Mode_Fat_Array then + Name_Node := Chap6.Translate_Name (Decl); + Name_Node := Stabilize (Name_Node); + Chap3.Allocate_Fat_Array_Base (Alloc_System, Name_Node, Sig_Type); + elsif Is_Complex_Type (Type_Info) then + Name_Node := Chap6.Translate_Name (Decl); + Allocate_Complex_Object (Sig_Type, Alloc_System, Name_Node); + end if; + + Close_Temp; + end Elab_Signal_Declaration_Storage; + + function Has_Direct_Driver (Sig : Iir) return Boolean + is + Info : Ortho_Info_Acc; + begin + Info := Get_Info (Get_Object_Prefix (Sig)); + return Info.Kind = Kind_Object + and then Info.Object_Driver /= Null_Var; + end Has_Direct_Driver; + + procedure Elab_Direct_Driver_Declaration_Storage (Decl : Iir) + is + Sig_Type : constant Iir := Get_Type (Decl); + Sig_Info : constant Ortho_Info_Acc := Get_Info (Decl); + Type_Info : constant Type_Info_Acc := Get_Info (Sig_Type); + Name_Node : Mnode; + begin + Open_Temp; + + if Type_Info.Type_Mode = Type_Mode_Fat_Array then + Name_Node := Get_Var (Sig_Info.Object_Driver, + Type_Info, Mode_Value); + Name_Node := Stabilize (Name_Node); + -- Copy bounds from signal. + New_Assign_Stmt + (M2Lp (Chap3.Get_Array_Bounds (Name_Node)), + M2Addr (Chap3.Get_Array_Bounds (Chap6.Translate_Name (Decl)))); + -- Allocate base. + Chap3.Allocate_Fat_Array_Base (Alloc_System, Name_Node, Sig_Type); + elsif Is_Complex_Type (Type_Info) then + Name_Node := Get_Var (Sig_Info.Object_Driver, + Type_Info, Mode_Value); + Allocate_Complex_Object (Sig_Type, Alloc_System, Name_Node); + end if; + + Close_Temp; + end Elab_Direct_Driver_Declaration_Storage; + + -- Create signal object. + -- Note: SIG can be a signal sub-element (used when signals are + -- collapsed). + -- If CHECK_NULL is TRUE, create the signal only if it was not yet + -- created. + procedure Elab_Signal_Declaration_Object + (Sig : Iir; Parent : Iir; Check_Null : Boolean) + is + Decl : constant Iir := Strip_Denoting_Name (Sig); + Sig_Type : constant Iir := Get_Type (Sig); + Base_Decl : constant Iir := Get_Object_Prefix (Sig); + Name_Node : Mnode; + Val : Iir; + Data : Elab_Signal_Data; + begin + New_Debug_Line_Stmt (Get_Line_Number (Sig)); + + Open_Temp; + + -- Set the name of the signal. + declare + Assoc : O_Assoc_List; + begin + Start_Association (Assoc, Ghdl_Signal_Name_Rti); + New_Association + (Assoc, + New_Lit (New_Global_Unchecked_Address + (Get_Info (Base_Decl).Object_Rti, + Rtis.Ghdl_Rti_Access))); + Rtis.Associate_Rti_Context (Assoc, Parent); + New_Procedure_Call (Assoc); + end; + + Name_Node := Chap6.Translate_Name (Decl); + if Get_Object_Kind (Name_Node) /= Mode_Signal then + raise Internal_Error; + end if; + + if Decl = Base_Decl then + Data.Already_Resolved := False; + Data.Check_Null := Check_Null; + Val := Get_Default_Value (Base_Decl); + if Val = Null_Iir then + Data.Has_Val := False; + else + Data.Has_Val := True; + Data.Val := E2M (Chap7.Translate_Expression (Val, Sig_Type), + Get_Info (Sig_Type), + Mode_Value); + end if; + else + -- Sub signal. + -- Do not add resolver. + -- Do not use default value. + Data.Already_Resolved := True; + Data.Has_Val := False; + Data.Check_Null := False; + end if; + Elab_Signal (Name_Node, Sig_Type, Data); + + Close_Temp; + end Elab_Signal_Declaration_Object; + + procedure Elab_Signal_Declaration + (Decl : Iir; Parent : Iir; Check_Null : Boolean) + is + begin + Elab_Signal_Declaration_Storage (Decl); + Elab_Signal_Declaration_Object (Decl, Parent, Check_Null); + end Elab_Signal_Declaration; + + procedure Elab_Signal_Attribute (Decl : Iir) + is + Assoc : O_Assoc_List; + Dtype : Iir; + Type_Info : Type_Info_Acc; + Info : Object_Info_Acc; + Prefix : Iir; + Prefix_Node : Mnode; + Res : O_Enode; + Val : O_Enode; + Param : Iir; + Subprg : O_Dnode; + begin + New_Debug_Line_Stmt (Get_Line_Number (Decl)); + + Info := Get_Info (Decl); + Dtype := Get_Type (Decl); + Type_Info := Get_Info (Dtype); + -- Create the signal (with the time) + case Get_Kind (Decl) is + when Iir_Kind_Stable_Attribute => + Subprg := Ghdl_Create_Stable_Signal; + when Iir_Kind_Quiet_Attribute => + Subprg := Ghdl_Create_Quiet_Signal; + when Iir_Kind_Transaction_Attribute => + Subprg := Ghdl_Create_Transaction_Signal; + when others => + Error_Kind ("elab_signal_attribute", Decl); + end case; + Start_Association (Assoc, Subprg); + case Get_Kind (Decl) is + when Iir_Kind_Stable_Attribute + | Iir_Kind_Quiet_Attribute => + Param := Get_Parameter (Decl); + if Param = Null_Iir then + Val := New_Lit (New_Signed_Literal (Std_Time_Otype, 0)); + else + Val := Chap7.Translate_Expression (Param); + end if; + New_Association (Assoc, Val); + when others => + null; + end case; + Res := New_Convert_Ov (New_Function_Call (Assoc), + Type_Info.Ortho_Type (Mode_Signal)); + New_Assign_Stmt (Get_Var (Info.Object_Var), Res); + + -- Register all signals this depends on. + Prefix := Get_Prefix (Decl); + Prefix_Node := Chap6.Translate_Name (Prefix); + Register_Signal (Prefix_Node, Get_Type (Prefix), + Ghdl_Signal_Attribute_Register_Prefix); + end Elab_Signal_Attribute; + + type Delayed_Signal_Data is record + Pfx : Mnode; + Param : Iir; + end record; + + procedure Create_Delayed_Signal_Noncomposite + (Targ : Mnode; Targ_Type : Iir; Data : Delayed_Signal_Data) + is + pragma Unreferenced (Targ_Type); + Assoc : O_Assoc_List; + Type_Info : Type_Info_Acc; + Val : O_Enode; + begin + Start_Association (Assoc, Ghdl_Create_Delayed_Signal); + New_Association + (Assoc, + New_Convert_Ov (New_Value (M2Lv (Data.Pfx)), Ghdl_Signal_Ptr)); + if Data.Param = Null_Iir then + Val := New_Lit (New_Signed_Literal (Std_Time_Otype, 0)); + else + Val := Chap7.Translate_Expression (Data.Param); + end if; + New_Association (Assoc, Val); + Type_Info := Get_Type_Info (Targ); + New_Assign_Stmt + (M2Lv (Targ), + New_Convert_Ov (New_Function_Call (Assoc), + Type_Info.Ortho_Type (Mode_Signal))); + end Create_Delayed_Signal_Noncomposite; + + function Create_Delayed_Signal_Prepare_Composite + (Targ : Mnode; Targ_Type : Iir; Data : Delayed_Signal_Data) + return Delayed_Signal_Data + is + pragma Unreferenced (Targ_Type); + Res : Delayed_Signal_Data; + begin + Res.Param := Data.Param; + if Get_Type_Info (Targ).Type_Mode = Type_Mode_Record then + Res.Pfx := Stabilize (Data.Pfx); + else + Res.Pfx := Chap3.Get_Array_Base (Data.Pfx); + end if; + return Res; + end Create_Delayed_Signal_Prepare_Composite; + + function Create_Delayed_Signal_Update_Data_Array + (Data : Delayed_Signal_Data; Targ_Type : Iir; Index : O_Dnode) + return Delayed_Signal_Data + is + begin + return Delayed_Signal_Data' + (Pfx => Chap3.Index_Base (Data.Pfx, Targ_Type, + New_Obj_Value (Index)), + Param => Data.Param); + end Create_Delayed_Signal_Update_Data_Array; + + function Create_Delayed_Signal_Update_Data_Record + (Data : Delayed_Signal_Data; + Targ_Type : Iir; + El : Iir_Element_Declaration) + return Delayed_Signal_Data + is + pragma Unreferenced (Targ_Type); + begin + return Delayed_Signal_Data' + (Pfx => Chap6.Translate_Selected_Element (Data.Pfx, El), + Param => Data.Param); + end Create_Delayed_Signal_Update_Data_Record; + + procedure Create_Delayed_Signal_Finish_Data_Composite + (Data : in out Delayed_Signal_Data) + is + pragma Unreferenced (Data); + begin + null; + end Create_Delayed_Signal_Finish_Data_Composite; + + procedure Create_Delayed_Signal is new Foreach_Non_Composite + (Data_Type => Delayed_Signal_Data, + Composite_Data_Type => Delayed_Signal_Data, + Do_Non_Composite => Create_Delayed_Signal_Noncomposite, + Prepare_Data_Array => Create_Delayed_Signal_Prepare_Composite, + Update_Data_Array => Create_Delayed_Signal_Update_Data_Array, + Finish_Data_Array => Create_Delayed_Signal_Finish_Data_Composite, + Prepare_Data_Record => Create_Delayed_Signal_Prepare_Composite, + Update_Data_Record => Create_Delayed_Signal_Update_Data_Record, + Finish_Data_Record => Create_Delayed_Signal_Finish_Data_Composite); + + procedure Elab_Signal_Delayed_Attribute (Decl : Iir) + is + Name_Node : Mnode; + Sig_Type : Iir; + Type_Info : Type_Info_Acc; + Pfx_Node : Mnode; + Data : Delayed_Signal_Data; + begin + Name_Node := Chap6.Translate_Name (Decl); + Sig_Type := Get_Type (Decl); + Type_Info := Get_Info (Sig_Type); + + if Is_Complex_Type (Type_Info) then + Allocate_Complex_Object (Sig_Type, Alloc_System, Name_Node); + -- We cannot stabilize NAME_NODE, since Allocate_Complex_Object + -- assign it. + Name_Node := Chap6.Translate_Name (Decl); + end if; + + Pfx_Node := Chap6.Translate_Name (Get_Prefix (Decl)); + Data := Delayed_Signal_Data'(Pfx => Pfx_Node, + Param => Get_Parameter (Decl)); + + Create_Delayed_Signal (Name_Node, Get_Type (Decl), Data); + end Elab_Signal_Delayed_Attribute; + + procedure Elab_File_Declaration (Decl : Iir_File_Declaration) + is + Constr : O_Assoc_List; + Name : Mnode; + File_Name : Iir; + Open_Kind : Iir; + Mode_Val : O_Enode; + Str : O_Enode; + Is_Text : Boolean; + Info : Type_Info_Acc; + begin + -- Elaborate the file. + Name := Chap6.Translate_Name (Decl); + if Get_Object_Kind (Name) /= Mode_Value then + raise Internal_Error; + end if; + Is_Text := Get_Text_File_Flag (Get_Type (Decl)); + if Is_Text then + Start_Association (Constr, Ghdl_Text_File_Elaborate); + else + Start_Association (Constr, Ghdl_File_Elaborate); + Info := Get_Info (Get_Type (Decl)); + if Info.T.File_Signature /= O_Dnode_Null then + New_Association + (Constr, New_Address (New_Obj (Info.T.File_Signature), + Char_Ptr_Type)); + else + New_Association (Constr, + New_Lit (New_Null_Access (Char_Ptr_Type))); + end if; + end if; + New_Assign_Stmt (M2Lv (Name), New_Function_Call (Constr)); + + -- If file_open_information is present, open the file. + File_Name := Get_File_Logical_Name (Decl); + if File_Name = Null_Iir then + return; + end if; + Open_Temp; + Name := Chap6.Translate_Name (Decl); + Open_Kind := Get_File_Open_Kind (Decl); + if Open_Kind /= Null_Iir then + Mode_Val := New_Convert_Ov + (Chap7.Translate_Expression (Open_Kind), Ghdl_I32_Type); + else + case Get_Mode (Decl) is + when Iir_In_Mode => + Mode_Val := New_Lit (New_Signed_Literal (Ghdl_I32_Type, 0)); + when Iir_Out_Mode => + Mode_Val := New_Lit (New_Signed_Literal (Ghdl_I32_Type, 1)); + when others => + raise Internal_Error; + end case; + end if; + Str := Chap7.Translate_Expression (File_Name, String_Type_Definition); + + if Is_Text then + Start_Association (Constr, Ghdl_Text_File_Open); + else + Start_Association (Constr, Ghdl_File_Open); + end if; + New_Association (Constr, M2E (Name)); + New_Association (Constr, Mode_Val); + New_Association (Constr, Str); + New_Procedure_Call (Constr); + Close_Temp; + end Elab_File_Declaration; + + procedure Final_File_Declaration (Decl : Iir_File_Declaration) + is + Constr : O_Assoc_List; + Name : Mnode; + Is_Text : Boolean; + begin + Is_Text := Get_Text_File_Flag (Get_Type (Decl)); + + Open_Temp; + Name := Chap6.Translate_Name (Decl); + Stabilize (Name); + + -- LRM 3.4.1 File Operations + -- An implicit call to FILE_CLOSE exists in a subprogram body for + -- every file object declared in the corresponding subprogram + -- declarative part. Each such call associates a unique file object + -- with the formal parameter F and is called whenever the + -- corresponding subprogram completes its execution. + if Is_Text then + Start_Association (Constr, Ghdl_Text_File_Close); + else + Start_Association (Constr, Ghdl_File_Close); + end if; + New_Association (Constr, M2E (Name)); + New_Procedure_Call (Constr); + + if Is_Text then + Start_Association (Constr, Ghdl_Text_File_Finalize); + else + Start_Association (Constr, Ghdl_File_Finalize); + end if; + New_Association (Constr, M2E (Name)); + New_Procedure_Call (Constr); + + Close_Temp; + end Final_File_Declaration; + + procedure Translate_Type_Declaration (Decl : Iir) + is + begin + Chap3.Translate_Named_Type_Definition (Get_Type_Definition (Decl), + Get_Identifier (Decl)); + end Translate_Type_Declaration; + + procedure Translate_Anonymous_Type_Declaration (Decl : Iir) + is + Mark : Id_Mark_Type; + Mark1 : Id_Mark_Type; + begin + Push_Identifier_Prefix (Mark, Get_Identifier (Decl)); + Push_Identifier_Prefix (Mark1, "BT"); + Chap3.Translate_Type_Definition (Get_Type_Definition (Decl)); + Pop_Identifier_Prefix (Mark1); + Pop_Identifier_Prefix (Mark); + end Translate_Anonymous_Type_Declaration; + + procedure Translate_Subtype_Declaration (Decl : Iir_Subtype_Declaration) + is + begin + Chap3.Translate_Named_Type_Definition (Get_Type (Decl), + Get_Identifier (Decl)); + end Translate_Subtype_Declaration; + + procedure Translate_Bool_Type_Declaration (Decl : Iir_Type_Declaration) + is + Mark : Id_Mark_Type; + begin + Push_Identifier_Prefix (Mark, Get_Identifier (Decl)); + Chap3.Translate_Bool_Type_Definition (Get_Type_Definition (Decl)); + Pop_Identifier_Prefix (Mark); + end Translate_Bool_Type_Declaration; + + procedure Translate_Object_Alias_Declaration + (Decl : Iir_Object_Alias_Declaration) + is + Decl_Type : Iir; + Info : Alias_Info_Acc; + Tinfo : Type_Info_Acc; + Atype : O_Tnode; + begin + Decl_Type := Get_Type (Decl); + + Chap3.Translate_Named_Type_Definition + (Decl_Type, Get_Identifier (Decl)); + + Info := Add_Info (Decl, Kind_Alias); + case Get_Kind (Get_Object_Prefix (Decl)) is + when Iir_Kind_Signal_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Guard_Signal_Declaration => + Info.Alias_Kind := Mode_Signal; + when others => + Info.Alias_Kind := Mode_Value; + end case; + + Tinfo := Get_Info (Decl_Type); + case Tinfo.Type_Mode is + when Type_Mode_Fat_Array => + -- create an object. + -- At elaboration: copy base from name, copy bounds from type, + -- check for matching bounds. + Atype := Get_Ortho_Type (Decl_Type, Info.Alias_Kind); + when Type_Mode_Array + | Type_Mode_Acc + | Type_Mode_Fat_Acc => + -- Create an object pointer. + -- At elaboration: copy base from name. + Atype := Tinfo.Ortho_Ptr_Type (Info.Alias_Kind); + when Type_Mode_Scalar => + case Info.Alias_Kind is + when Mode_Signal => + Atype := Tinfo.Ortho_Type (Mode_Signal); + when Mode_Value => + Atype := Tinfo.Ortho_Ptr_Type (Mode_Value); + end case; + when Type_Mode_Record => + -- Create an object pointer. + -- At elaboration: copy base from name. + Atype := Tinfo.Ortho_Ptr_Type (Info.Alias_Kind); + when others => + raise Internal_Error; + end case; + Info.Alias_Var := Create_Var (Create_Var_Identifier (Decl), Atype); + end Translate_Object_Alias_Declaration; + + procedure Elab_Object_Alias_Declaration + (Decl : Iir_Object_Alias_Declaration) + is + Decl_Type : Iir; + Name : Iir; + Name_Node : Mnode; + Alias_Node : Mnode; + Alias_Info : Alias_Info_Acc; + Name_Type : Iir; + Tinfo : Type_Info_Acc; + Kind : Object_Kind_Type; + begin + New_Debug_Line_Stmt (Get_Line_Number (Decl)); + + Decl_Type := Get_Type (Decl); + Tinfo := Get_Info (Decl_Type); + + Alias_Info := Get_Info (Decl); + Chap3.Elab_Object_Subtype (Decl_Type); + Name := Get_Name (Decl); + Name_Type := Get_Type (Name); + Name_Node := Chap6.Translate_Name (Name); + Kind := Get_Object_Kind (Name_Node); + + case Tinfo.Type_Mode is + when Type_Mode_Fat_Array => + Open_Temp; + Stabilize (Name_Node); + Alias_Node := Stabilize + (Get_Var (Alias_Info.Alias_Var, + Tinfo, Alias_Info.Alias_Kind)); + Copy_Fat_Pointer (Alias_Node, Name_Node); + Close_Temp; + when Type_Mode_Array => + Open_Temp; + Stabilize (Name_Node); + New_Assign_Stmt + (Get_Var (Alias_Info.Alias_Var), + M2E (Chap3.Get_Array_Base (Name_Node))); + Chap3.Check_Array_Match (Decl_Type, T2M (Decl_Type, Kind), + Name_Type, Name_Node, + Decl); + Close_Temp; + when Type_Mode_Acc + | Type_Mode_Fat_Acc => + New_Assign_Stmt (Get_Var (Alias_Info.Alias_Var), + M2Addr (Name_Node)); + when Type_Mode_Scalar => + case Alias_Info.Alias_Kind is + when Mode_Value => + New_Assign_Stmt (Get_Var (Alias_Info.Alias_Var), + M2Addr (Name_Node)); + when Mode_Signal => + New_Assign_Stmt (Get_Var (Alias_Info.Alias_Var), + M2E (Name_Node)); + end case; + when Type_Mode_Record => + Open_Temp; + Stabilize (Name_Node); + New_Assign_Stmt (Get_Var (Alias_Info.Alias_Var), + M2Addr (Name_Node)); + Close_Temp; + when others => + raise Internal_Error; + end case; + end Elab_Object_Alias_Declaration; + + procedure Translate_Port_Chain (Parent : Iir) + is + Port : Iir; + begin + Port := Get_Port_Chain (Parent); + while Port /= Null_Iir loop + Create_Signal (Port); + Port := Get_Chain (Port); + end loop; + end Translate_Port_Chain; + + procedure Translate_Generic_Chain (Parent : Iir) + is + Decl : Iir; + begin + Decl := Get_Generic_Chain (Parent); + while Decl /= Null_Iir loop + case Get_Kind (Decl) is + when Iir_Kinds_Interface_Object_Declaration => + Create_Object (Decl); + when Iir_Kind_Interface_Package_Declaration => + Create_Package_Interface (Decl); + when others => + Error_Kind ("translate_generic_chain", Decl); + end case; + Decl := Get_Chain (Decl); + end loop; + end Translate_Generic_Chain; + + -- Create instance record for a component. + procedure Translate_Component_Declaration (Decl : Iir) + is + Mark : Id_Mark_Type; + Info : Ortho_Info_Acc; + begin + Info := Add_Info (Decl, Kind_Component); + Push_Identifier_Prefix (Mark, Get_Identifier (Decl)); + Push_Instance_Factory (Info.Comp_Scope'Access); + + Info.Comp_Link := Add_Instance_Factory_Field + (Wki_Instance, Rtis.Ghdl_Component_Link_Type); + + -- Generic and ports. + Translate_Generic_Chain (Decl); + Translate_Port_Chain (Decl); + + Pop_Instance_Factory (Info.Comp_Scope'Access); + New_Type_Decl (Create_Identifier ("_COMPTYPE"), + Get_Scope_Type (Info.Comp_Scope)); + Info.Comp_Ptr_Type := New_Access_Type + (Get_Scope_Type (Info.Comp_Scope)); + New_Type_Decl (Create_Identifier ("_COMPPTR"), Info.Comp_Ptr_Type); + Pop_Identifier_Prefix (Mark); + end Translate_Component_Declaration; + + procedure Translate_Declaration (Decl : Iir) + is + begin + case Get_Kind (Decl) is + when Iir_Kind_Use_Clause => + null; + when Iir_Kind_Configuration_Specification => + null; + when Iir_Kind_Disconnection_Specification => + null; + + when Iir_Kind_Component_Declaration => + Chap4.Translate_Component_Declaration (Decl); + when Iir_Kind_Type_Declaration => + Chap4.Translate_Type_Declaration (Decl); + when Iir_Kind_Anonymous_Type_Declaration => + Chap4.Translate_Anonymous_Type_Declaration (Decl); + when Iir_Kind_Subtype_Declaration => + Chap4.Translate_Subtype_Declaration (Decl); + + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + raise Internal_Error; + when Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body => + null; + + when Iir_Kind_Protected_Type_Body => + null; + + --when Iir_Kind_Implicit_Function_Declaration => + --when Iir_Kind_Signal_Declaration + -- | Iir_Kind_Interface_Signal_Declaration => + -- Chap4.Create_Object (Decl); + + when Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration => + Create_Object (Decl); + + when Iir_Kind_Signal_Declaration => + Create_Signal (Decl); + + when Iir_Kind_Object_Alias_Declaration => + Translate_Object_Alias_Declaration (Decl); + + when Iir_Kind_Non_Object_Alias_Declaration => + null; + + when Iir_Kind_File_Declaration => + Create_File_Object (Decl); + + when Iir_Kind_Attribute_Declaration => + -- Useless as attribute declarations have a type mark. + Chap3.Translate_Object_Subtype (Decl); + + when Iir_Kind_Attribute_Specification => + Chap5.Translate_Attribute_Specification (Decl); + + when Iir_Kinds_Signal_Attribute => + Chap4.Create_Implicit_Signal (Decl); + + when Iir_Kind_Guard_Signal_Declaration => + Create_Signal (Decl); + + when Iir_Kind_Group_Template_Declaration => + null; + when Iir_Kind_Group_Declaration => + null; + + when others => + Error_Kind ("translate_declaration", Decl); + end case; + end Translate_Declaration; + + procedure Translate_Resolution_Function (Func : Iir) + is + -- Type of the resolution function parameter. + El_Type : Iir; + El_Info : Type_Info_Acc; + Finfo : constant Subprg_Info_Acc := Get_Info (Func); + Interface_List : O_Inter_List; + Rinfo : constant Subprg_Resolv_Info_Acc := Finfo.Subprg_Resolv; + Id : O_Ident; + Itype : O_Tnode; + Unused_Instance : O_Dnode; + begin + if Rinfo = null then + -- Not a resolution function + return; + end if; + + -- Declare the procedure. + Id := Create_Identifier (Func, Get_Overload_Number (Func), "_RESOLV"); + Start_Procedure_Decl (Interface_List, Id, Global_Storage); + + -- The instance. + if Subprgs.Has_Current_Subprg_Instance then + Subprgs.Add_Subprg_Instance_Interfaces (Interface_List, + Rinfo.Var_Instance); + else + -- Create a dummy instance parameter + New_Interface_Decl (Interface_List, Unused_Instance, + Wki_Instance, Ghdl_Ptr_Type); + Rinfo.Var_Instance := Subprgs.Null_Subprg_Instance; + end if; + + -- The signal. + El_Type := Get_Type (Get_Interface_Declaration_Chain (Func)); + El_Type := Get_Element_Subtype (El_Type); + El_Info := Get_Info (El_Type); + -- FIXME: create a function for getting the type of an interface. + case El_Info.Type_Mode is + when Type_Mode_Thin => + Itype := El_Info.Ortho_Type (Mode_Signal); + when Type_Mode_Fat => + Itype := El_Info.Ortho_Ptr_Type (Mode_Signal); + when Type_Mode_Unknown => + raise Internal_Error; + end case; + New_Interface_Decl + (Interface_List, Rinfo.Var_Vals, Get_Identifier ("VALS"), Itype); + + New_Interface_Decl + (Interface_List, Rinfo.Var_Vec, Get_Identifier ("bool_vec"), + Ghdl_Bool_Array_Ptr); + New_Interface_Decl + (Interface_List, Rinfo.Var_Vlen, Get_Identifier ("vec_len"), + Ghdl_Index_Type); + New_Interface_Decl + (Interface_List, Rinfo.Var_Nbr_Drv, Get_Identifier ("nbr_drv"), + Ghdl_Index_Type); + New_Interface_Decl + (Interface_List, Rinfo.Var_Nbr_Ports, Get_Identifier ("nbr_ports"), + Ghdl_Index_Type); + + Finish_Subprogram_Decl (Interface_List, Rinfo.Resolv_Func); + end Translate_Resolution_Function; + + type Read_Source_Kind is (Read_Port, Read_Driver); + type Read_Source_Data is record + Sig : Mnode; + Drv_Index : O_Dnode; + Kind : Read_Source_Kind; + end record; + + procedure Read_Source_Non_Composite + (Targ : Mnode; Targ_Type : Iir; Data : Read_Source_Data) + is + Assoc : O_Assoc_List; + Targ_Info : Type_Info_Acc; + E : O_Enode; + begin + Targ_Info := Get_Info (Targ_Type); + case Data.Kind is + when Read_Port => + Start_Association (Assoc, Ghdl_Signal_Read_Port); + when Read_Driver => + Start_Association (Assoc, Ghdl_Signal_Read_Driver); + end case; + + New_Association + (Assoc, New_Convert_Ov (M2E (Data.Sig), Ghdl_Signal_Ptr)); + New_Association (Assoc, New_Obj_Value (Data.Drv_Index)); + E := New_Convert_Ov (New_Function_Call (Assoc), + Targ_Info.Ortho_Ptr_Type (Mode_Value)); + New_Assign_Stmt (M2Lv (Targ), + New_Value (New_Access_Element (E))); + end Read_Source_Non_Composite; + + function Read_Source_Prepare_Data_Array + (Targ: Mnode; Targ_Type : Iir; Data : Read_Source_Data) + return Read_Source_Data + is + pragma Unreferenced (Targ, Targ_Type); + begin + return Data; + end Read_Source_Prepare_Data_Array; + + function Read_Source_Prepare_Data_Record + (Targ : Mnode; Targ_Type : Iir; Data : Read_Source_Data) + return Read_Source_Data + is + pragma Unreferenced (Targ, Targ_Type); + begin + return Read_Source_Data'(Sig => Stabilize (Data.Sig), + Drv_Index => Data.Drv_Index, + Kind => Data.Kind); + end Read_Source_Prepare_Data_Record; + + function Read_Source_Update_Data_Array + (Data : Read_Source_Data; Targ_Type : Iir; Index : O_Dnode) + return Read_Source_Data + is + begin + return Read_Source_Data' + (Sig => Chap3.Index_Base (Data.Sig, Targ_Type, + New_Obj_Value (Index)), + Drv_Index => Data.Drv_Index, + Kind => Data.Kind); + end Read_Source_Update_Data_Array; + + function Read_Source_Update_Data_Record + (Data : Read_Source_Data; + Targ_Type : Iir; + El : Iir_Element_Declaration) + return Read_Source_Data + is + pragma Unreferenced (Targ_Type); + begin + return Read_Source_Data' + (Sig => Chap6.Translate_Selected_Element (Data.Sig, El), + Drv_Index => Data.Drv_Index, + Kind => Data.Kind); + end Read_Source_Update_Data_Record; + + procedure Read_Source_Finish_Data_Composite + (Data : in out Read_Source_Data) + is + pragma Unreferenced (Data); + begin + null; + end Read_Source_Finish_Data_Composite; + + procedure Read_Signal_Source is new Foreach_Non_Composite + (Data_Type => Read_Source_Data, + Composite_Data_Type => Read_Source_Data, + Do_Non_Composite => Read_Source_Non_Composite, + Prepare_Data_Array => Read_Source_Prepare_Data_Array, + Update_Data_Array => Read_Source_Update_Data_Array, + Finish_Data_Array => Read_Source_Finish_Data_Composite, + Prepare_Data_Record => Read_Source_Prepare_Data_Record, + Update_Data_Record => Read_Source_Update_Data_Record, + Finish_Data_Record => Read_Source_Finish_Data_Composite); + + procedure Translate_Resolution_Function_Body (Func : Iir) + is + -- Type of the resolution function parameter. + Arr_Type : Iir; + Base_Type : Iir; + Base_Info : Type_Info_Acc; + Index_Info : Index_Info_Acc; + + -- Type of parameter element. + El_Type : Iir; + El_Info : Type_Info_Acc; + + -- Type of the function return value. + Ret_Type : Iir; + Ret_Info : Type_Info_Acc; + + -- Type and info of the array index. + Index_Type : Iir; + Index_Tinfo : Type_Info_Acc; + + -- Local variables. + Var_I : O_Dnode; + Var_J : O_Dnode; + Var_Length : O_Dnode; + Var_Res : O_Dnode; + + Vals : Mnode; + Res : Mnode; + + If_Blk : O_If_Block; + Label : O_Snode; + + V : Mnode; + + Var_Bound : O_Dnode; + Var_Range_Ptr : O_Dnode; + Var_Array : O_Dnode; + Finfo : constant Subprg_Info_Acc := Get_Info (Func); + Rinfo : constant Subprg_Resolv_Info_Acc := Finfo.Subprg_Resolv; + Assoc : O_Assoc_List; + + Data : Read_Source_Data; + begin + if Rinfo = null then + -- No resolver for this function + return; + end if; + + Ret_Type := Get_Return_Type (Func); + Ret_Info := Get_Info (Ret_Type); + + Arr_Type := Get_Type (Get_Interface_Declaration_Chain (Func)); + Base_Type := Get_Base_Type (Arr_Type); + Index_Info := Get_Info + (Get_First_Element (Get_Index_Subtype_Definition_List (Base_Type))); + Base_Info := Get_Info (Base_Type); + + El_Type := Get_Element_Subtype (Arr_Type); + El_Info := Get_Info (El_Type); + + Index_Type := Get_Index_Type (Arr_Type, 0); + Index_Tinfo := Get_Info (Index_Type); + + Start_Subprogram_Body (Rinfo.Resolv_Func); + if Subprgs.Has_Subprg_Instance (Rinfo.Var_Instance) then + Subprgs.Start_Subprg_Instance_Use (Rinfo.Var_Instance); + end if; + Push_Local_Factory; + + -- A signal. + + New_Var_Decl + (Var_Res, Get_Identifier ("res"), + O_Storage_Local, Get_Object_Type (Ret_Info, Mode_Value)); + + -- I, J. + New_Var_Decl (Var_I, Wki_I, O_Storage_Local, Ghdl_Index_Type); + New_Var_Decl (Var_J, Get_Identifier ("J"), + O_Storage_Local, Ghdl_Index_Type); + + -- Length. + New_Var_Decl + (Var_Length, Wki_Length, O_Storage_Local, Ghdl_Index_Type); + + New_Var_Decl (Var_Bound, Get_Identifier ("BOUND"), O_Storage_Local, + Base_Info.T.Bounds_Type); + New_Var_Decl (Var_Array, Get_Identifier ("ARRAY"), O_Storage_Local, + Base_Info.Ortho_Type (Mode_Value)); + + New_Var_Decl (Var_Range_Ptr, Get_Identifier ("RANGE_PTR"), + O_Storage_Local, Index_Tinfo.T.Range_Ptr_Type); + + Open_Temp; + + case El_Info.Type_Mode is + when Type_Mode_Thin => + Vals := Dv2M (Rinfo.Var_Vals, El_Info, Mode_Signal); + when Type_Mode_Fat => + Vals := Dp2M (Rinfo.Var_Vals, El_Info, Mode_Signal); + when Type_Mode_Unknown => + raise Internal_Error; + end case; + + -- * length := vec_len + nports; + New_Assign_Stmt (New_Obj (Var_Length), + New_Dyadic_Op (ON_Add_Ov, + New_Obj_Value (Rinfo.Var_Vlen), + New_Obj_Value (Rinfo.Var_Nbr_Ports))); + + -- * range_ptr := BOUND.dim_1'address; + New_Assign_Stmt + (New_Obj (Var_Range_Ptr), + New_Address (New_Selected_Element (New_Obj (Var_Bound), + Index_Info.Index_Field), + Index_Tinfo.T.Range_Ptr_Type)); + + -- Create range from length + Chap3.Create_Range_From_Length + (Index_Type, Var_Length, Var_Range_Ptr, Func); + New_Assign_Stmt + (New_Selected_Element (New_Obj (Var_Array), + Base_Info.T.Bounds_Field (Mode_Value)), + New_Address (New_Obj (Var_Bound), Base_Info.T.Bounds_Ptr_Type)); + + -- Allocate the array. + Chap3.Allocate_Fat_Array_Base + (Alloc_Stack, Dv2M (Var_Array, Base_Info, Mode_Value), Base_Type); + + -- Fill the array + -- 1. From ports. + -- * I := 0; + Init_Var (Var_I); + -- * loop + Start_Loop_Stmt (Label); + -- * exit when I = nports; + Gen_Exit_When (Label, + New_Compare_Op (ON_Eq, + New_Obj_Value (Var_I), + New_Obj_Value (Rinfo.Var_Nbr_Ports), + Ghdl_Bool_Type)); + -- fill array[i] + V := Chap3.Index_Base + (Chap3.Get_Array_Base (Dv2M (Var_Array, Base_Info, Mode_Value)), + Base_Type, New_Obj_Value (Var_I)); + Data := Read_Source_Data'(Vals, Var_I, Read_Port); + Read_Signal_Source (V, El_Type, Data); + + -- * I := I + 1; + Inc_Var (Var_I); + -- * end loop; + Finish_Loop_Stmt (Label); + + -- 2. From drivers. + -- * J := 0; + -- * loop + -- * exit when j = var_max; + -- * if vec[j] then + -- + -- * ptr := get_signal_driver (sig, j); + -- * array[i].XXX := *ptr + -- + -- * i := i + 1; + -- * end if; + -- * J := J + 1; + -- * end loop; + Init_Var (Var_J); + Start_Loop_Stmt (Label); + Gen_Exit_When (Label, + New_Compare_Op (ON_Eq, + New_Obj_Value (Var_J), + New_Obj_Value (Rinfo.Var_Nbr_Drv), + Ghdl_Bool_Type)); + Start_If_Stmt + (If_Blk, + New_Value (New_Indexed_Acc_Value (New_Obj (Rinfo.Var_Vec), + New_Obj_Value (Var_J)))); + + V := Chap3.Index_Base + (Chap3.Get_Array_Base (Dv2M (Var_Array, Base_Info, Mode_Value)), + Base_Type, New_Obj_Value (Var_I)); + Data := Read_Source_Data'(Vals, Var_J, Read_Driver); + Read_Signal_Source (V, El_Type, Data); + + Inc_Var (Var_I); + Finish_If_Stmt (If_Blk); + + Inc_Var (Var_J); + Finish_Loop_Stmt (Label); + + if Finfo.Res_Interface /= O_Dnode_Null then + Res := Lo2M (Var_Res, Ret_Info, Mode_Value); + if Ret_Info.Type_Mode /= Type_Mode_Fat_Array then + Allocate_Complex_Object (Ret_Type, Alloc_Stack, Res); + end if; + end if; + + -- Call the resolution function. + if Finfo.Use_Stack2 then + Create_Temp_Stack2_Mark; + end if; + + Start_Association (Assoc, Finfo.Ortho_Func); + if Finfo.Res_Interface /= O_Dnode_Null then + New_Association (Assoc, M2E (Res)); + end if; + Subprgs.Add_Subprg_Instance_Assoc (Assoc, Finfo.Subprg_Instance); + New_Association + (Assoc, New_Address (New_Obj (Var_Array), + Base_Info.Ortho_Ptr_Type (Mode_Value))); + + if Finfo.Res_Interface = O_Dnode_Null then + Res := E2M (New_Function_Call (Assoc), Ret_Info, Mode_Value); + else + New_Procedure_Call (Assoc); + end if; + + if El_Type /= Ret_Type then + Res := E2M + (Chap7.Translate_Implicit_Conv (M2E (Res), Ret_Type, El_Type, + Mode_Value, Func), + El_Info, Mode_Value); + end if; + Chap7.Set_Driving_Value (Vals, El_Type, Res); + + Close_Temp; + Pop_Local_Factory; + if Subprgs.Has_Subprg_Instance (Rinfo.Var_Instance) then + Subprgs.Finish_Subprg_Instance_Use (Rinfo.Var_Instance); + end if; + Finish_Subprogram_Body; + end Translate_Resolution_Function_Body; + + procedure Translate_Declaration_Chain (Parent : Iir) + is + Info : Subprg_Info_Acc; + El : Iir; + begin + El := Get_Declaration_Chain (Parent); + while El /= Null_Iir loop + case Get_Kind (El) is + when Iir_Kind_Procedure_Declaration + | Iir_Kind_Function_Declaration => + -- Translate interfaces. + if (not Flag_Discard_Unused or else Get_Use_Flag (El)) + and then not Is_Second_Subprogram_Specification (El) + then + Info := Add_Info (El, Kind_Subprg); + Chap2.Translate_Subprogram_Interfaces (El); + if Get_Kind (El) = Iir_Kind_Function_Declaration then + if Get_Resolution_Function_Flag (El) then + Info.Subprg_Resolv := new Subprg_Resolv_Info; + end if; + end if; + end if; + when Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body => + null; + when Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration => + null; + when others => + Translate_Declaration (El); + end case; + El := Get_Chain (El); + end loop; + end Translate_Declaration_Chain; + + procedure Translate_Declaration_Chain_Subprograms (Parent : Iir) + is + El : Iir; + Infos : Chap7.Implicit_Subprogram_Infos; + begin + El := Get_Declaration_Chain (Parent); + while El /= Null_Iir loop + case Get_Kind (El) is + when Iir_Kind_Procedure_Declaration + | Iir_Kind_Function_Declaration => + -- Translate only if used. + if Get_Info (El) /= null then + Chap2.Translate_Subprogram_Declaration (El); + Translate_Resolution_Function (El); + end if; + when Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body => + -- Do not translate body if generating only specs (for + -- subprograms in an entity). + if Global_Storage /= O_Storage_External + and then + (not Flag_Discard_Unused + or else + Get_Use_Flag (Get_Subprogram_Specification (El))) + then + Chap2.Translate_Subprogram_Body (El); + Translate_Resolution_Function_Body + (Get_Subprogram_Specification (El)); + end if; + when Iir_Kind_Type_Declaration + | Iir_Kind_Anonymous_Type_Declaration => + Chap3.Translate_Type_Subprograms (El); + Chap7.Init_Implicit_Subprogram_Infos (Infos); + when Iir_Kind_Protected_Type_Body => + Chap3.Translate_Protected_Type_Body (El); + Chap3.Translate_Protected_Type_Body_Subprograms (El); + when Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration => + if Flag_Discard_Unused_Implicit + and then not Get_Use_Flag (El) + then + case Get_Implicit_Definition (El) is + when Iir_Predefined_Array_Equality + | Iir_Predefined_Array_Greater + | Iir_Predefined_Record_Equality => + -- Used implicitly in case statement or other + -- predefined equality. + Chap7.Translate_Implicit_Subprogram (El, Infos); + when others => + null; + end case; + else + Chap7.Translate_Implicit_Subprogram (El, Infos); + end if; + when others => + null; + end case; + El := Get_Chain (El); + end loop; + end Translate_Declaration_Chain_Subprograms; + + procedure Elab_Declaration_Chain (Parent : Iir; Need_Final : out Boolean) + is + Decl : Iir; + begin + Decl := Get_Declaration_Chain (Parent); + Need_Final := False; + while Decl /= Null_Iir loop + case Get_Kind (Decl) is + when Iir_Kind_Use_Clause => + null; + when Iir_Kind_Component_Declaration => + null; + when Iir_Kind_Configuration_Specification => + null; + when Iir_Kind_Disconnection_Specification => + Chap5.Elab_Disconnection_Specification (Decl); + + when Iir_Kind_Type_Declaration + | Iir_Kind_Anonymous_Type_Declaration => + Chap3.Elab_Type_Declaration (Decl); + when Iir_Kind_Subtype_Declaration => + Chap3.Elab_Subtype_Declaration (Decl); + + when Iir_Kind_Protected_Type_Body => + null; + + --when Iir_Kind_Signal_Declaration => + -- Chap1.Elab_Signal (Decl); + when Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration => + Elab_Object (Decl); + if Get_Kind (Get_Type (Decl)) + = Iir_Kind_Protected_Type_Declaration + then + Need_Final := True; + end if; + + when Iir_Kind_Signal_Declaration => + Elab_Signal_Declaration (Decl, Parent, False); + + when Iir_Kind_Object_Alias_Declaration => + Elab_Object_Alias_Declaration (Decl); + + when Iir_Kind_Non_Object_Alias_Declaration => + null; + + when Iir_Kind_File_Declaration => + Elab_File_Declaration (Decl); + Need_Final := True; + + when Iir_Kind_Attribute_Declaration => + Chap3.Elab_Object_Subtype (Get_Type (Decl)); + + when Iir_Kind_Attribute_Specification => + Chap5.Elab_Attribute_Specification (Decl); + + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + if Get_Info (Decl) /= null then + Chap2.Elab_Subprogram_Interfaces (Decl); + end if; + when Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body => + null; + + when Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration => + null; + + when Iir_Kind_Stable_Attribute + | Iir_Kind_Quiet_Attribute + | Iir_Kind_Transaction_Attribute => + Elab_Signal_Attribute (Decl); + + when Iir_Kind_Delayed_Attribute => + Elab_Signal_Delayed_Attribute (Decl); + + when Iir_Kind_Group_Template_Declaration + | Iir_Kind_Group_Declaration => + null; + + when others => + Error_Kind ("elab_declaration_chain", Decl); + end case; + + Decl := Get_Chain (Decl); + end loop; + end Elab_Declaration_Chain; + + procedure Final_Declaration_Chain (Parent : Iir; Deallocate : Boolean) + is + Decl : Iir; + begin + Decl := Get_Declaration_Chain (Parent); + while Decl /= Null_Iir loop + case Get_Kind (Decl) is + when Iir_Kind_File_Declaration => + Final_File_Declaration (Decl); + when Iir_Kind_Variable_Declaration => + if Get_Kind (Get_Type (Decl)) + = Iir_Kind_Protected_Type_Declaration + then + Fini_Protected_Object (Decl); + end if; + if Deallocate then + Fini_Object (Decl); + end if; + when Iir_Kind_Constant_Declaration => + if Deallocate then + Fini_Object (Decl); + end if; + when others => + null; + end case; + + Decl := Get_Chain (Decl); + end loop; + end Final_Declaration_Chain; + + type Conv_Mode is (Conv_Mode_In, Conv_Mode_Out); + + -- Create subprogram for an association conversion. + -- STMT is the statement/block_header containing the association. + -- BLOCK is the architecture/block containing the instance. + -- ASSOC is the association and MODE the conversion to work on. + -- CONV_INFO is the result place holder. + -- BASE_BLOCK is the base architecture/block containing the instance. + -- ENTITY is the entity/component instantiated (null for block_stmt) + procedure Translate_Association_Subprogram + (Stmt : Iir; + Block : Iir; + Assoc : Iir; + Mode : Conv_Mode; + Conv_Info : in out Assoc_Conv_Info; + Base_Block : Iir; + Entity : Iir) + is + Formal : constant Iir := Get_Formal (Assoc); + Actual : constant Iir := Get_Actual (Assoc); + + Mark2, Mark3 : Id_Mark_Type; + Inter_List : O_Inter_List; + In_Type, Out_Type : Iir; + In_Info, Out_Info : Type_Info_Acc; + Itype : O_Tnode; + El_List : O_Element_List; + Block_Info : constant Block_Info_Acc := Get_Info (Base_Block); + Stmt_Info : Block_Info_Acc; + Entity_Info : Ortho_Info_Acc; + Var_Data : O_Dnode; + + -- Variables for body. + E : O_Enode; + V : O_Dnode; + V1 : O_Lnode; + V_Out : Mnode; + R : O_Enode; + Constr : O_Assoc_List; + Subprg_Info : Subprg_Info_Acc; + Res : Mnode; + Imp : Iir; + Func : Iir; + begin + case Mode is + when Conv_Mode_In => + -- IN: from actual to formal. + Push_Identifier_Prefix (Mark2, "CONVIN"); + Out_Type := Get_Type (Formal); + In_Type := Get_Type (Actual); + Imp := Get_In_Conversion (Assoc); + + when Conv_Mode_Out => + -- OUT: from formal to actual. + Push_Identifier_Prefix (Mark2, "CONVOUT"); + In_Type := Get_Type (Formal); + Out_Type := Get_Type (Actual); + Imp := Get_Out_Conversion (Assoc); + + end case; + -- FIXME: individual assoc -> overload. + Push_Identifier_Prefix + (Mark3, Get_Identifier (Get_Association_Interface (Assoc))); + + -- Handle anonymous subtypes. + Chap3.Translate_Anonymous_Type_Definition (Out_Type, False); + Chap3.Translate_Anonymous_Type_Definition (In_Type, False); + Out_Info := Get_Info (Out_Type); + In_Info := Get_Info (In_Type); + + -- Start record containing data for the conversion function. + Start_Record_Type (El_List); + + -- Add instance field. + Conv_Info.Instance_Block := Base_Block; + New_Record_Field + (El_List, Conv_Info.Instance_Field, Wki_Instance, + Block_Info.Block_Decls_Ptr_Type); + + if Entity /= Null_Iir then + Conv_Info.Instantiated_Entity := Entity; + Entity_Info := Get_Info (Entity); + declare + Ptr : O_Tnode; + begin + if Entity_Info.Kind = Kind_Component then + Ptr := Entity_Info.Comp_Ptr_Type; + else + Ptr := Entity_Info.Block_Decls_Ptr_Type; + end if; + New_Record_Field + (El_List, Conv_Info.Instantiated_Field, + Get_Identifier ("instantiated"), Ptr); + end; + else + Conv_Info.Instantiated_Entity := Null_Iir; + Conv_Info.Instantiated_Field := O_Fnode_Null; + end if; + + -- Add input. + case In_Info.Type_Mode is + when Type_Mode_Thin => + Itype := In_Info.Ortho_Type (Mode_Signal); + when Type_Mode_Fat => + Itype := In_Info.Ortho_Ptr_Type (Mode_Signal); + when Type_Mode_Unknown => + raise Internal_Error; + end case; + New_Record_Field + (El_List, Conv_Info.In_Field, Get_Identifier ("val_in"), Itype); + + -- Add output. + New_Record_Field + (El_List, Conv_Info.Out_Field, Get_Identifier ("val_out"), + Get_Object_Type (Out_Info, Mode_Signal)); + Finish_Record_Type (El_List, Conv_Info.Record_Type); + New_Type_Decl (Create_Identifier ("DTYPE"), Conv_Info.Record_Type); + Conv_Info.Record_Ptr_Type := New_Access_Type (Conv_Info.Record_Type); + New_Type_Decl (Create_Identifier ("DPTR"), Conv_Info.Record_Ptr_Type); + + -- Declare the subprogram. + Start_Procedure_Decl + (Inter_List, Create_Identifier, O_Storage_Private); + New_Interface_Decl + (Inter_List, Var_Data, Get_Identifier ("data"), + Conv_Info.Record_Ptr_Type); + Finish_Subprogram_Decl (Inter_List, Conv_Info.Subprg); + + Start_Subprogram_Body (Conv_Info.Subprg); + Push_Local_Factory; + Open_Temp; + + -- Add an access to local block. + V := Create_Temp_Init + (Block_Info.Block_Decls_Ptr_Type, + New_Value_Selected_Acc_Value (New_Obj (Var_Data), + Conv_Info.Instance_Field)); + Set_Scope_Via_Param_Ptr (Block_Info.Block_Scope, V); + + -- Add an access to instantiated entity. + -- This may be used to do some type checks. + if Conv_Info.Instantiated_Entity /= Null_Iir then + declare + Ptr_Type : O_Tnode; + begin + if Entity_Info.Kind = Kind_Component then + Ptr_Type := Entity_Info.Comp_Ptr_Type; + else + Ptr_Type := Entity_Info.Block_Decls_Ptr_Type; + end if; + V := Create_Temp_Init + (Ptr_Type, + New_Value_Selected_Acc_Value (New_Obj (Var_Data), + Conv_Info.Instantiated_Field)); + if Entity_Info.Kind = Kind_Component then + Set_Scope_Via_Param_Ptr (Entity_Info.Comp_Scope, V); + else + Set_Scope_Via_Param_Ptr (Entity_Info.Block_Scope, V); + end if; + end; + end if; + + -- Add access to the instantiation-specific data. + -- This is used only for anonymous subtype variables. + -- FIXME: what if STMT is a binding_indication ? + Stmt_Info := Get_Info (Stmt); + if Stmt_Info /= null + and then Has_Scope_Type (Stmt_Info.Block_Scope) + then + Set_Scope_Via_Field (Stmt_Info.Block_Scope, + Stmt_Info.Block_Parent_Field, + Get_Info (Block).Block_Scope'Access); + end if; + + -- Read signal value. + E := New_Value_Selected_Acc_Value (New_Obj (Var_Data), + Conv_Info.In_Field); + case Mode is + when Conv_Mode_In => + R := Chap7.Translate_Signal_Effective_Value (E, In_Type); + when Conv_Mode_Out => + R := Chap7.Translate_Signal_Driving_Value (E, In_Type); + end case; + + case Get_Kind (Imp) is + when Iir_Kind_Function_Call => + Func := Get_Implementation (Imp); + R := Chap7.Translate_Implicit_Conv + (R, In_Type, + Get_Type (Get_Interface_Declaration_Chain (Func)), + Mode_Value, Assoc); + + -- Create result value. + Subprg_Info := Get_Info (Func); + + if Subprg_Info.Use_Stack2 then + Create_Temp_Stack2_Mark; + end if; + + if Subprg_Info.Res_Interface /= O_Dnode_Null then + -- Composite result. + -- If we need to allocate, do it before starting the call! + declare + Res_Type : constant Iir := Get_Return_Type (Func); + Res_Info : constant Type_Info_Acc := Get_Info (Res_Type); + begin + Res := Create_Temp (Res_Info); + if Res_Info.Type_Mode /= Type_Mode_Fat_Array then + Chap4.Allocate_Complex_Object + (Res_Type, Alloc_Stack, Res); + end if; + end; + end if; + + -- Call conversion function. + Start_Association (Constr, Subprg_Info.Ortho_Func); + + if Subprg_Info.Res_Interface /= O_Dnode_Null then + -- Composite result. + New_Association (Constr, M2E (Res)); + end if; + + Subprgs.Add_Subprg_Instance_Assoc + (Constr, Subprg_Info.Subprg_Instance); + + New_Association (Constr, R); + + if Subprg_Info.Res_Interface /= O_Dnode_Null then + -- Composite result. + New_Procedure_Call (Constr); + E := M2E (Res); + else + E := New_Function_Call (Constr); + end if; + Res := E2M + (Chap7.Translate_Implicit_Conv + (E, Get_Return_Type (Func), + Out_Type, Mode_Value, Imp), + Get_Info (Out_Type), Mode_Value); + + when Iir_Kind_Type_Conversion => + declare + Conv_Type : Iir; + begin + Conv_Type := Get_Type (Imp); + E := Chap7.Translate_Type_Conversion + (R, In_Type, Conv_Type, Assoc); + E := Chap7.Translate_Implicit_Conv + (E, Conv_Type, Out_Type, Mode_Value, Imp); + Res := E2M (E, Get_Info (Out_Type), Mode_Value); + end; + + when others => + Error_Kind ("Translate_Association_Subprogram", Imp); + end case; + + -- Assign signals. + V1 := New_Selected_Acc_Value (New_Obj (Var_Data), + Conv_Info.Out_Field); + V_Out := Lo2M (V1, Out_Info, Mode_Signal); + + case Mode is + when Conv_Mode_In => + Chap7.Set_Effective_Value (V_Out, Out_Type, Res); + when Conv_Mode_Out => + Chap7.Set_Driving_Value (V_Out, Out_Type, Res); + end case; + + Close_Temp; + if Stmt_Info /= null + and then Has_Scope_Type (Stmt_Info.Block_Scope) + then + Clear_Scope (Stmt_Info.Block_Scope); + end if; + if Conv_Info.Instantiated_Entity /= Null_Iir then + if Entity_Info.Kind = Kind_Component then + Clear_Scope (Entity_Info.Comp_Scope); + else + Clear_Scope (Entity_Info.Block_Scope); + end if; + end if; + Clear_Scope (Block_Info.Block_Scope); + + Pop_Local_Factory; + Finish_Subprogram_Body; + + Pop_Identifier_Prefix (Mark3); + Pop_Identifier_Prefix (Mark2); + end Translate_Association_Subprogram; + + -- ENTITY is null for block_statement. + procedure Translate_Association_Subprograms + (Stmt : Iir; Block : Iir; Base_Block : Iir; Entity : Iir) + is + Assoc : Iir; + Info : Assoc_Info_Acc; + begin + Assoc := Get_Port_Map_Aspect_Chain (Stmt); + while Assoc /= Null_Iir loop + if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression + then + Info := null; + if Get_In_Conversion (Assoc) /= Null_Iir then + Info := Add_Info (Assoc, Kind_Assoc); + Translate_Association_Subprogram + (Stmt, Block, Assoc, Conv_Mode_In, Info.Assoc_In, + Base_Block, Entity); + end if; + if Get_Out_Conversion (Assoc) /= Null_Iir then + if Info = null then + Info := Add_Info (Assoc, Kind_Assoc); + end if; + Translate_Association_Subprogram + (Stmt, Block, Assoc, Conv_Mode_Out, Info.Assoc_Out, + Base_Block, Entity); + end if; + end if; + Assoc := Get_Chain (Assoc); + end loop; + end Translate_Association_Subprograms; + + procedure Elab_Conversion (Sig_In : Iir; + Sig_Out : Iir; + Reg_Subprg : O_Dnode; + Info : Assoc_Conv_Info; + Ndest : out Mnode) + is + Out_Type : Iir; + Out_Info : Type_Info_Acc; + Ssig : Mnode; + Constr : O_Assoc_List; + Var_Data : O_Dnode; + Data : Elab_Signal_Data; + begin + Out_Type := Get_Type (Sig_Out); + Out_Info := Get_Info (Out_Type); + + -- Allocate data for the subprogram. + Var_Data := Create_Temp (Info.Record_Ptr_Type); + New_Assign_Stmt + (New_Obj (Var_Data), + Gen_Alloc (Alloc_System, + New_Lit (New_Sizeof (Info.Record_Type, + Ghdl_Index_Type)), + Info.Record_Ptr_Type)); + + -- Set instance. + New_Assign_Stmt + (New_Selected_Acc_Value (New_Obj (Var_Data), Info.Instance_Field), + Get_Instance_Access (Info.Instance_Block)); + + -- Set instantiated unit instance (if any). + if Info.Instantiated_Entity /= Null_Iir then + declare + Inst_Addr : O_Enode; + Inst_Info : Ortho_Info_Acc; + begin + if Get_Kind (Info.Instantiated_Entity) + = Iir_Kind_Component_Declaration + then + Inst_Info := Get_Info (Info.Instantiated_Entity); + Inst_Addr := New_Address + (Get_Instance_Ref (Inst_Info.Comp_Scope), + Inst_Info.Comp_Ptr_Type); + else + Inst_Addr := Get_Instance_Access (Info.Instantiated_Entity); + end if; + New_Assign_Stmt + (New_Selected_Acc_Value (New_Obj (Var_Data), + Info.Instantiated_Field), + Inst_Addr); + end; + end if; + + -- Set input. + Ssig := Chap6.Translate_Name (Sig_In); + Ssig := Stabilize (Ssig, True); + + New_Assign_Stmt + (New_Selected_Acc_Value (New_Obj (Var_Data), Info.In_Field), + M2E (Ssig)); + + -- Create a copy of SIG_OUT. + Ndest := Lo2M (New_Selected_Acc_Value (New_Obj (Var_Data), + Info.Out_Field), + Out_Info, Mode_Signal); + Chap4.Allocate_Complex_Object (Out_Type, Alloc_System, Ndest); + -- Note: NDEST will be assigned by ELAB_SIGNAL. + Ndest := Lo2M (New_Selected_Acc_Value (New_Obj (Var_Data), + Info.Out_Field), + Out_Info, Mode_Signal); + Data := Elab_Signal_Data'(Has_Val => False, + Already_Resolved => True, + Val => Mnode_Null, + Check_Null => False, + If_Stmt => null); + Elab_Signal (Ndest, Out_Type, Data); + + Ndest := Lo2M (New_Selected_Acc_Value (New_Obj (Var_Data), + Info.Out_Field), + Out_Info, Mode_Signal); + Ndest := Stabilize (Ndest, True); + + -- Register. + Start_Association (Constr, Reg_Subprg); + New_Association + (Constr, New_Lit (New_Subprogram_Address (Info.Subprg, + Ghdl_Ptr_Type))); + New_Association + (Constr, New_Convert_Ov (New_Obj_Value (Var_Data), Ghdl_Ptr_Type)); + + New_Association + (Constr, + New_Convert_Ov (M2E (Get_Leftest_Signal (Ssig, Get_Type (Sig_In))), + Ghdl_Signal_Ptr)); + New_Association (Constr, Get_Nbr_Signals (Ssig, Get_Type (Sig_In))); + + New_Association + (Constr, + New_Convert_Ov + (M2E (Get_Leftest_Signal (Ndest, Get_Type (Sig_Out))), + Ghdl_Signal_Ptr)); + New_Association (Constr, Get_Nbr_Signals (Ndest, Get_Type (Sig_Out))); + + New_Procedure_Call (Constr); + end Elab_Conversion; + + -- In conversion: from actual to formal. + procedure Elab_In_Conversion (Assoc : Iir; Ndest : out Mnode) + is + Assoc_Info : Assoc_Info_Acc; + begin + Assoc_Info := Get_Info (Assoc); + + Elab_Conversion + (Get_Actual (Assoc), Get_Formal (Assoc), + Ghdl_Signal_In_Conversion, Assoc_Info.Assoc_In, Ndest); + end Elab_In_Conversion; + + -- Out conversion: from formal to actual. + procedure Elab_Out_Conversion (Assoc : Iir; Ndest : out Mnode) + is + Assoc_Info : Assoc_Info_Acc; + begin + Assoc_Info := Get_Info (Assoc); + + Elab_Conversion + (Get_Formal (Assoc), Get_Actual (Assoc), + Ghdl_Signal_Out_Conversion, Assoc_Info.Assoc_Out, Ndest); + end Elab_Out_Conversion; + + -- Create a record that describe thes location of an IIR node and + -- returns the address of it. + function Get_Location (N : Iir) return O_Dnode + is + Constr : O_Record_Aggr_List; + Aggr : O_Cnode; + Name : Name_Id; + Line : Natural; + Col : Natural; + C : O_Dnode; + begin + Files_Map.Location_To_Position (Get_Location (N), Name, Line, Col); + + New_Const_Decl (C, Create_Uniq_Identifier, O_Storage_Private, + Ghdl_Location_Type_Node); + Start_Const_Value (C); + Start_Record_Aggr (Constr, Ghdl_Location_Type_Node); + New_Record_Aggr_El + (Constr, New_Global_Address (Current_Filename_Node, Char_Ptr_Type)); + New_Record_Aggr_El (Constr, New_Signed_Literal (Ghdl_I32_Type, + Integer_64 (Line))); + New_Record_Aggr_El (Constr, New_Signed_Literal (Ghdl_I32_Type, + Integer_64 (Col))); + Finish_Record_Aggr (Constr, Aggr); + Finish_Const_Value (C, Aggr); + + return C; + --return New_Global_Address (C, Ghdl_Location_Ptr_Node); + end Get_Location; +end Trans.Chap4; |