From f17db2f3f39d1a7e8104139eead99b7f4c5b6e0d Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Wed, 12 Dec 2018 06:46:27 +0100 Subject: Preliminary support of dynamically unbounded elements in aggregates. For #646 --- src/vhdl/translate/trans-chap3.ads | 4 + src/vhdl/translate/trans-chap7.adb | 190 +++++- src/vhdl/translate/trans.adb | 7 + src/vhdl/translate/trans.ads | 1144 ++++++++++++++++++------------------ 4 files changed, 758 insertions(+), 587 deletions(-) (limited to 'src') diff --git a/src/vhdl/translate/trans-chap3.ads b/src/vhdl/translate/trans-chap3.ads index 1db37788b..ceb255d58 100644 --- a/src/vhdl/translate/trans-chap3.ads +++ b/src/vhdl/translate/trans-chap3.ads @@ -227,6 +227,10 @@ package Trans.Chap3 is function Array_Bounds_To_Element_Bounds (B : Mnode; Atype : Iir) return Mnode; + -- From unbounded array bounds B, get the layout of the unbounded element. + function Array_Bounds_To_Element_Layout (B : Mnode; Atype : Iir) + return Mnode; + -- Deallocate OBJ. procedure Gen_Deallocate (Obj : O_Enode); diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb index 8e0f9aea3..fa1f5a0b4 100644 --- a/src/vhdl/translate/trans-chap7.adb +++ b/src/vhdl/translate/trans-chap7.adb @@ -3051,6 +3051,7 @@ package body Trans.Chap7 is -- Then, assign named or others association. if Is_Chain_Length_One (El) then + pragma Assert (Get_Info (El) = null); -- There is only one choice case Get_Kind (El) is when Iir_Kind_Choice_By_Others => @@ -3128,6 +3129,9 @@ package body Trans.Chap7 is -- convert aggr into a case statement. Start_Case_Stmt (Case_Blk, New_Obj_Value (Var_Pos)); while El /= Null_Iir loop + -- No Expr_Eval. + pragma Assert (Get_Info (El) = null); + Start_Choice (Case_Blk); Chap8.Translate_Case_Choice (El, Range_Type, Case_Blk); Finish_Choice (Case_Blk); @@ -3205,16 +3209,26 @@ package body Trans.Chap7 is -- The expression associated. El_Expr : Iir; + Assoc : Iir; -- Set an elements. - procedure Set_El (El : Iir_Element_Declaration) is + procedure Set_El (El : Iir_Element_Declaration) + is + Info : constant Ortho_Info_Acc := Get_Info (Assoc); + Dest : Mnode; begin - Translate_Assign (Chap6.Translate_Selected_Element (Targ, El), - El_Expr, Get_Type (El)); + Dest := Chap6.Translate_Selected_Element (Targ, El); + if Info /= null then + -- The expression was already evaluated to compute the bounds. + -- Just copy it. + Chap3.Translate_Object_Copy (Dest, Info.Expr_Eval, Get_Type (El)); + Clear_Info (Assoc); + else + Translate_Assign (Dest, El_Expr, Get_Type (El)); + end if; Set_Array (Natural (Get_Element_Position (El))) := True; end Set_El; - Assoc : Iir; N_El_Expr : Iir; begin Open_Temp; @@ -3453,7 +3467,9 @@ package body Trans.Chap7 is end case; end Translate_Aggregate; - procedure Translate_Aggregate_Bounds (Bounds : Mnode; Aggr : Iir) + procedure Translate_Aggregate_Sub_Bounds (Bounds : Mnode; Aggr : Iir); + + procedure Translate_Array_Aggregate_Bounds (Bounds : Mnode; Aggr : Iir) is Aggr_Type : constant Iir := Get_Type (Aggr); Assoc : Iir; @@ -3479,6 +3495,8 @@ package body Trans.Chap7 is Static_Len := Static_Len + Eval_Discrete_Type_Length (Range_Type); end if; + else + raise Internal_Error; end if; end if; Assoc := Get_Chain (Assoc); @@ -3509,6 +3527,8 @@ package body Trans.Chap7 is New_Obj_Value (Var_Len), M2E (L))); end; end if; + else + raise Internal_Error; end if; end if; Assoc := Get_Chain (Assoc); @@ -3517,6 +3537,125 @@ package body Trans.Chap7 is Chap3.Create_Range_From_Length (Get_Index_Type (Aggr_Type, 0), Var_Len, Chap3.Bounds_To_Range (Bounds, Aggr_Type, 1), Aggr); + end Translate_Array_Aggregate_Bounds; + + procedure Translate_Record_Aggregate_Bounds (Bounds : Mnode; Aggr : Iir) + is + Stable_Bounds : Mnode; + Aggr_Type : constant Iir := Get_Type (Aggr); + Base_El_List : constant Iir_Flist := + Get_Elements_Declaration_List (Get_Base_Type (Aggr_Type)); + + Pos : Natural; + Base_El : Iir; + Base_El_Type : Iir; + + Others_Assoc : Iir; + Assoc : Iir; + + Expr : Iir; + Expr_Type : Iir; + Val : Mnode; + Info : Ortho_Info_Acc; + begin + Stable_Bounds := Stabilize (Bounds); + + Others_Assoc := Null_Iir; + Pos := 0; + Assoc := Get_Association_Choices_Chain (Aggr); + while Assoc /= Null_Iir loop + case Iir_Kinds_Record_Choice (Get_Kind (Assoc)) is + when Iir_Kind_Choice_By_Others => + Others_Assoc := Assoc; + pragma Assert (Get_Chain (Assoc) = Null_Iir); + exit; + when Iir_Kind_Choice_By_None => + null; + when Iir_Kind_Choice_By_Name => + pragma Assert + (Get_Element_Position + (Get_Named_Entity + (Get_Choice_Name (Assoc))) = Iir_Index32 (Pos)); + null; + end case; + Base_El := Get_Nth_Element (Base_El_List, Pos); + Base_El_Type := Get_Type (Base_El); + if Is_Unbounded_Type (Get_Info (Base_El_Type)) then + -- There are corresponding bounds. + Expr := Get_Associated_Expr (Assoc); + Expr_Type := Get_Type (Expr); + if Get_Constraint_State (Expr_Type) = Fully_Constrained then + -- Translate subtype, and copy bounds. + raise Internal_Error; + else + if Get_Kind (Expr) = Iir_Kind_Aggregate then + -- Just translate bounds. + Translate_Aggregate_Sub_Bounds + (Chap3.Record_Bounds_To_Element_Bounds + (Stable_Bounds, Base_El), + Expr); + else + -- Eval expr + Val := Translate_Expression (Expr); + Val := Stabilize (Val); + Info := Add_Info (Assoc, Kind_Expr_Eval); + Info.Expr_Eval := Val; + + -- Copy bounds. + Chap3.Copy_Bounds + (Chap3.Record_Bounds_To_Element_Bounds + (Stable_Bounds, Base_El), + Chap3.Get_Composite_Bounds (Val), Expr_Type); + end if; + end if; + end if; + + Pos := Pos + 1; + Assoc := Get_Chain (Assoc); + end loop; + pragma Assert (Others_Assoc = Null_Iir); -- TODO + end Translate_Record_Aggregate_Bounds; + + -- Just create the bounds from AGGR. + procedure Translate_Aggregate_Sub_Bounds (Bounds : Mnode; Aggr : Iir) + is + Aggr_Type : constant Iir := Get_Type (Aggr); + begin + case Iir_Kinds_Composite_Type_Definition (Get_Kind (Aggr_Type)) is + when Iir_Kind_Array_Type_Definition + | Iir_Kind_Array_Subtype_Definition => + Translate_Array_Aggregate_Bounds (Bounds, Aggr); + when Iir_Kind_Record_Type_Definition + | Iir_Kind_Record_Subtype_Definition => + Translate_Record_Aggregate_Bounds (Bounds, Aggr); + end case; + end Translate_Aggregate_Sub_Bounds; + + -- Create the bounds and build the type (set size). + procedure Translate_Aggregate_Bounds (Bounds : Mnode; Aggr : Iir) + is + Aggr_Type : constant Iir := Get_Type (Aggr); + begin + case Iir_Kinds_Composite_Type_Definition (Get_Kind (Aggr_Type)) is + when Iir_Kind_Array_Type_Definition + | Iir_Kind_Array_Subtype_Definition => + Translate_Array_Aggregate_Bounds (Bounds, Aggr); + declare + El_Type : constant Iir := Get_Element_Subtype (Aggr_Type); + begin + -- The array aggregate may be unbounded simply because the + -- indexes are not known but its element is bounded. + if Is_Unbounded_Type (Get_Info (El_Type)) then + Chap3.Gen_Call_Type_Builder + (Chap3.Array_Bounds_To_Element_Layout (Bounds, Aggr_Type), + El_Type, Mode_Value); + end if; + end; + when Iir_Kind_Record_Type_Definition + | Iir_Kind_Record_Subtype_Definition => + Translate_Record_Aggregate_Bounds (Bounds, Aggr); + Chap3.Gen_Call_Type_Builder (Bounds, Aggr_Type, Mode_Value); + end case; end Translate_Aggregate_Bounds; function Translate_Allocator_By_Expression (Expr : Iir) return O_Enode @@ -4049,6 +4188,7 @@ package body Trans.Chap7 is declare Aggr_Type : Iir; Tinfo : Type_Info_Acc; + Bounds : Mnode; Mres : Mnode; begin -- Extract the type of the aggregate. Use the type of the @@ -4058,25 +4198,37 @@ package body Trans.Chap7 is and then Is_Fully_Constrained_Type (Rtype) then Aggr_Type := Rtype; - else - pragma Assert (Is_Fully_Constrained_Type (Expr_Type)); - null; end if; - Chap3.Create_Composite_Subtype (Aggr_Type); - - -- FIXME: this may be not necessary - Tinfo := Get_Info (Aggr_Type); + if Get_Constraint_State (Aggr_Type) /= Fully_Constrained + then + Tinfo := Get_Info (Aggr_Type); - -- The result area has to be created - if Is_Complex_Type (Tinfo) then Mres := Create_Temp (Tinfo); - Chap4.Allocate_Complex_Object - (Aggr_Type, Alloc_Stack, Mres); + Bounds := Create_Temp_Bounds (Tinfo); + New_Assign_Stmt + (M2Lp (Chap3.Get_Composite_Bounds (Mres)), + M2Addr (Bounds)); + -- Build bounds from aggregate. + Chap7.Translate_Aggregate_Bounds (Bounds, Expr); + Chap3.Allocate_Unbounded_Composite_Base + (Alloc_Stack, Mres, Aggr_Type); else - -- if thin array/record: - -- create result - Mres := Create_Temp (Tinfo); + Chap3.Create_Composite_Subtype (Aggr_Type); + + -- FIXME: this may be not necessary + Tinfo := Get_Info (Aggr_Type); + + -- The result area has to be created + if Is_Complex_Type (Tinfo) then + Mres := Create_Temp (Tinfo); + Chap4.Allocate_Complex_Object + (Aggr_Type, Alloc_Stack, Mres); + else + -- if thin array/record: + -- create result + Mres := Create_Temp (Tinfo); + end if; end if; Translate_Aggregate (Mres, Aggr_Type, Expr); diff --git a/src/vhdl/translate/trans.adb b/src/vhdl/translate/trans.adb index fae8dd137..b9455965d 100644 --- a/src/vhdl/translate/trans.adb +++ b/src/vhdl/translate/trans.adb @@ -2144,6 +2144,13 @@ package body Trans is return Create_Temp_Init (Atype, New_Address (Name, Atype)); end Create_Temp_Ptr; + function Create_Temp_Bounds (Tinfo : Type_Info_Acc) return Mnode is + begin + return Dv2M (Create_Temp (Tinfo.B.Bounds_Type), + Tinfo, Mode_Value, + Tinfo.B.Bounds_Type, Tinfo.B.Bounds_Ptr_Type); + end Create_Temp_Bounds; + -- Return a ghdl_index_type literal for NUM. function New_Index_Lit (Num : Unsigned_64) return O_Cnode is begin diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads index f9ec5f494..a7968e20e 100644 --- a/src/vhdl/translate/trans.ads +++ b/src/vhdl/translate/trans.ads @@ -741,7 +741,8 @@ package Trans is Kind_Config, Kind_Assoc, Kind_Design_File, - Kind_Library + Kind_Library, + Kind_Expr_Eval ); type Ortho_Info_Type_Kind is @@ -1372,722 +1373,726 @@ package Trans is type Direct_Driver_Arr is array (Natural range <>) of Direct_Driver_Type; type Direct_Drivers_Acc is access Direct_Driver_Arr; - type Ortho_Info_Type; + type Ortho_Info_Type (Kind : Ortho_Info_Kind); type Ortho_Info_Acc is access Ortho_Info_Type; - type Ortho_Info_Type (Kind : Ortho_Info_Kind) is record - -- For a simple memory management: use mark and sweep to free all infos. - Mark : Boolean := False; + subtype Type_Info_Acc is Ortho_Info_Acc (Kind_Type); + subtype Incomplete_Type_Info_Acc is Ortho_Info_Acc (Kind_Incomplete_Type); + subtype Index_Info_Acc is Ortho_Info_Acc (Kind_Index); + subtype Subprg_Info_Acc is Ortho_Info_Acc (Kind_Subprg); + subtype Operator_Info_Acc is Ortho_Info_Acc (Kind_Operator); + subtype Interface_Info_Acc is Ortho_Info_Acc (Kind_Interface); + subtype Call_Info_Acc is Ortho_Info_Acc (Kind_Call); + subtype Call_Assoc_Info_Acc is Ortho_Info_Acc (Kind_Call_Assoc); + subtype Object_Info_Acc is Ortho_Info_Acc (Kind_Object); + subtype Signal_Info_Acc is Ortho_Info_Acc (Kind_Signal); + subtype Alias_Info_Acc is Ortho_Info_Acc (Kind_Alias); + subtype Proc_Info_Acc is Ortho_Info_Acc (Kind_Process); + subtype Psl_Info_Acc is Ortho_Info_Acc (Kind_Psl_Directive); + subtype Loop_Info_Acc is Ortho_Info_Acc (Kind_Loop); + subtype Loop_State_Info_Acc is Ortho_Info_Acc (Kind_Loop_State); + subtype Block_Info_Acc is Ortho_Info_Acc (Kind_Block); + subtype Generate_Info_Acc is Ortho_Info_Acc (Kind_Generate); + subtype Comp_Info_Acc is Ortho_Info_Acc (Kind_Component); + subtype Field_Info_Acc is Ortho_Info_Acc (Kind_Field); + subtype Config_Info_Acc is Ortho_Info_Acc (Kind_Config); + subtype Assoc_Info_Acc is Ortho_Info_Acc (Kind_Assoc); + subtype Inter_Info_Acc is Ortho_Info_Acc (Kind_Interface); + subtype Design_File_Info_Acc is Ortho_Info_Acc (Kind_Design_File); + subtype Library_Info_Acc is Ortho_Info_Acc (Kind_Library); - case Kind is - when Kind_Type => - -- Mode of the type. - Type_Mode : Type_Mode_Type := Type_Mode_Unknown; + procedure Init_Node_Infos; + procedure Update_Node_Infos; + procedure Free_Node_Infos; - -- If true, the type is (still) incomplete. - Type_Incomplete : Boolean := False; + procedure Set_Info (Target : Iir; Info : Ortho_Info_Acc); - -- For array only. True if the type is constrained with locally - -- static bounds. May have non locally-static bounds in some - -- of its sub-element (ie being a complex type). - Type_Locally_Constrained : Boolean := False; + procedure Clear_Info (Target : Iir); - -- Ortho node which represents the type. - -- Type -> Ortho type - -- scalar -> scalar - -- bounded record (complex or not) -> record - -- constrained non-complex array -> constrained array - -- constrained complex array -> the element - -- unboubded array or record -> fat pointer - -- access to unconstrained array -> fat pointer - -- access (others) -> access - -- file -> file_index_type - -- protected -> instance - Ortho_Type : O_Tnode_Array; + function Get_Info (Target : Iir) return Ortho_Info_Acc; + pragma Inline (Get_Info); - -- Ortho pointer to the type. This is always an access to the - -- ortho_type. - Ortho_Ptr_Type : O_Tnode_Array; + -- Create an ortho_info field of kind KIND for iir node TARGET, and + -- return it. + function Add_Info (Target : Iir; Kind : Ortho_Info_Kind) + return Ortho_Info_Acc; - -- More info according to the type. - B : Ortho_Info_Basetype_Type; - S : Ortho_Info_Subtype_Type; + procedure Free_Info (Target : Iir); - -- Run-time information. - Type_Rti : O_Dnode := O_Dnode_Null; + procedure Free_Type_Info (Info : in out Type_Info_Acc); - when Kind_Incomplete_Type => - -- The declaration of the incomplete type. - Incomplete_Type : Iir; + function Get_Ortho_Literal (Target : Iir) return O_Cnode; - when Kind_Index => - -- For index_subtype_declaration, the field containing - -- the bounds of that index, in the array bounds record. - Index_Field : O_Fnode; + function Get_Ortho_Type (Target : Iir; Is_Sig : Object_Kind_Type) + return O_Tnode; - when Kind_Field => - -- For element whose type is static: field in the record. - -- For element whose type is not static: offset field in the - -- bounds. - Field_Node : O_Fnode_Array := (O_Fnode_Null, O_Fnode_Null); + -- Return true is INFO is a type info for a composite type, ie: + -- * a record + -- * an array (fat or thin) + -- * a fat pointer. + function Is_Composite (Info : Type_Info_Acc) return Boolean; + pragma Inline (Is_Composite); - -- The field in the layout record for the layout of the - -- element (for unbounded element). - Field_Bound : O_Fnode := O_Fnode_Null; + -- Type is bounded but layout and size are known only during elaboration. + function Is_Complex_Type (Tinfo : Type_Info_Acc) return Boolean; - when Kind_Enum_Lit => - -- Ortho tree which represents the expression, used for - -- enumeration literals. - Lit_Node : O_Cnode; + -- Type size is known at compile-time. + function Is_Static_Type (Tinfo : Type_Info_Acc) return Boolean; - when Kind_Subprg => - -- True if the function can return a value stored in the secondary - -- stack. In this case, the caller must deallocate the area - -- allocated by the callee when the value was used. - Use_Stack2 : Boolean := False; + -- True iff TINFO is base + bounds. + function Is_Unbounded_Type (Tinfo : Type_Info_Acc) return Boolean; + pragma Inline (Is_Unbounded_Type); - -- Subprogram declaration node. - Subprg_Node : O_Dnode; + type Hexstr_Type is array (Integer range 0 .. 15) of Character; + N2hex : constant Hexstr_Type := "0123456789abcdef"; - -- For a function: - -- If the return value is not composite, then this field - -- must be O_DNODE_NULL. - -- If the return value is a composite type, then the caller must - -- give to the callee an area to put the result. This area is - -- given via an (hidden to the user) interface. Furthermore, - -- the function is translated into a procedure. - -- For a procedure: - -- Interface for parameters. - Res_Interface : O_Dnode := O_Dnode_Null; + -- In order to unify and have a common handling of Enode/Lnode/Dnode, + -- let's introduce Mnode (yes, another node). + -- + -- Mnodes can be converted to Enode/Lnode via the M2xx functions. If + -- an Mnode are referenced more than once, they must be stabilized (this + -- will create a new variable if needed as Enode and Lnode can be + -- referenced only once). + -- + -- An Mnode is a typed union, containing either an Lnode or a Enode. + -- See Mstate for a description of the union. + -- The real data is contained insisde a record, so that the discriminant + -- can be changed. + type Mnode; - -- 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; + -- State of an Mmode. + type Mstate is + ( + -- The Mnode contains an Enode, which can be either a value or a + -- pointer. + -- This Mnode can be used only once. + Mstate_E, - -- For a procedure, record containing the parameters. - Subprg_Params_Type : O_Tnode := O_Tnode_Null; - Subprg_Params_Ptr : O_Tnode := O_Tnode_Null; + -- The Mnode contains an Lnode representing a value. + -- This Lnode can be used only once. + Mstate_Lv, - -- Field in the parameter struct for the suspend state. Also the - -- suspend state is not a parameter, it is initialized by the - -- caller. - Subprg_State_Field : O_Fnode := O_Fnode_Null; + -- The Mnode contains an Lnode representing a pointer. + -- This Lnode can be used only once. + Mstate_Lp, - -- Field in the parameter struct for local variables. - Subprg_Locvars_Field : O_Fnode := O_Fnode_Null; - Subprg_Locvars_Scope : aliased Var_Scope_Type; + -- The Mnode contains an Dnode for a variable representing a value. + -- This Dnode may be used several times. + Mstate_Dv, - -- Access to the declarations within this subprogram. - Subprg_Frame_Scope : aliased Var_Scope_Type; + -- The Mnode contains an Dnode for a variable representing a pointer. + -- This Dnode may be used several times. + Mstate_Dp, - -- Instances for the subprograms. - Subprg_Instance : Subprgs.Subprg_Instance_Type := - Subprgs.Null_Subprg_Instance; + -- Null Mnode. + Mstate_Null, - Subprg_Resolv : Subprg_Resolv_Info_Acc := null; + -- The Mnode is invalid (such as already used). + Mstate_Bad); - -- Local identifier number, set by spec, continued by body. - Subprg_Local_Id : Local_Identifier_Type; + type Mnode1 (State : Mstate := Mstate_Bad) is record + -- Additionnal informations about the objects: kind and type. + K : Object_Kind_Type; + T : Type_Info_Acc; - -- If set, return should be converted into exit out of the - -- SUBPRG_EXIT loop and the value should be assigned to - -- SUBPRG_RESULT, if any. - Subprg_Exit : O_Snode := O_Snode_Null; - Subprg_Result : O_Dnode := O_Dnode_Null; + -- Ortho type of the object. + Vtype : O_Tnode; - when Kind_Operator => - -- For an implicit subprogram like type operators or file - -- subprograms. + -- Type for a pointer to the object. + Ptype : O_Tnode; - -- Use secondary stack (not referenced). - Operator_Stack2 : Boolean := False; + case State is + when Mstate_E => + E : O_Enode; + when Mstate_Lv => + Lv : O_Lnode; + when Mstate_Lp => + Lp : O_Lnode; + when Mstate_Dv => + Dv : O_Dnode; + when Mstate_Dp => + Dp : O_Dnode; + when Mstate_Bad + | Mstate_Null => + null; + end case; + end record; + --pragma Pack (Mnode1); - -- True if the body was generated. Many operators share the same - -- subprogram. - Operator_Body : Boolean := False; + type Mnode is record + M1 : Mnode1; + end record; - -- Subprogram declaration node. - Operator_Node : O_Dnode; + -- Null Mnode. + Mnode_Null : constant Mnode := Mnode'(M1 => (State => Mstate_Null, + K => Mode_Value, + Ptype => O_Tnode_Null, + Vtype => O_Tnode_Null, + T => null)); - -- Instances for the subprograms. - Operator_Instance : Subprgs.Subprg_Instance_Type := - Subprgs.Null_Subprg_Instance; + type Mnode_Array is array (Object_Kind_Type) of Mnode; - -- Parameters - Operator_Left, Operator_Right : O_Dnode; - Operator_Res : O_Dnode; + -- Object kind of a Mnode + function Get_Object_Kind (M : Mnode) return Object_Kind_Type; - when Kind_Call => - Call_State_Scope : aliased Var_Scope_Type; - Call_State_Mark : Var_Type := Null_Var; - Call_Params_Var : Var_Type := Null_Var; + -- Transform VAR to Mnode. + function Get_Var + (Var : Var_Type; Vtype : Type_Info_Acc; Mode : Object_Kind_Type) + return Mnode; - when Kind_Call_Assoc => - -- Variable containing a reference to the actual, for scalar - -- copyout. The value is passed in the parameter. - Call_Assoc_Ref : Var_Type := Null_Var; + -- Likewise, but VAR is a pointer to the value. + function Get_Varp + (Var : Var_Type; Vtype : Type_Info_Acc; Mode : Object_Kind_Type) + return Mnode; - -- Variable containing the value, the bounds and the fat vector. - Call_Assoc_Value : Var_Type_Array := (others => Null_Var); - Call_Assoc_Bounds : Var_Type := Null_Var; - Call_Assoc_Fat : Var_Type_Array := (others => Null_Var); + -- Return a stabilized node for M. + -- The former M is not usuable anymore. + function Stabilize (M : Mnode; Can_Copy : Boolean := False) return Mnode; - when Kind_Object => - -- For constants: set when the object is defined as a constant. - Object_Static : Boolean; - -- The object itself. - Object_Var : Var_Type; - -- RTI constant for the object. - Object_Rti : O_Dnode := O_Dnode_Null; + -- Stabilize M. + procedure Stabilize (M : in out Mnode); - when Kind_Signal => - -- The current value of the signal. - -- Also the initial value of collapsed ports. - Signal_Val : Var_Type := Null_Var; - -- Pointer to the value, for ports. - Signal_Valp : Var_Type := Null_Var; - -- A pointer to the signal (contains meta data). - Signal_Sig : Var_Type; - -- Direct driver for signal (if any). - Signal_Driver : Var_Type := Null_Var; - -- RTI constant for the object. - Signal_Rti : O_Dnode := O_Dnode_Null; - -- Function to compute the value of object (used for implicit - -- guard signal declaration). - Signal_Function : O_Dnode := O_Dnode_Null; + -- If M is not stable, create a variable containing the value of M. + -- M must be scalar (or access). + function Stabilize_Value (M : Mnode) return Mnode; - when Kind_Alias => - Alias_Var : Var_Type_Array; - Alias_Kind : Object_Kind_Type; + -- Create a temporary of type INFO and kind KIND. + function Create_Temp (Info : Type_Info_Acc; + Kind : Object_Kind_Type := Mode_Value) + return Mnode; - when Kind_Iterator => - -- True if the range should be copied as it may change during - -- the loop. - Iterator_Range_Copy : Boolean; - -- Iterator variable. - Iterator_Var : Var_Type; - -- Iterator right bound (used only if the iterator is a range - -- expression). - Iterator_Right : Var_Type; - -- Iterator range pointer (used only if the iterator is not a - -- range expression). - Iterator_Range : Var_Type; + function Get_Type_Info (M : Mnode) return Type_Info_Acc; + pragma Inline (Get_Type_Info); - when Kind_Interface => - -- Call mechanism (by copy or by address) for the interface. - Interface_Mechanism : Call_Mechanism_Array; + -- Creation of Mnodes. - -- Ortho declaration for the interface. If not null, there is - -- a corresponding ortho parameter for the interface. While - -- translating nested subprograms (that are unnested), - -- Interface_Field may be set to the corresponding field in the - -- FRAME record. So: - -- Decl: not null, Field: null: parameter - -- Decl: not null, Field: not null: parameter with a copy in - -- the FRAME record. - -- Decl: null, Field: null: not possible - -- Decl: null, Field: not null: field in RESULT record - Interface_Decl : O_Dnode_Array := (others => O_Dnode_Null); - -- Field of the PARAMS record for arguments of procedure. - -- In that case, Interface_Node must be null. - Interface_Field : O_Fnode_Array := (others => O_Fnode_Null); + function E2M (E : O_Enode; T : Type_Info_Acc; Kind : Object_Kind_Type) + return Mnode; + function E2M (E : O_Enode; + T : Type_Info_Acc; + Kind : Object_Kind_Type; + Vtype : O_Tnode; + Ptype : O_Tnode) + return Mnode; - when Kind_Disconnect => - -- Variable which contains the time_expression of the - -- disconnection specification - Disconnect_Var : Var_Type; + -- From a Lnode, general form (can be used for ranges, bounds, base...) + function Lv2M (L : O_Lnode; + T : Type_Info_Acc; + Kind : Object_Kind_Type; + Vtype : O_Tnode; + Ptype : O_Tnode) + return Mnode; - when Kind_Process => - Process_Scope : aliased Var_Scope_Type; + -- From a Lnode, only for values. + function Lv2M (L : O_Lnode; T : Type_Info_Acc; Kind : Object_Kind_Type) + return Mnode; - -- Subprogram for the process. - Process_Subprg : O_Dnode; + -- From a Lnode that designates a pointer, general form. + function Lp2M (L : O_Lnode; + T : Type_Info_Acc; + Kind : Object_Kind_Type; + Vtype : O_Tnode; + Ptype : O_Tnode) + return Mnode; + + -- From a Lnode that designates a pointer to a value. + function Lp2M (L : O_Lnode; T : Type_Info_Acc; Kind : Object_Kind_Type) + return Mnode; - -- Variable (in the frame) containing the current state (a - -- number) used to resume the process. - Process_State : Var_Type := Null_Var; + -- From a variable declaration, general form. + function Dv2M (D : O_Dnode; + T : Type_Info_Acc; + Kind : Object_Kind_Type; + Vtype : O_Tnode; + Ptype : O_Tnode) + return Mnode; - -- Union containing local declarations for statements. - Process_Locvar_Scope : aliased Var_Scope_Type; + -- From a variable for a value. + function Dv2M (D : O_Dnode; T : Type_Info_Acc; Kind : Object_Kind_Type) + return Mnode; - -- List of drivers if Flag_Direct_Drivers. - Process_Drivers : Direct_Drivers_Acc := null; + -- From a pointer variable, general form. + function Dp2M (D : O_Dnode; + T : Type_Info_Acc; + Kind : Object_Kind_Type; + Vtype : O_Tnode; + Ptype : O_Tnode) + return Mnode; - -- RTI for the process. - Process_Rti_Const : O_Dnode := O_Dnode_Null; + -- From a pointer to a value variable. + function Dp2M (D : O_Dnode; T : Type_Info_Acc; Kind : Object_Kind_Type) + return Mnode; - when Kind_Psl_Directive => - Psl_Scope : aliased Var_Scope_Type; + function M2Lv (M : Mnode) return O_Lnode; - -- Procedure for the state machine. - Psl_Proc_Subprg : O_Dnode; - -- Procedure for finalization. Handles EOS. - Psl_Proc_Final_Subprg : O_Dnode; + function M2Lp (M : Mnode) return O_Lnode; - -- Type of the state vector. - Psl_Vect_Type : O_Tnode; + function M2Dp (M : Mnode) return O_Dnode; - -- State vector variable. - Psl_Vect_Var : Var_Type; + function M2Dv (M : Mnode) return O_Dnode; - -- Counter variable (nbr of failures or coverage) - Psl_Count_Var : Var_Type; + function T2M (Atype : Iir; Kind : Object_Kind_Type) return Mnode; - -- RTI for the process. - Psl_Rti_Const : O_Dnode := O_Dnode_Null; + function M2E (M : Mnode) return O_Enode; - when Kind_Loop => - -- Labels for the loop. - -- Used for exit/next from while-loop, and to exit from for-loop. - Label_Exit : O_Snode; - -- Used to next from for-loop, with an exit statment. - Label_Next : O_Snode; + function M2Addr (M : Mnode) return O_Enode; - when Kind_Loop_State => - -- Likewise but for a suspendable loop. - -- State next: evaluate condition for a while-loop, update - -- iterator for a for-loop. - Loop_State_Next : State_Type; - -- Body of a for-loop, not used for a while-loop. - Loop_State_Body: State_Type; - -- State after the loop. - Loop_State_Exit : State_Type; - -- Access to declarations of the iterator. - Loop_State_Scope : aliased Var_Scope_Type; - Loop_Locvar_Scope : aliased Var_Scope_Type; + -- function Is_Null (M : Mnode) return Boolean is + -- begin + -- return M.M1.State = Mstate_Null; + -- end Is_Null; - when Kind_Locvar_State => - Locvar_Scope : aliased Var_Scope_Type; + function Is_Stable (M : Mnode) return Boolean; - when Kind_Block => - -- Access to declarations of this block. - Block_Scope : aliased Var_Scope_Type; + function Varv2M (Var : Var_Type; + Var_Type : Type_Info_Acc; + Mode : Object_Kind_Type; + Vtype : O_Tnode; + Ptype : O_Tnode) + return Mnode; - -- Instance type (ortho record) for declarations contained in the - -- block/entity/architecture. - Block_Decls_Ptr_Type : O_Tnode; + -- Convert a Lnode for a sub object to an MNODE. + function Lo2M (L : O_Lnode; Vtype : Type_Info_Acc; Mode : Object_Kind_Type) + return Mnode; - -- For Entity: field in the instance type containing link to - -- parent. - -- For an instantiation: link in the parent block to the instance. - Block_Link_Field : O_Fnode; + function Lo2M (D : O_Dnode; Vtype : Type_Info_Acc; Mode : Object_Kind_Type) + return Mnode; - -- For an entity: must be o_fnode_null. - -- For an architecture: the entity field. - -- For a block, a component or a generate block: field in the - -- parent instance which contains the declarations for this - -- block. - Block_Parent_Field : O_Fnode; + type Ortho_Info_Type (Kind : Ortho_Info_Kind) is record + -- For a simple memory management: use mark and sweep to free all infos. + Mark : Boolean := False; - -- For a generate block: field in the block providing a chain to - -- the previous block (note: this may not be the parent, but - -- is a parent). - Block_Origin_Field : O_Fnode; - -- For an iterative block: boolean field set when the block - -- is configured. This is used to check if the block was already - -- configured since index and slice are not compelled to be - -- locally static. - Block_Configured_Field : O_Fnode; + case Kind is + when Kind_Type => + -- Mode of the type. + Type_Mode : Type_Mode_Type := Type_Mode_Unknown; - -- For iterative generate block: array of instances. - Block_Decls_Array_Type : O_Tnode; - Block_Decls_Array_Ptr_Type : O_Tnode; + -- If true, the type is (still) incomplete. + Type_Incomplete : Boolean := False; - -- For if-generate generate statement body: the identifier of the - -- body. Used to know which block_configuration applies to the - -- block. - Block_Id : Nat32; + -- For array only. True if the type is constrained with locally + -- static bounds. May have non locally-static bounds in some + -- of its sub-element (ie being a complex type). + Type_Locally_Constrained : Boolean := False; - -- Subprogram which elaborates the block (for entity or arch). - Block_Elab_Subprg : O_Dnode_Elab; + -- Ortho node which represents the type. + -- Type -> Ortho type + -- scalar -> scalar + -- bounded record (complex or not) -> record + -- constrained non-complex array -> constrained array + -- constrained complex array -> the element + -- unboubded array or record -> fat pointer + -- access to unconstrained array -> fat pointer + -- access (others) -> access + -- file -> file_index_type + -- protected -> instance + Ortho_Type : O_Tnode_Array; - -- Size of the block instance. - Block_Instance_Size : O_Dnode; + -- Ortho pointer to the type. This is always an access to the + -- ortho_type. + Ortho_Ptr_Type : O_Tnode_Array; - -- Only for an entity: procedure that elaborate the packages this - -- units depend on. That must be done before elaborating the - -- entity and before evaluating default expressions in generics. - Block_Elab_Pkg_Subprg : O_Dnode; + -- More info according to the type. + B : Ortho_Info_Basetype_Type; + S : Ortho_Info_Subtype_Type; - -- RTI constant for the block. - Block_Rti_Const : O_Dnode := O_Dnode_Null; + -- Run-time information. + Type_Rti : O_Dnode := O_Dnode_Null; - when Kind_Generate => - -- Like Block_Parent_Field: field in the instance for the - -- sub-block. Always a Ghdl_Ptr_Type, as there are many possible - -- types for the sub-block instance (if/case generate). - Generate_Parent_Field : O_Fnode; + when Kind_Incomplete_Type => + -- The declaration of the incomplete type. + Incomplete_Type : Iir; - -- Identifier number of the generate statement body. Used for - -- configuring sub-block, and for grt to index the rti. - Generate_Body_Id : O_Fnode; + when Kind_Index => + -- For index_subtype_declaration, the field containing + -- the bounds of that index, in the array bounds record. + Index_Field : O_Fnode; - -- RTI for the generate statement. - Generate_Rti_Const : O_Dnode := O_Dnode_Null; + when Kind_Field => + -- For element whose type is static: field in the record. + -- For element whose type is not static: offset field in the + -- bounds. + Field_Node : O_Fnode_Array := (O_Fnode_Null, O_Fnode_Null); - when Kind_Component => - -- How to access to component interfaces. - Comp_Scope : aliased Var_Scope_Type; + -- The field in the layout record for the layout of the + -- element (for unbounded element). + Field_Bound : O_Fnode := O_Fnode_Null; - -- Instance for the component. - Comp_Ptr_Type : O_Tnode; - -- Field containing a pointer to the instance link. - Comp_Link : O_Fnode; - -- RTI for the component. - Comp_Rti_Const : O_Dnode; + when Kind_Enum_Lit => + -- Ortho tree which represents the expression, used for + -- enumeration literals. + Lit_Node : O_Cnode; - when Kind_Config => - -- Subprogram that configure the block. - Config_Subprg : O_Dnode; - Config_Instance : O_Dnode; + when Kind_Subprg => + -- True if the function can return a value stored in the secondary + -- stack. In this case, the caller must deallocate the area + -- allocated by the callee when the value was used. + Use_Stack2 : Boolean := False; - when Kind_Package => - -- Subprogram which elaborate the package spec/body. - -- External units should call the body elaborator. - -- The spec elaborator is called only from the body elaborator. - Package_Elab_Spec_Subprg : O_Dnode; - Package_Elab_Body_Subprg : O_Dnode; + -- Subprogram declaration node. + Subprg_Node : O_Dnode; - -- Instance for the elaborators. - Package_Elab_Spec_Instance : Subprgs.Subprg_Instance_Type; - Package_Elab_Body_Instance : Subprgs.Subprg_Instance_Type; + -- For a function: + -- If the return value is not composite, then this field + -- must be O_DNODE_NULL. + -- If the return value is a composite type, then the caller must + -- give to the callee an area to put the result. This area is + -- given via an (hidden to the user) interface. Furthermore, + -- the function is translated into a procedure. + -- For a procedure: + -- Interface for parameters. + Res_Interface : O_Dnode := O_Dnode_Null; - -- Variable set to true when the package is elaborated. - Package_Elab_Var : Var_Type; + -- 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; - -- RTI constant for the package. - Package_Rti_Const : O_Dnode; + -- 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 declarations of the spec. - Package_Spec_Scope : aliased Var_Scope_Type; + -- Field in the parameter struct for the suspend state. Also the + -- suspend state is not a parameter, it is initialized by the + -- caller. + Subprg_State_Field : O_Fnode := O_Fnode_Null; - -- Instance type for uninstantiated package - Package_Spec_Ptr_Type : O_Tnode; + -- Field in the parameter struct for local variables. + Subprg_Locvars_Field : O_Fnode := O_Fnode_Null; + Subprg_Locvars_Scope : aliased Var_Scope_Type; - Package_Body_Scope : aliased Var_Scope_Type; - Package_Body_Ptr_Type : O_Tnode; + -- Access to the declarations within this subprogram. + Subprg_Frame_Scope : aliased Var_Scope_Type; - -- Field to the spec within the body. - Package_Spec_Field : O_Fnode; + -- Instances for the subprograms. + Subprg_Instance : Subprgs.Subprg_Instance_Type := + Subprgs.Null_Subprg_Instance; - -- Local id, set by package declaration, continued by package - -- body. - Package_Local_Id : Local_Identifier_Type; + Subprg_Resolv : Subprg_Resolv_Info_Acc := null; - when Kind_Package_Instance => - -- The variables containing the instance. There are two variables - -- for interface package: one for the spec, one for the body. - -- For package instantiation, only the variable for the body is - -- used. The variable for spec is added so that packages with - -- package interfaces don't need to know the body of their - -- interfaces. - Package_Instance_Spec_Var : Var_Type; - Package_Instance_Body_Var : Var_Type; + -- Local identifier number, set by spec, continued by body. + Subprg_Local_Id : Local_Identifier_Type; - -- Elaboration procedure for the instance. - Package_Instance_Elab_Subprg : O_Dnode; + -- If set, return should be converted into exit out of the + -- SUBPRG_EXIT loop and the value should be assigned to + -- SUBPRG_RESULT, if any. + Subprg_Exit : O_Snode := O_Snode_Null; + Subprg_Result : O_Dnode := O_Dnode_Null; - Package_Instance_Spec_Scope : aliased Var_Scope_Type; - Package_Instance_Body_Scope : aliased Var_Scope_Type; + when Kind_Operator => + -- For an implicit subprogram like type operators or file + -- subprograms. - when Kind_Assoc => - -- Association informations. - Assoc_In : Assoc_Conv_Info; - Assoc_Out : Assoc_Conv_Info; + -- Use secondary stack (not referenced). + Operator_Stack2 : Boolean := False; - when Kind_Design_File => - Design_Filename : O_Dnode; + -- True if the body was generated. Many operators share the same + -- subprogram. + Operator_Body : Boolean := False; - when Kind_Library => - Library_Rti_Const : O_Dnode; - end case; - end record; + -- Subprogram declaration node. + Operator_Node : O_Dnode; - procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation - (Name => Ortho_Info_Acc, Object => Ortho_Info_Type); + -- Instances for the subprograms. + Operator_Instance : Subprgs.Subprg_Instance_Type := + Subprgs.Null_Subprg_Instance; - subtype Type_Info_Acc is Ortho_Info_Acc (Kind_Type); - subtype Incomplete_Type_Info_Acc is Ortho_Info_Acc (Kind_Incomplete_Type); - subtype Index_Info_Acc is Ortho_Info_Acc (Kind_Index); - subtype Subprg_Info_Acc is Ortho_Info_Acc (Kind_Subprg); - subtype Operator_Info_Acc is Ortho_Info_Acc (Kind_Operator); - subtype Interface_Info_Acc is Ortho_Info_Acc (Kind_Interface); - subtype Call_Info_Acc is Ortho_Info_Acc (Kind_Call); - subtype Call_Assoc_Info_Acc is Ortho_Info_Acc (Kind_Call_Assoc); - subtype Object_Info_Acc is Ortho_Info_Acc (Kind_Object); - subtype Signal_Info_Acc is Ortho_Info_Acc (Kind_Signal); - subtype Alias_Info_Acc is Ortho_Info_Acc (Kind_Alias); - subtype Proc_Info_Acc is Ortho_Info_Acc (Kind_Process); - subtype Psl_Info_Acc is Ortho_Info_Acc (Kind_Psl_Directive); - subtype Loop_Info_Acc is Ortho_Info_Acc (Kind_Loop); - subtype Loop_State_Info_Acc is Ortho_Info_Acc (Kind_Loop_State); - subtype Block_Info_Acc is Ortho_Info_Acc (Kind_Block); - subtype Generate_Info_Acc is Ortho_Info_Acc (Kind_Generate); - subtype Comp_Info_Acc is Ortho_Info_Acc (Kind_Component); - subtype Field_Info_Acc is Ortho_Info_Acc (Kind_Field); - subtype Config_Info_Acc is Ortho_Info_Acc (Kind_Config); - subtype Assoc_Info_Acc is Ortho_Info_Acc (Kind_Assoc); - subtype Inter_Info_Acc is Ortho_Info_Acc (Kind_Interface); - subtype Design_File_Info_Acc is Ortho_Info_Acc (Kind_Design_File); - subtype Library_Info_Acc is Ortho_Info_Acc (Kind_Library); + -- Parameters + Operator_Left, Operator_Right : O_Dnode; + Operator_Res : O_Dnode; - procedure Init_Node_Infos; - procedure Update_Node_Infos; - procedure Free_Node_Infos; + when Kind_Call => + Call_State_Scope : aliased Var_Scope_Type; + Call_State_Mark : Var_Type := Null_Var; + Call_Params_Var : Var_Type := Null_Var; - procedure Set_Info (Target : Iir; Info : Ortho_Info_Acc); + when Kind_Call_Assoc => + -- Variable containing a reference to the actual, for scalar + -- copyout. The value is passed in the parameter. + Call_Assoc_Ref : Var_Type := Null_Var; - procedure Clear_Info (Target : Iir); + -- Variable containing the value, the bounds and the fat vector. + Call_Assoc_Value : Var_Type_Array := (others => Null_Var); + Call_Assoc_Bounds : Var_Type := Null_Var; + Call_Assoc_Fat : Var_Type_Array := (others => Null_Var); - function Get_Info (Target : Iir) return Ortho_Info_Acc; - pragma Inline (Get_Info); + when Kind_Object => + -- For constants: set when the object is defined as a constant. + Object_Static : Boolean; + -- The object itself. + Object_Var : Var_Type; + -- RTI constant for the object. + Object_Rti : O_Dnode := O_Dnode_Null; - -- Create an ortho_info field of kind KIND for iir node TARGET, and - -- return it. - function Add_Info (Target : Iir; Kind : Ortho_Info_Kind) - return Ortho_Info_Acc; + when Kind_Signal => + -- The current value of the signal. + -- Also the initial value of collapsed ports. + Signal_Val : Var_Type := Null_Var; + -- Pointer to the value, for ports. + Signal_Valp : Var_Type := Null_Var; + -- A pointer to the signal (contains meta data). + Signal_Sig : Var_Type; + -- Direct driver for signal (if any). + Signal_Driver : Var_Type := Null_Var; + -- RTI constant for the object. + Signal_Rti : O_Dnode := O_Dnode_Null; + -- Function to compute the value of object (used for implicit + -- guard signal declaration). + Signal_Function : O_Dnode := O_Dnode_Null; - procedure Free_Info (Target : Iir); + when Kind_Alias => + Alias_Var : Var_Type_Array; + Alias_Kind : Object_Kind_Type; - procedure Free_Type_Info (Info : in out Type_Info_Acc); + when Kind_Iterator => + -- True if the range should be copied as it may change during + -- the loop. + Iterator_Range_Copy : Boolean; + -- Iterator variable. + Iterator_Var : Var_Type; + -- Iterator right bound (used only if the iterator is a range + -- expression). + Iterator_Right : Var_Type; + -- Iterator range pointer (used only if the iterator is not a + -- range expression). + Iterator_Range : Var_Type; - function Get_Ortho_Literal (Target : Iir) return O_Cnode; + when Kind_Interface => + -- Call mechanism (by copy or by address) for the interface. + Interface_Mechanism : Call_Mechanism_Array; - function Get_Ortho_Type (Target : Iir; Is_Sig : Object_Kind_Type) - return O_Tnode; + -- Ortho declaration for the interface. If not null, there is + -- a corresponding ortho parameter for the interface. While + -- translating nested subprograms (that are unnested), + -- Interface_Field may be set to the corresponding field in the + -- FRAME record. So: + -- Decl: not null, Field: null: parameter + -- Decl: not null, Field: not null: parameter with a copy in + -- the FRAME record. + -- Decl: null, Field: null: not possible + -- Decl: null, Field: not null: field in RESULT record + Interface_Decl : O_Dnode_Array := (others => O_Dnode_Null); + -- Field of the PARAMS record for arguments of procedure. + -- In that case, Interface_Node must be null. + Interface_Field : O_Fnode_Array := (others => O_Fnode_Null); - -- Return true is INFO is a type info for a composite type, ie: - -- * a record - -- * an array (fat or thin) - -- * a fat pointer. - function Is_Composite (Info : Type_Info_Acc) return Boolean; - pragma Inline (Is_Composite); + when Kind_Expr_Eval => + -- Result of an evaluation. + Expr_Eval : Mnode; - -- Type is bounded but layout and size are known only during elaboration. - function Is_Complex_Type (Tinfo : Type_Info_Acc) return Boolean; + when Kind_Disconnect => + -- Variable which contains the time_expression of the + -- disconnection specification + Disconnect_Var : Var_Type; - -- Type size is known at compile-time. - function Is_Static_Type (Tinfo : Type_Info_Acc) return Boolean; + when Kind_Process => + Process_Scope : aliased Var_Scope_Type; - -- True iff TINFO is base + bounds. - function Is_Unbounded_Type (Tinfo : Type_Info_Acc) return Boolean; - pragma Inline (Is_Unbounded_Type); + -- Subprogram for the process. + Process_Subprg : O_Dnode; - type Hexstr_Type is array (Integer range 0 .. 15) of Character; - N2hex : constant Hexstr_Type := "0123456789abcdef"; + -- Variable (in the frame) containing the current state (a + -- number) used to resume the process. + Process_State : Var_Type := Null_Var; - -- In order to unify and have a common handling of Enode/Lnode/Dnode, - -- let's introduce Mnode (yes, another node). - -- - -- Mnodes can be converted to Enode/Lnode via the M2xx functions. If - -- an Mnode are referenced more than once, they must be stabilized (this - -- will create a new variable if needed as Enode and Lnode can be - -- referenced only once). - -- - -- An Mnode is a typed union, containing either an Lnode or a Enode. - -- See Mstate for a description of the union. - -- The real data is contained insisde a record, so that the discriminant - -- can be changed. - type Mnode; + -- Union containing local declarations for statements. + Process_Locvar_Scope : aliased Var_Scope_Type; - -- State of an Mmode. - type Mstate is - ( - -- The Mnode contains an Enode, which can be either a value or a - -- pointer. - -- This Mnode can be used only once. - Mstate_E, + -- List of drivers if Flag_Direct_Drivers. + Process_Drivers : Direct_Drivers_Acc := null; - -- The Mnode contains an Lnode representing a value. - -- This Lnode can be used only once. - Mstate_Lv, + -- RTI for the process. + Process_Rti_Const : O_Dnode := O_Dnode_Null; - -- The Mnode contains an Lnode representing a pointer. - -- This Lnode can be used only once. - Mstate_Lp, + when Kind_Psl_Directive => + Psl_Scope : aliased Var_Scope_Type; - -- The Mnode contains an Dnode for a variable representing a value. - -- This Dnode may be used several times. - Mstate_Dv, + -- Procedure for the state machine. + Psl_Proc_Subprg : O_Dnode; + -- Procedure for finalization. Handles EOS. + Psl_Proc_Final_Subprg : O_Dnode; - -- The Mnode contains an Dnode for a variable representing a pointer. - -- This Dnode may be used several times. - Mstate_Dp, + -- Type of the state vector. + Psl_Vect_Type : O_Tnode; - -- Null Mnode. - Mstate_Null, + -- State vector variable. + Psl_Vect_Var : Var_Type; - -- The Mnode is invalid (such as already used). - Mstate_Bad); + -- Counter variable (nbr of failures or coverage) + Psl_Count_Var : Var_Type; - type Mnode1 (State : Mstate := Mstate_Bad) is record - -- Additionnal informations about the objects: kind and type. - K : Object_Kind_Type; - T : Type_Info_Acc; + -- RTI for the process. + Psl_Rti_Const : O_Dnode := O_Dnode_Null; - -- Ortho type of the object. - Vtype : O_Tnode; + when Kind_Loop => + -- Labels for the loop. + -- Used for exit/next from while-loop, and to exit from for-loop. + Label_Exit : O_Snode; + -- Used to next from for-loop, with an exit statment. + Label_Next : O_Snode; - -- Type for a pointer to the object. - Ptype : O_Tnode; + when Kind_Loop_State => + -- Likewise but for a suspendable loop. + -- State next: evaluate condition for a while-loop, update + -- iterator for a for-loop. + Loop_State_Next : State_Type; + -- Body of a for-loop, not used for a while-loop. + Loop_State_Body: State_Type; + -- State after the loop. + Loop_State_Exit : State_Type; + -- Access to declarations of the iterator. + Loop_State_Scope : aliased Var_Scope_Type; + Loop_Locvar_Scope : aliased Var_Scope_Type; - case State is - when Mstate_E => - E : O_Enode; - when Mstate_Lv => - Lv : O_Lnode; - when Mstate_Lp => - Lp : O_Lnode; - when Mstate_Dv => - Dv : O_Dnode; - when Mstate_Dp => - Dp : O_Dnode; - when Mstate_Bad - | Mstate_Null => - null; - end case; - end record; - --pragma Pack (Mnode1); + when Kind_Locvar_State => + Locvar_Scope : aliased Var_Scope_Type; - type Mnode is record - M1 : Mnode1; - end record; + when Kind_Block => + -- Access to declarations of this block. + Block_Scope : aliased Var_Scope_Type; - -- Null Mnode. - Mnode_Null : constant Mnode := Mnode'(M1 => (State => Mstate_Null, - K => Mode_Value, - Ptype => O_Tnode_Null, - Vtype => O_Tnode_Null, - T => null)); + -- Instance type (ortho record) for declarations contained in the + -- block/entity/architecture. + Block_Decls_Ptr_Type : O_Tnode; - type Mnode_Array is array (Object_Kind_Type) of Mnode; + -- For Entity: field in the instance type containing link to + -- parent. + -- For an instantiation: link in the parent block to the instance. + Block_Link_Field : O_Fnode; - -- Object kind of a Mnode - function Get_Object_Kind (M : Mnode) return Object_Kind_Type; + -- For an entity: must be o_fnode_null. + -- For an architecture: the entity field. + -- For a block, a component or a generate block: field in the + -- parent instance which contains the declarations for this + -- block. + Block_Parent_Field : O_Fnode; - -- Transform VAR to Mnode. - function Get_Var - (Var : Var_Type; Vtype : Type_Info_Acc; Mode : Object_Kind_Type) - return Mnode; + -- For a generate block: field in the block providing a chain to + -- the previous block (note: this may not be the parent, but + -- is a parent). + Block_Origin_Field : O_Fnode; + -- For an iterative block: boolean field set when the block + -- is configured. This is used to check if the block was already + -- configured since index and slice are not compelled to be + -- locally static. + Block_Configured_Field : O_Fnode; - -- Likewise, but VAR is a pointer to the value. - function Get_Varp - (Var : Var_Type; Vtype : Type_Info_Acc; Mode : Object_Kind_Type) - return Mnode; + -- For iterative generate block: array of instances. + Block_Decls_Array_Type : O_Tnode; + Block_Decls_Array_Ptr_Type : O_Tnode; - -- Return a stabilized node for M. - -- The former M is not usuable anymore. - function Stabilize (M : Mnode; Can_Copy : Boolean := False) return Mnode; + -- For if-generate generate statement body: the identifier of the + -- body. Used to know which block_configuration applies to the + -- block. + Block_Id : Nat32; - -- Stabilize M. - procedure Stabilize (M : in out Mnode); + -- Subprogram which elaborates the block (for entity or arch). + Block_Elab_Subprg : O_Dnode_Elab; - -- If M is not stable, create a variable containing the value of M. - -- M must be scalar (or access). - function Stabilize_Value (M : Mnode) return Mnode; + -- Size of the block instance. + Block_Instance_Size : O_Dnode; - -- Create a temporary of type INFO and kind KIND. - function Create_Temp (Info : Type_Info_Acc; - Kind : Object_Kind_Type := Mode_Value) - return Mnode; + -- Only for an entity: procedure that elaborate the packages this + -- units depend on. That must be done before elaborating the + -- entity and before evaluating default expressions in generics. + Block_Elab_Pkg_Subprg : O_Dnode; - function Get_Type_Info (M : Mnode) return Type_Info_Acc; - pragma Inline (Get_Type_Info); + -- RTI constant for the block. + Block_Rti_Const : O_Dnode := O_Dnode_Null; - -- Creation of Mnodes. + when Kind_Generate => + -- Like Block_Parent_Field: field in the instance for the + -- sub-block. Always a Ghdl_Ptr_Type, as there are many possible + -- types for the sub-block instance (if/case generate). + Generate_Parent_Field : O_Fnode; - function E2M (E : O_Enode; T : Type_Info_Acc; Kind : Object_Kind_Type) - return Mnode; - function E2M (E : O_Enode; - T : Type_Info_Acc; - Kind : Object_Kind_Type; - Vtype : O_Tnode; - Ptype : O_Tnode) - return Mnode; + -- Identifier number of the generate statement body. Used for + -- configuring sub-block, and for grt to index the rti. + Generate_Body_Id : O_Fnode; - -- From a Lnode, general form (can be used for ranges, bounds, base...) - function Lv2M (L : O_Lnode; - T : Type_Info_Acc; - Kind : Object_Kind_Type; - Vtype : O_Tnode; - Ptype : O_Tnode) - return Mnode; + -- RTI for the generate statement. + Generate_Rti_Const : O_Dnode := O_Dnode_Null; - -- From a Lnode, only for values. - function Lv2M (L : O_Lnode; T : Type_Info_Acc; Kind : Object_Kind_Type) - return Mnode; + when Kind_Component => + -- How to access to component interfaces. + Comp_Scope : aliased Var_Scope_Type; - -- From a Lnode that designates a pointer, general form. - function Lp2M (L : O_Lnode; - T : Type_Info_Acc; - Kind : Object_Kind_Type; - Vtype : O_Tnode; - Ptype : O_Tnode) - return Mnode; + -- Instance for the component. + Comp_Ptr_Type : O_Tnode; + -- Field containing a pointer to the instance link. + Comp_Link : O_Fnode; + -- RTI for the component. + Comp_Rti_Const : O_Dnode; - -- From a Lnode that designates a pointer to a value. - function Lp2M (L : O_Lnode; T : Type_Info_Acc; Kind : Object_Kind_Type) - return Mnode; + when Kind_Config => + -- Subprogram that configure the block. + Config_Subprg : O_Dnode; + Config_Instance : O_Dnode; - -- From a variable declaration, general form. - function Dv2M (D : O_Dnode; - T : Type_Info_Acc; - Kind : Object_Kind_Type; - Vtype : O_Tnode; - Ptype : O_Tnode) - return Mnode; + when Kind_Package => + -- Subprogram which elaborate the package spec/body. + -- External units should call the body elaborator. + -- The spec elaborator is called only from the body elaborator. + Package_Elab_Spec_Subprg : O_Dnode; + Package_Elab_Body_Subprg : O_Dnode; - -- From a variable for a value. - function Dv2M (D : O_Dnode; T : Type_Info_Acc; Kind : Object_Kind_Type) - return Mnode; + -- Instance for the elaborators. + Package_Elab_Spec_Instance : Subprgs.Subprg_Instance_Type; + Package_Elab_Body_Instance : Subprgs.Subprg_Instance_Type; - -- From a pointer variable, general form. - function Dp2M (D : O_Dnode; - T : Type_Info_Acc; - Kind : Object_Kind_Type; - Vtype : O_Tnode; - Ptype : O_Tnode) - return Mnode; + -- Variable set to true when the package is elaborated. + Package_Elab_Var : Var_Type; - -- From a pointer to a value variable. - function Dp2M (D : O_Dnode; T : Type_Info_Acc; Kind : Object_Kind_Type) - return Mnode; + -- RTI constant for the package. + Package_Rti_Const : O_Dnode; - function M2Lv (M : Mnode) return O_Lnode; + -- Access to declarations of the spec. + Package_Spec_Scope : aliased Var_Scope_Type; - function M2Lp (M : Mnode) return O_Lnode; + -- Instance type for uninstantiated package + Package_Spec_Ptr_Type : O_Tnode; - function M2Dp (M : Mnode) return O_Dnode; + Package_Body_Scope : aliased Var_Scope_Type; + Package_Body_Ptr_Type : O_Tnode; - function M2Dv (M : Mnode) return O_Dnode; + -- Field to the spec within the body. + Package_Spec_Field : O_Fnode; - function T2M (Atype : Iir; Kind : Object_Kind_Type) return Mnode; + -- Local id, set by package declaration, continued by package + -- body. + Package_Local_Id : Local_Identifier_Type; - function M2E (M : Mnode) return O_Enode; + when Kind_Package_Instance => + -- The variables containing the instance. There are two variables + -- for interface package: one for the spec, one for the body. + -- For package instantiation, only the variable for the body is + -- used. The variable for spec is added so that packages with + -- package interfaces don't need to know the body of their + -- interfaces. + Package_Instance_Spec_Var : Var_Type; + Package_Instance_Body_Var : Var_Type; - function M2Addr (M : Mnode) return O_Enode; + -- Elaboration procedure for the instance. + Package_Instance_Elab_Subprg : O_Dnode; - -- function Is_Null (M : Mnode) return Boolean is - -- begin - -- return M.M1.State = Mstate_Null; - -- end Is_Null; + Package_Instance_Spec_Scope : aliased Var_Scope_Type; + Package_Instance_Body_Scope : aliased Var_Scope_Type; - function Is_Stable (M : Mnode) return Boolean; + when Kind_Assoc => + -- Association informations. + Assoc_In : Assoc_Conv_Info; + Assoc_Out : Assoc_Conv_Info; - function Varv2M (Var : Var_Type; - Var_Type : Type_Info_Acc; - Mode : Object_Kind_Type; - Vtype : O_Tnode; - Ptype : O_Tnode) - return Mnode; + when Kind_Design_File => + Design_Filename : O_Dnode; - -- Convert a Lnode for a sub object to an MNODE. - function Lo2M (L : O_Lnode; Vtype : Type_Info_Acc; Mode : Object_Kind_Type) - return Mnode; + when Kind_Library => + Library_Rti_Const : O_Dnode; + end case; + end record; - function Lo2M (D : O_Dnode; Vtype : Type_Info_Acc; Mode : Object_Kind_Type) - return Mnode; + procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation + (Name => Ortho_Info_Acc, Object => Ortho_Info_Type); package Helpers is -- Generate code to initialize a ghdl_index_type variable V to 0. @@ -2126,7 +2131,10 @@ package Trans is -- Create a temporary variable of ATYPE and initialize it with the -- address of NAME. function Create_Temp_Ptr (Atype : O_Tnode; Name : O_Lnode) - return O_Dnode; + return O_Dnode; + + function Create_Temp_Bounds (Tinfo : Type_Info_Acc) return Mnode; + -- Create a mark in the temporary region for the stack2. -- FIXME: maybe a flag must be added to CLOSE_TEMP where it is known -- stack2 can be released. -- cgit v1.2.3