diff options
author | Tristan Gingold <tgingold@free.fr> | 2018-12-12 06:46:27 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2018-12-12 06:46:27 +0100 |
commit | f17db2f3f39d1a7e8104139eead99b7f4c5b6e0d (patch) | |
tree | 5410168f50a7f4e998ca5493b8d603c8d5b13833 /src/vhdl/translate | |
parent | 0e9f6c8979a1a05e287b183b77108f2c46903c82 (diff) | |
download | ghdl-f17db2f3f39d1a7e8104139eead99b7f4c5b6e0d.tar.gz ghdl-f17db2f3f39d1a7e8104139eead99b7f4c5b6e0d.tar.bz2 ghdl-f17db2f3f39d1a7e8104139eead99b7f4c5b6e0d.zip |
Preliminary support of dynamically unbounded elements in aggregates.
For #646
Diffstat (limited to 'src/vhdl/translate')
-rw-r--r-- | src/vhdl/translate/trans-chap3.ads | 4 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap7.adb | 190 | ||||
-rw-r--r-- | src/vhdl/translate/trans.adb | 7 | ||||
-rw-r--r-- | src/vhdl/translate/trans.ads | 578 |
4 files changed, 475 insertions, 304 deletions
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,9 +1373,291 @@ 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; + 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); + + procedure Init_Node_Infos; + procedure Update_Node_Infos; + procedure Free_Node_Infos; + + procedure Set_Info (Target : Iir; Info : Ortho_Info_Acc); + + procedure Clear_Info (Target : Iir); + + function Get_Info (Target : Iir) return Ortho_Info_Acc; + pragma Inline (Get_Info); + + -- 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; + + procedure Free_Info (Target : Iir); + + procedure Free_Type_Info (Info : in out Type_Info_Acc); + + function Get_Ortho_Literal (Target : Iir) return O_Cnode; + + function Get_Ortho_Type (Target : Iir; Is_Sig : Object_Kind_Type) + return O_Tnode; + + -- 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); + + -- Type is bounded but layout and size are known only during elaboration. + function Is_Complex_Type (Tinfo : Type_Info_Acc) return Boolean; + + -- Type size is known at compile-time. + function Is_Static_Type (Tinfo : Type_Info_Acc) return Boolean; + + -- True iff TINFO is base + bounds. + function Is_Unbounded_Type (Tinfo : Type_Info_Acc) return Boolean; + pragma Inline (Is_Unbounded_Type); + + type Hexstr_Type is array (Integer range 0 .. 15) of Character; + N2hex : constant Hexstr_Type := "0123456789abcdef"; + + -- 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; + + -- 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, + + -- The Mnode contains an Lnode representing a value. + -- This Lnode can be used only once. + Mstate_Lv, + + -- The Mnode contains an Lnode representing a pointer. + -- This Lnode can be used only once. + Mstate_Lp, + + -- The Mnode contains an Dnode for a variable representing a value. + -- This Dnode may be used several times. + Mstate_Dv, + + -- The Mnode contains an Dnode for a variable representing a pointer. + -- This Dnode may be used several times. + Mstate_Dp, + + -- Null Mnode. + Mstate_Null, + + -- The Mnode is invalid (such as already used). + Mstate_Bad); + + type Mnode1 (State : Mstate := Mstate_Bad) is record + -- Additionnal informations about the objects: kind and type. + K : Object_Kind_Type; + T : Type_Info_Acc; + + -- Ortho type of the object. + Vtype : O_Tnode; + + -- Type for a pointer to the object. + Ptype : O_Tnode; + + 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); + + type Mnode is record + M1 : Mnode1; + end record; + + -- Null Mnode. + Mnode_Null : constant Mnode := Mnode'(M1 => (State => Mstate_Null, + K => Mode_Value, + Ptype => O_Tnode_Null, + Vtype => O_Tnode_Null, + T => null)); + + type Mnode_Array is array (Object_Kind_Type) of Mnode; + + -- Object kind of a Mnode + function Get_Object_Kind (M : Mnode) return Object_Kind_Type; + + -- Transform VAR to Mnode. + function Get_Var + (Var : Var_Type; Vtype : Type_Info_Acc; Mode : Object_Kind_Type) + return Mnode; + + -- 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; + + -- Return a stabilized node for M. + -- The former M is not usuable anymore. + function Stabilize (M : Mnode; Can_Copy : Boolean := False) return Mnode; + + -- Stabilize M. + procedure Stabilize (M : in out Mnode); + + -- 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; + + -- Create a temporary of type INFO and kind KIND. + function Create_Temp (Info : Type_Info_Acc; + Kind : Object_Kind_Type := Mode_Value) + return Mnode; + + function Get_Type_Info (M : Mnode) return Type_Info_Acc; + pragma Inline (Get_Type_Info); + + -- Creation of Mnodes. + + 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; + + -- 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; + + -- From a Lnode, only for values. + function Lv2M (L : O_Lnode; T : Type_Info_Acc; Kind : Object_Kind_Type) + return Mnode; + + -- 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; + + -- 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; + + -- From a variable for a value. + function Dv2M (D : O_Dnode; T : Type_Info_Acc; Kind : Object_Kind_Type) + return Mnode; + + -- 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; + + -- From a pointer to a value variable. + function Dp2M (D : O_Dnode; T : Type_Info_Acc; Kind : Object_Kind_Type) + return Mnode; + + function M2Lv (M : Mnode) return O_Lnode; + + function M2Lp (M : Mnode) return O_Lnode; + + function M2Dp (M : Mnode) return O_Dnode; + + function M2Dv (M : Mnode) return O_Dnode; + + function T2M (Atype : Iir; Kind : Object_Kind_Type) return Mnode; + + function M2E (M : Mnode) return O_Enode; + + function M2Addr (M : Mnode) return O_Enode; + + -- function Is_Null (M : Mnode) return Boolean is + -- begin + -- return M.M1.State = Mstate_Null; + -- end Is_Null; + + function Is_Stable (M : Mnode) return Boolean; + + function Varv2M (Var : Var_Type; + Var_Type : Type_Info_Acc; + Mode : Object_Kind_Type; + Vtype : O_Tnode; + Ptype : O_Tnode) + return Mnode; + + -- 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; + + function Lo2M (D : O_Dnode; Vtype : Type_Info_Acc; Mode : Object_Kind_Type) + return Mnode; + 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; @@ -1593,6 +1876,10 @@ package Trans is -- In that case, Interface_Node must be null. Interface_Field : O_Fnode_Array := (others => O_Fnode_Null); + when Kind_Expr_Eval => + -- Result of an evaluation. + Expr_Eval : Mnode; + when Kind_Disconnect => -- Variable which contains the time_expression of the -- disconnection specification @@ -1807,288 +2094,6 @@ package Trans is procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation (Name => Ortho_Info_Acc, Object => Ortho_Info_Type); - 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); - - procedure Init_Node_Infos; - procedure Update_Node_Infos; - procedure Free_Node_Infos; - - procedure Set_Info (Target : Iir; Info : Ortho_Info_Acc); - - procedure Clear_Info (Target : Iir); - - function Get_Info (Target : Iir) return Ortho_Info_Acc; - pragma Inline (Get_Info); - - -- 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; - - procedure Free_Info (Target : Iir); - - procedure Free_Type_Info (Info : in out Type_Info_Acc); - - function Get_Ortho_Literal (Target : Iir) return O_Cnode; - - function Get_Ortho_Type (Target : Iir; Is_Sig : Object_Kind_Type) - return O_Tnode; - - -- 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); - - -- Type is bounded but layout and size are known only during elaboration. - function Is_Complex_Type (Tinfo : Type_Info_Acc) return Boolean; - - -- Type size is known at compile-time. - function Is_Static_Type (Tinfo : Type_Info_Acc) return Boolean; - - -- True iff TINFO is base + bounds. - function Is_Unbounded_Type (Tinfo : Type_Info_Acc) return Boolean; - pragma Inline (Is_Unbounded_Type); - - type Hexstr_Type is array (Integer range 0 .. 15) of Character; - N2hex : constant Hexstr_Type := "0123456789abcdef"; - - -- 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; - - -- 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, - - -- The Mnode contains an Lnode representing a value. - -- This Lnode can be used only once. - Mstate_Lv, - - -- The Mnode contains an Lnode representing a pointer. - -- This Lnode can be used only once. - Mstate_Lp, - - -- The Mnode contains an Dnode for a variable representing a value. - -- This Dnode may be used several times. - Mstate_Dv, - - -- The Mnode contains an Dnode for a variable representing a pointer. - -- This Dnode may be used several times. - Mstate_Dp, - - -- Null Mnode. - Mstate_Null, - - -- The Mnode is invalid (such as already used). - Mstate_Bad); - - type Mnode1 (State : Mstate := Mstate_Bad) is record - -- Additionnal informations about the objects: kind and type. - K : Object_Kind_Type; - T : Type_Info_Acc; - - -- Ortho type of the object. - Vtype : O_Tnode; - - -- Type for a pointer to the object. - Ptype : O_Tnode; - - 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); - - type Mnode is record - M1 : Mnode1; - end record; - - -- Null Mnode. - Mnode_Null : constant Mnode := Mnode'(M1 => (State => Mstate_Null, - K => Mode_Value, - Ptype => O_Tnode_Null, - Vtype => O_Tnode_Null, - T => null)); - - type Mnode_Array is array (Object_Kind_Type) of Mnode; - - -- Object kind of a Mnode - function Get_Object_Kind (M : Mnode) return Object_Kind_Type; - - -- Transform VAR to Mnode. - function Get_Var - (Var : Var_Type; Vtype : Type_Info_Acc; Mode : Object_Kind_Type) - return Mnode; - - -- 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; - - -- Return a stabilized node for M. - -- The former M is not usuable anymore. - function Stabilize (M : Mnode; Can_Copy : Boolean := False) return Mnode; - - -- Stabilize M. - procedure Stabilize (M : in out Mnode); - - -- 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; - - -- Create a temporary of type INFO and kind KIND. - function Create_Temp (Info : Type_Info_Acc; - Kind : Object_Kind_Type := Mode_Value) - return Mnode; - - function Get_Type_Info (M : Mnode) return Type_Info_Acc; - pragma Inline (Get_Type_Info); - - -- Creation of Mnodes. - - 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; - - -- 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; - - -- From a Lnode, only for values. - function Lv2M (L : O_Lnode; T : Type_Info_Acc; Kind : Object_Kind_Type) - return Mnode; - - -- 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; - - -- 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; - - -- From a variable for a value. - function Dv2M (D : O_Dnode; T : Type_Info_Acc; Kind : Object_Kind_Type) - return Mnode; - - -- 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; - - -- From a pointer to a value variable. - function Dp2M (D : O_Dnode; T : Type_Info_Acc; Kind : Object_Kind_Type) - return Mnode; - - function M2Lv (M : Mnode) return O_Lnode; - - function M2Lp (M : Mnode) return O_Lnode; - - function M2Dp (M : Mnode) return O_Dnode; - - function M2Dv (M : Mnode) return O_Dnode; - - function T2M (Atype : Iir; Kind : Object_Kind_Type) return Mnode; - - function M2E (M : Mnode) return O_Enode; - - function M2Addr (M : Mnode) return O_Enode; - - -- function Is_Null (M : Mnode) return Boolean is - -- begin - -- return M.M1.State = Mstate_Null; - -- end Is_Null; - - function Is_Stable (M : Mnode) return Boolean; - - function Varv2M (Var : Var_Type; - Var_Type : Type_Info_Acc; - Mode : Object_Kind_Type; - Vtype : O_Tnode; - Ptype : O_Tnode) - return Mnode; - - -- 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; - - function Lo2M (D : O_Dnode; Vtype : Type_Info_Acc; Mode : Object_Kind_Type) - return Mnode; - package Helpers is -- Generate code to initialize a ghdl_index_type variable V to 0. procedure Init_Var (V : O_Dnode); @@ -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. |