From 5d61676973add240db798b79302add98b10b1375 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Thu, 11 Jan 2018 06:38:23 +0100 Subject: Rework array/record type mode to improve support of constrained records. --- src/vhdl/translate/trans-chap3.adb | 86 ++++++++++--------- src/vhdl/translate/trans-chap4.adb | 97 +++++++++++----------- src/vhdl/translate/trans-chap6.adb | 32 ++++--- src/vhdl/translate/trans-chap7.adb | 46 +++++----- src/vhdl/translate/trans-chap8.adb | 18 ++-- src/vhdl/translate/trans-foreach_non_composite.adb | 6 +- src/vhdl/translate/trans-helpers2.adb | 6 +- src/vhdl/translate/trans-rtis.adb | 34 ++++---- src/vhdl/translate/trans.adb | 70 ++++++++++------ src/vhdl/translate/trans.ads | 50 +++++++---- 10 files changed, 240 insertions(+), 205 deletions(-) (limited to 'src/vhdl') diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb index 28579288b..f25f47e89 100644 --- a/src/vhdl/translate/trans-chap3.adb +++ b/src/vhdl/translate/trans-chap3.adb @@ -133,7 +133,7 @@ package body Trans.Chap3 is case Info.Type_Mode is when Type_Mode_Unbounded => Ptype := Info.B.Base_Ptr_Type (Kind); - when Type_Mode_Record => + when Type_Mode_Complex_Record => Ptype := Info.Ortho_Ptr_Type (Kind); when others => raise Internal_Error; @@ -898,13 +898,13 @@ package body Trans.Chap3 is -- Note: info of indexes subtype are not created! Len := Get_Array_Subtype_Length (Def); - Info.Type_Mode := Type_Mode_Array; Info.Type_Locally_Constrained := (Len >= 0); if Is_Complex_Type (Binfo) or else not Info.Type_Locally_Constrained then -- This is a complex type as the size is not known at compile -- time. + Info.Type_Mode := Type_Mode_Complex_Array; Info.Ortho_Type := Binfo.B.Base_Ptr_Type; Info.Ortho_Ptr_Type := Binfo.B.Base_Ptr_Type; @@ -924,6 +924,7 @@ package body Trans.Chap3 is raise Internal_Error; else -- Length is known. Create a constrained array. + Info.Type_Mode := Type_Mode_Static_Array; Info.Ortho_Type (Mode_Signal) := O_Tnode_Null; Info.Ortho_Ptr_Type := Binfo.B.Base_Ptr_Type; for I in Mode_Value .. Type_To_Last_Object_Kind (Def) loop @@ -978,7 +979,7 @@ package body Trans.Chap3 is Def))); -- Find the innermost non-array element. - while El_Info.Type_Mode = Type_Mode_Array loop + while El_Info.Type_Mode = Type_Mode_Complex_Array loop El_Type := Get_Element_Subtype (El_Type); El_Info := Get_Info (El_Type); end loop; @@ -1125,9 +1126,7 @@ package body Trans.Chap3 is Translate_Type_Definition (El_Type); Pop_Identifier_Prefix (Mark); end if; - if not Need_Size and then Is_Complex_Type (Get_Info (El_Type)) then - Need_Size := True; - end if; + Need_Size := Need_Size or else Is_Complex_Type (Get_Info (El_Type)); Field_Info := Add_Info (El, Kind_Field); end loop; @@ -1155,6 +1154,7 @@ package body Trans.Chap3 is end loop; Finish_Record_Type (El_List, Info.B.Base_Type (Kind)); end loop; + if Is_Unbounded then Info.Type_Mode := Type_Mode_Unbounded_Record; Finish_Unbounded_Type_Base (Info); @@ -1166,7 +1166,11 @@ package body Trans.Chap3 is -- must be built. Set_Complex_Type (Info, True); else - Info.Type_Mode := Type_Mode_Record; + if Need_Size then + Info.Type_Mode := Type_Mode_Complex_Record; + else + Info.Type_Mode := Type_Mode_Static_Record; + end if; Info.Ortho_Type := Info.B.Base_Type; Finish_Type_Definition (Info); Info.B.Base_Ptr_Type := Info.Ortho_Ptr_Type; @@ -1246,7 +1250,11 @@ package body Trans.Chap3 is end if; -- Record is constrained. - Info.Type_Mode := Type_Mode_Record; + if Get_Type_Staticness (Def) = Locally then + Info.Type_Mode := Type_Mode_Static_Record; + else + Info.Type_Mode := Type_Mode_Complex_Record; + end if; -- Base type is complex (unbounded record) Copy_Complex_Type (Info, Base_Info); @@ -2125,9 +2133,13 @@ package body Trans.Chap3 is | Type_Mode_Unknown | Type_Mode_Protected => raise Internal_Error; - when Type_Mode_Record => + when Type_Mode_Static_Record + | Type_Mode_Static_Array => + -- No need to create a size var, the size is known. + raise Internal_Error; + when Type_Mode_Complex_Record => Create_Record_Size_Var (Def, Kind); - when Type_Mode_Array => + when Type_Mode_Complex_Array => Create_Array_Size_Var (Def, Kind); end case; end if; @@ -2705,10 +2717,10 @@ package body Trans.Chap3 is is begin case Info.Type_Mode is - when Type_Mode_Fat_Array => + when Type_Mode_Unbounded => raise Internal_Error; - when Type_Mode_Array - | Type_Mode_Record => + when Type_Mode_Bounded_Arrays + | Type_Mode_Bounded_Records => return Varv2M (Info.S.Composite_Bounds, Info, Mode_Value, Info.B.Bounds_Type, @@ -2741,8 +2753,8 @@ package body Trans.Chap3 is Info.B.Bounds_Type, Info.B.Bounds_Ptr_Type); end; - when Type_Mode_Array - | Type_Mode_Record => + when Type_Mode_Bounded_Arrays + | Type_Mode_Bounded_Records => return Get_Array_Type_Bounds (Info); when Type_Mode_Bounds_Acc => return Lp2M (M2Lv (Arr), Info, Mode_Value); @@ -2827,9 +2839,9 @@ package body Trans.Chap3 is Info, Kind, Info.B.Base_Type (Kind), Info.B.Base_Ptr_Type (Kind)); end; - when Type_Mode_Array => + when Type_Mode_Bounded_Arrays => return Arr; - when Type_Mode_Record => + when Type_Mode_Bounded_Records => return Unbox_Record (Arr); when others => raise Internal_Error; @@ -2841,12 +2853,11 @@ package body Trans.Chap3 is Info : constant Type_Info_Acc := Get_Type_Info (Arr); begin case Info.Type_Mode is - when Type_Mode_Unbounded_Array - | Type_Mode_Unbounded_Record => + when Type_Mode_Arrays => return Arr; - when Type_Mode_Array => + when Type_Mode_Unbounded_Record => return Arr; - when Type_Mode_Record => + when Type_Mode_Bounded_Records => declare Kind : constant Object_Kind_Type := Get_Object_Kind (Arr); Box_Field : constant O_Fnode := Info.S.Box_Field (Kind); @@ -3097,8 +3108,8 @@ package body Trans.Chap3 is Gen_Memcpy (M2Addr (Get_Composite_Base (D)), M2Addr (Get_Composite_Base (E2M (Src, Info, Kind))), Get_Object_Size (D, Obj_Type)); - when Type_Mode_Array - | Type_Mode_Record => + when Type_Mode_Bounded_Arrays + | Type_Mode_Bounded_Records => D := Stabilize (Dest); Gen_Memcpy (M2Addr (D), Src, Get_Object_Size (D, Obj_Type)); when Type_Mode_Unknown @@ -3112,18 +3123,18 @@ package body Trans.Chap3 is is Type_Info : constant Type_Info_Acc := Get_Info (Atype); begin - -- The length is pre-computed for a complex type (except for unbounded - -- types). - if Is_Complex_Type (Type_Info) - and then Type_Info.C (Kind).Size_Var /= Null_Var - then - return New_Value (Get_Var (Type_Info.C (Kind).Size_Var)); - end if; - case Type_Info.Type_Mode is + when Type_Mode_Complex_Array + | Type_Mode_Complex_Record => + -- The length is pre-computed for a complex bounded type. + if Type_Info.C (Kind).Size_Var /= Null_Var then + return New_Value (Get_Var (Type_Info.C (Kind).Size_Var)); + else + raise Internal_Error; + end if; when Type_Mode_Non_Composite - | Type_Mode_Array - | Type_Mode_Record => + | Type_Mode_Static_Array + | Type_Mode_Static_Record => return New_Lit (New_Sizeof (Type_Info.Ortho_Type (Kind), Ghdl_Index_Type)); when Type_Mode_Unbounded_Array => @@ -3428,14 +3439,13 @@ package body Trans.Chap3 is R_Node : Mnode; Loc : Iir) is - L_Tinfo, R_Tinfo : Type_Info_Acc; + L_Tinfo : constant Type_Info_Acc := Get_Info (L_Type); + R_Tinfo : constant Type_Info_Acc := Get_Info (R_Type); begin - L_Tinfo := Get_Info (L_Type); - R_Tinfo := Get_Info (R_Type); -- FIXME: optimize for a statically bounded array of a complex type. - if L_Tinfo.Type_Mode = Type_Mode_Array + if L_Tinfo.Type_Mode in Type_Mode_Arrays and then L_Tinfo.Type_Locally_Constrained - and then R_Tinfo.Type_Mode = Type_Mode_Array + and then R_Tinfo.Type_Mode in Type_Mode_Arrays and then R_Tinfo.Type_Locally_Constrained then -- Both left and right are thin array. diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb index 330900118..034e83389 100644 --- a/src/vhdl/translate/trans-chap4.adb +++ b/src/vhdl/translate/trans-chap4.adb @@ -42,22 +42,15 @@ package body Trans.Chap4 is 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_Unbounded_Array - | Type_Mode_Unbounded_Record => - 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; + case Tinfo.Type_Mode is + when Type_Mode_Complex_Record + | Type_Mode_Complex_Array + | Type_Mode_Protected => + -- For a complex type, use a pointer. + return Tinfo.Ortho_Ptr_Type (Kind); + when others => + return Tinfo.Ortho_Type (Kind); + end case; end Get_Object_Type; -- Return the pointer type for Tinfo. @@ -309,6 +302,7 @@ package body Trans.Chap4 is Type_Info : constant Type_Info_Acc := Get_Type_Info (Var); Kind : constant Object_Kind_Type := Get_Object_Kind (Var); Targ : Mnode; + Has_Ref : Boolean; begin -- Cannot allocate unconstrained object (since size is unknown). pragma Assert (Type_Info.Type_Mode not in Type_Mode_Unbounded); @@ -318,27 +312,33 @@ package body Trans.Chap4 is 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; + Has_Ref := False; + Targ := Var; - -- 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 not Is_Static_Type (Type_Info) then + if Type_Info.C (Kind).Builder_Need_Func + and then not Is_Stable (Var) + then + -- Need a stable reference... + Targ := Create_Temp (Type_Info, Kind); + Has_Ref := True; + 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))); + end if; 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; + + if Has_Ref then + New_Assign_Stmt (M2Lp (Var), M2Addr (Targ)); + Var := Targ; end if; end Allocate_Complex_Object; @@ -367,12 +367,13 @@ package body Trans.Chap4 is 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_Limit := Chap3.Get_Array_Length (Sobj, Obj_Type); + if Type_Info.Type_Mode = Type_Mode_Static_Array then Upper_Var := O_Dnode_Null; + else + -- Hoist the computation of the limit before the loop. + Upper_Var := Create_Temp_Init (Ghdl_Index_Type, Upper_Limit); end if; Index := Create_Temp (Ghdl_Index_Type); @@ -491,12 +492,11 @@ package body Trans.Chap4 is 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 not in Type_Mode_Unbounded - then + null; + elsif Is_Unbounded_Type (Type_Info) then + -- Allocated during initialization. + null; + elsif Is_Complex_Type (Type_Info) 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); @@ -1297,7 +1297,7 @@ package body Trans.Chap4 is Res : Delayed_Signal_Data; begin Res.Param := Data.Param; - if Get_Type_Info (Targ).Type_Mode = Type_Mode_Record then + if Get_Type_Info (Targ).Type_Mode in Type_Mode_Bounded_Records then Res.Targ_Val := Stabilize (Data.Targ_Val); Res.Pfx := Stabilize (Data.Pfx); else @@ -1530,7 +1530,8 @@ package body Trans.Chap4 is -- At elaboration: copy base from name, copy bounds from type, -- check for matching bounds. Atype := Get_Ortho_Type (Decl_Type, Mode); - when Type_Mode_Array + when Type_Mode_Bounded_Arrays + | Type_Mode_Bounded_Records | Type_Mode_Acc | Type_Mode_Bounds_Acc => -- Create an object pointer. @@ -1543,10 +1544,6 @@ package body Trans.Chap4 is 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 (Mode); when others => raise Internal_Error; end case; @@ -1594,7 +1591,7 @@ package body Trans.Chap4 is Stabilize (N); Alias_Node := Stabilize (Get_Var (A, Tinfo, Mode)); Copy_Fat_Pointer (Alias_Node, N); - when Type_Mode_Array => + when Type_Mode_Bounded_Arrays => Stabilize (N); New_Assign_Stmt (Get_Var (A), M2E (Chap3.Get_Composite_Base (N))); @@ -1610,7 +1607,7 @@ package body Trans.Chap4 is when Mode_Signal => New_Assign_Stmt (Get_Var (A), M2E (N)); end case; - when Type_Mode_Record => + when Type_Mode_Bounded_Records => Stabilize (N); New_Assign_Stmt (Get_Var (A), M2Addr (N)); when others => diff --git a/src/vhdl/translate/trans-chap6.adb b/src/vhdl/translate/trans-chap6.adb index 5022d2a64..cb31da86b 100644 --- a/src/vhdl/translate/trans-chap6.adb +++ b/src/vhdl/translate/trans-chap6.adb @@ -362,13 +362,11 @@ package body Trans.Chap6 is Ibasetype : Iir; Range_Ptr : Mnode; begin - case Prefix_Info.Type_Mode is - when Type_Mode_Fat_Array => + case Type_Mode_Arrays (Prefix_Info.Type_Mode) is + when Type_Mode_Unbounded_Array => Prefix := Stabilize (Prefix_Orig); - when Type_Mode_Array => + when Type_Mode_Bounded_Arrays => Prefix := Prefix_Orig; - when others => - raise Internal_Error; end case; Offset := Create_Temp (Ghdl_Index_Type); for Dim in 1 .. Nbr_Dim loop @@ -378,14 +376,14 @@ package body Trans.Chap6 is Open_Temp; -- Compute index for the current dimension. case Prefix_Info.Type_Mode is - when Type_Mode_Fat_Array => + when Type_Mode_Unbounded_Array => Range_Ptr := Stabilize (Chap3.Get_Array_Range (Prefix, Prefix_Type, Dim)); R := Translate_Index_To_Offset (Range_Ptr, Chap7.Translate_Expression (Index, Ibasetype), Null_Iir, Itype, Index); - when Type_Mode_Array => + when Type_Mode_Bounded_Arrays => if Prefix_Info.Type_Locally_Constrained then R := Translate_Thin_Index_Offset (Itype, Dim, Index); else @@ -505,9 +503,9 @@ package body Trans.Chap6 is Prefix_Info := Get_Info (Prefix_Type); Slice_Info := Get_Info (Slice_Type); - if Slice_Info.Type_Mode = Type_Mode_Array + if Slice_Info.Type_Mode = Type_Mode_Static_Array and then Slice_Info.Type_Locally_Constrained - and then Prefix_Info.Type_Mode = Type_Mode_Array + and then Prefix_Info.Type_Mode = Type_Mode_Static_Array and then Prefix_Info.Type_Locally_Constrained then Data.Is_Off := True; @@ -699,7 +697,7 @@ package body Trans.Chap6 is else -- Create the result (fat array) and assign the bounds field. case Slice_Info.Type_Mode is - when Type_Mode_Fat_Array => + when Type_Mode_Unbounded_Array => Res_D := Create_Temp (Slice_Info.Ortho_Type (Kind)); New_Assign_Stmt (New_Selected_Element (New_Obj (Res_D), @@ -713,7 +711,7 @@ package body Trans.Chap6 is Slice_Type, New_Obj_Value (Data.Unsigned_Diff)))); return Dv2M (Res_D, Slice_Info, Kind); - when Type_Mode_Array => + when Type_Mode_Bounded_Arrays => return Chap3.Slice_Base (Chap3.Get_Composite_Base (Prefix), Slice_Type, @@ -986,12 +984,12 @@ package body Trans.Chap6 is -- Alias_Var is not like an object variable, since it is -- always a pointer to the aliased object. case Type_Info.Type_Mode is - when Type_Mode_Fat_Array => + when Type_Mode_Unbounded_Array => -- Get_Var for Mnode is ok here as an unbounded object is always -- a pointer (and so is an alias). return Get_Var (Name_Info.Alias_Var (Mode), Type_Info, Mode); - when Type_Mode_Array - | Type_Mode_Record + when Type_Mode_Bounded_Arrays + | Type_Mode_Bounded_Records | Type_Mode_Acc | Type_Mode_Bounds_Acc => R := Get_Var (Name_Info.Alias_Var (Mode)); @@ -1048,11 +1046,11 @@ package body Trans.Chap6 is begin pragma Assert (Mode <= Name_Info.Alias_Kind); case Type_Info.Type_Mode is - when Type_Mode_Fat_Array => + when Type_Mode_Unbounded_Array => return Get_Var (Name_Info.Alias_Var (Mode), Type_Info, Mode); - when Type_Mode_Array - | Type_Mode_Record + when Type_Mode_Bounded_Arrays + | Type_Mode_Bounded_Records | Type_Mode_Acc | Type_Mode_Bounds_Acc => R := Get_Var (Name_Info.Alias_Var (Mode)); diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb index 44855162c..88bd45a9b 100644 --- a/src/vhdl/translate/trans-chap7.adb +++ b/src/vhdl/translate/trans-chap7.adb @@ -396,7 +396,7 @@ package body Trans.Chap7 is Val := Create_Global_Const (Create_Uniq_Identifier, Type_Info.Ortho_Type (Mode_Value), O_Storage_Private, Res); - elsif Type_Info.Type_Mode = Type_Mode_Array then + elsif Type_Info.Type_Mode in Type_Mode_Bounded_Arrays then -- Type of string literal isn't statically known; check the -- length. Chap6.Check_Bound_Error @@ -904,17 +904,14 @@ package body Trans.Chap7 is when Type_Mode_Unbounded_Array => -- unconstrained to unconstrained. return Expr; - when Type_Mode_Array => + when Type_Mode_Bounded_Arrays => -- constrained to unconstrained. return Convert_Constrained_To_Unconstrained (Expr, Res_Type); when others => raise Internal_Error; end case; - when Type_Mode_Array => - -- X to constrained. - if Einfo.Type_Locally_Constrained - and then Ainfo.Type_Locally_Constrained - then + when Type_Mode_Static_Array => + if Einfo.Type_Mode = Type_Mode_Static_Array then -- FIXME: optimize static vs non-static -- constrained to constrained. if not Chap3.Locally_Array_Match (Expr_Type, Res_Type) then @@ -926,9 +923,10 @@ package body Trans.Chap7 is return Expr; else -- Unbounded/bounded array to bounded array. - return Convert_To_Constrained - (Expr, Expr_Type, Res_Type, Loc); + return Convert_To_Constrained (Expr, Expr_Type, Res_Type, Loc); end if; + when Type_Mode_Complex_Array => + return Convert_To_Constrained (Expr, Expr_Type, Res_Type, Loc); when others => raise Internal_Error; end case; @@ -953,22 +951,22 @@ package body Trans.Chap7 is when Type_Mode_Unbounded_Record => -- unbounded to unbounded return Expr; - when Type_Mode_Record => + when Type_Mode_Bounded_Records => -- bounded to unconstrained. return Convert_Constrained_To_Unconstrained (Expr, Res_Type); when others => raise Internal_Error; end case; - when Type_Mode_Record => + when Type_Mode_Bounded_Records => -- X to bounded case Einfo.Type_Mode is when Type_Mode_Unbounded_Record => -- unbounded to bounded. return Convert_To_Constrained (Expr, Expr_Type, Res_Type, Loc); - when Type_Mode_Record => + when Type_Mode_Bounded_Records => -- bounded to bounded. - -- TODO: likewise ? + -- TODO: likewise ? check bounds ? return Expr; when others => raise Internal_Error; @@ -2756,11 +2754,11 @@ package body Trans.Chap7 is Chap3.Translate_Object_Copy (T, New_Obj_Value (E), Target_Type); end; - when Type_Mode_Array => + when Type_Mode_Bounded_Arrays => -- Source is of type TARGET_TYPE, so no length check is -- necessary. Chap3.Translate_Object_Copy (Target, Val, Target_Type); - when Type_Mode_Record => + when Type_Mode_Bounded_Records => Chap3.Translate_Object_Copy (Target, Val, Target_Type); when Type_Mode_Unbounded_Record => -- TODO @@ -2842,11 +2840,11 @@ package body Trans.Chap7 is Info := Get_Info (Target_Type); case Info.Type_Mode is - when Type_Mode_Fat_Array => + when Type_Mode_Unbounded_Array => Arr_Var := Stabilize (Target); Base_Ptr := Stabilize (Chap3.Get_Composite_Base (Arr_Var)); Len_Val := Chap3.Get_Array_Length (Arr_Var, Target_Type); - when Type_Mode_Array => + when Type_Mode_Bounded_Arrays => Base_Ptr := Stabilize (Chap3.Get_Composite_Base (Target)); Len_Val := Chap3.Get_Array_Type_Length (Target_Type); when others => @@ -3576,7 +3574,7 @@ package body Trans.Chap7 is begin E := Stabilize (E2M (Expr, Expr_Info, Mode_Value)); case Res_Info.Type_Mode is - when Type_Mode_Array => + when Type_Mode_Bounded_Arrays => Chap3.Check_Array_Match (Res_Type, T2M (Res_Type, Mode_Value), Expr_Type, E, @@ -3584,7 +3582,7 @@ package body Trans.Chap7 is return New_Convert_Ov (M2Addr (Chap3.Get_Composite_Base (E)), Res_Info.Ortho_Ptr_Type (Mode_Value)); - when Type_Mode_Fat_Array => + when Type_Mode_Unbounded_Array => declare Res : Mnode; begin @@ -4643,8 +4641,7 @@ package body Trans.Chap7 is return New_Compare_Op (ON_Eq, M2E (L), M2E (R), Ghdl_Bool_Type); - when Type_Mode_Array - | Type_Mode_Unbounded_Array => + when Type_Mode_Arrays => declare Base_Type : constant Iir_Array_Type_Definition := Get_Base_Type (Etype); @@ -4660,8 +4657,7 @@ package body Trans.Chap7 is return Translate_Predefined_Lib_Operator (Lc, Rc, Func); end; - when Type_Mode_Record - | Type_Mode_Unbounded_Record => + when Type_Mode_Records => declare Func : Iir; begin @@ -5522,7 +5518,7 @@ package body Trans.Chap7 is Ghdl_Index_Type))); -- call a predefined procedure New_Procedure_Call (Assocs); - when Type_Mode_Record => + when Type_Mode_Bounded_Records => declare El_List : constant Iir_Flist := Get_Elements_Declaration_List (Get_Base_Type (Val_Type)); @@ -5539,7 +5535,7 @@ package body Trans.Chap7 is end loop; Close_Temp; end; - when Type_Mode_Array => + when Type_Mode_Bounded_Arrays => declare Var_Max : O_Dnode; begin diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb index 85b3aaa58..c78e270a0 100644 --- a/src/vhdl/translate/trans-chap8.adb +++ b/src/vhdl/translate/trans-chap8.adb @@ -263,8 +263,8 @@ package body Trans.Chap8 is Chap3.Translate_Object_Copy (Area, M2Addr (Val), Ret_Type); Gen_Return; end; - when Type_Mode_Record - | Type_Mode_Array => + when Type_Mode_Bounded_Records + | Type_Mode_Bounded_Arrays => -- * if the return type is a constrained composite type, copy -- it to the result area. -- Create a temporary area so that if the expression use @@ -1857,8 +1857,8 @@ package body Trans.Chap8 is -- call a predefined procedure New_Procedure_Call (Assocs); Close_Temp; - when Type_Mode_Array - | Type_Mode_Record + when Type_Mode_Bounded_Arrays + | Type_Mode_Bounded_Records | Type_Mode_Unbounded_Array => Subprg_Info := Get_Info (Imp); Start_Association (Assocs, Subprg_Info.Operator_Node); @@ -1912,8 +1912,8 @@ package body Trans.Chap8 is -- call a predefined procedure New_Procedure_Call (Assocs); Close_Temp; - when Type_Mode_Array - | Type_Mode_Record => + when Type_Mode_Bounded_Arrays + | Type_Mode_Bounded_Records => Subprg_Info := Get_Info (Imp); Start_Association (Assocs, Subprg_Info.Operator_Node); Subprgs.Add_Subprg_Instance_Assoc @@ -3584,7 +3584,7 @@ package body Trans.Chap8 is when Type_Mode_F64 => Subprg := Ghdl_Signal_Simple_Assign_F64; Conv := Ghdl_Real_Type; - when Type_Mode_Array => + when Type_Mode_Arrays => raise Internal_Error; when others => Error_Kind ("gen_signal_assign_non_composite", Targ_Type); @@ -3682,7 +3682,7 @@ package body Trans.Chap8 is when Type_Mode_F64 => Subprg := Ghdl_Signal_Start_Assign_F64; Conv := Ghdl_Real_Type; - when Type_Mode_Array => + when Type_Mode_Arrays => raise Internal_Error; when others => Error_Kind ("gen_signal_assign_non_composite", Targ_Type); @@ -3842,7 +3842,7 @@ package body Trans.Chap8 is when Type_Mode_F64 => Subprg := Ghdl_Signal_Next_Assign_F64; Conv := Ghdl_Real_Type; - when Type_Mode_Array => + when Type_Mode_Arrays => raise Internal_Error; when others => Error_Kind ("gen_signal_next_assign_non_composite", Targ_Type); diff --git a/src/vhdl/translate/trans-foreach_non_composite.adb b/src/vhdl/translate/trans-foreach_non_composite.adb index 1c203f68f..bbb595195 100644 --- a/src/vhdl/translate/trans-foreach_non_composite.adb +++ b/src/vhdl/translate/trans-foreach_non_composite.adb @@ -31,8 +31,7 @@ begin case Type_Info.Type_Mode is when Type_Mode_Scalar => Do_Non_Composite (Targ, Targ_Type, Data); - when Type_Mode_Unbounded_Array - | Type_Mode_Array => + when Type_Mode_Arrays => declare El_Type : constant Iir := Get_Element_Subtype (Targ_Type); Var_El : Mnode; @@ -81,8 +80,7 @@ begin Finish_Data_Array (Composite_Data); Close_Temp; end; - when Type_Mode_Record - | Type_Mode_Unbounded_Record => + when Type_Mode_Records => declare List : constant Iir_Flist := Get_Elements_Declaration_List (Targ_Type); diff --git a/src/vhdl/translate/trans-helpers2.adb b/src/vhdl/translate/trans-helpers2.adb index d332711ac..bcbb1f907 100644 --- a/src/vhdl/translate/trans-helpers2.adb +++ b/src/vhdl/translate/trans-helpers2.adb @@ -237,11 +237,9 @@ package body Trans.Helpers2 is Type_Info := Get_Info (Targ_Type); Res := E2M (Val, Type_Info, Mode_Value); case Type_Info.Type_Mode is - when Type_Mode_Array - | Type_Mode_Unbounded_Array => + when Type_Mode_Arrays => Res := Chap3.Get_Composite_Base (Res); - when Type_Mode_Record - | Type_Mode_Unbounded_Record => + when Type_Mode_Records => Res := Stabilize (Res); when others => -- Not a composite type! diff --git a/src/vhdl/translate/trans-rtis.adb b/src/vhdl/translate/trans-rtis.adb index cde74a439..3258ce085 100644 --- a/src/vhdl/translate/trans-rtis.adb +++ b/src/vhdl/translate/trans-rtis.adb @@ -1436,10 +1436,11 @@ package body Trans.Rtis is Finish_Init_Value (Res, Val); end Generate_Array_Type_Indexes; - function Type_To_Mode (Atype : Iir) return Natural is + function Type_To_Mode (Atype : Iir) return Natural + is Res : Natural := 0; begin - if Is_Complex_Type (Get_Info (Atype)) then + if not Is_Static_Type (Get_Info (Atype)) then Res := Res + 1; end if; if Is_Anonymous_Type_Definition (Atype) @@ -1541,11 +1542,11 @@ package body Trans.Rtis is Start_Init_Value (Info.Type_Rti); Start_Record_Aggr (Aggr, Ghdl_Rtin_Subtype_Composite); case Info.Type_Mode is - when Type_Mode_Array => + when Type_Mode_Bounded_Arrays => Kind := Ghdl_Rtik_Subtype_Array; when Type_Mode_Unbounded_Array => Kind := Ghdl_Rtik_Subtype_Unconstrained_Array; - when Type_Mode_Record => + when Type_Mode_Bounded_Records => Kind := Ghdl_Rtik_Subtype_Record; when Type_Mode_Unbounded_Record => Kind := Ghdl_Rtik_Subtype_Unbounded_Record; @@ -1566,18 +1567,21 @@ package body Trans.Rtis is New_Record_Aggr_El (Aggr, Val); for I in Mode_Value .. Mode_Signal loop case Info.Type_Mode is - when Type_Mode_Array - | Type_Mode_Record => - Val := Get_Null_Loc; + when Type_Mode_Static_Array + | Type_Mode_Static_Record => if Info.Ortho_Type (I) /= O_Tnode_Null then - if Is_Complex_Type (Info) then - if Info.C (I).Size_Var /= Null_Var then - Val := Var_Acc_To_Loc (Info.C (I).Size_Var); - end if; - else - Val := New_Sizeof (Info.Ortho_Type (I), - Ghdl_Ptr_Type); - end if; + Val := New_Sizeof (Info.Ortho_Type (I), Ghdl_Ptr_Type); + else + Val := Get_Null_Loc; + end if; + when Type_Mode_Complex_Array + | Type_Mode_Complex_Record => + if Info.Ortho_Type (I) /= O_Tnode_Null + and then Info.C (I).Size_Var /= Null_Var + then + Val := Var_Acc_To_Loc (Info.C (I).Size_Var); + else + Val := Get_Null_Loc; end if; when Type_Mode_Unbounded_Array | Type_Mode_Unbounded_Record => diff --git a/src/vhdl/translate/trans.adb b/src/vhdl/translate/trans.adb index 06fc2c15d..e776aae22 100644 --- a/src/vhdl/translate/trans.adb +++ b/src/vhdl/translate/trans.adb @@ -1154,21 +1154,20 @@ package body Trans is else return Lv2M (L, Vtype, Mode); end if; - when Type_Mode_Array - | Type_Mode_Record + when Type_Mode_Complex_Array + | Type_Mode_Complex_Record | Type_Mode_Protected => - if Is_Complex_Type (Vtype) then - if Stable then - return Dp2M (D, Vtype, Mode); - else - return Lp2M (L, Vtype, Mode); - end if; + if Stable then + return Dp2M (D, Vtype, Mode); else - if Stable then - return Dv2M (D, Vtype, Mode); - else - return Lv2M (L, Vtype, Mode); - end if; + return Lp2M (L, Vtype, Mode); + end if; + when Type_Mode_Static_Array + | Type_Mode_Static_Record => + if Stable then + return Dv2M (D, Vtype, Mode); + else + return Lv2M (L, Vtype, Mode); end if; when Type_Mode_Unknown => raise Internal_Error; @@ -1426,6 +1425,25 @@ package body Trans is return Tinfo.C /= null; end Is_Complex_Type; + function Is_Static_Type (Tinfo : Type_Info_Acc) return Boolean is + begin + case Tinfo.Type_Mode is + when Type_Mode_Non_Composite => + return True; + when Type_Mode_Static_Record + | Type_Mode_Static_Array => + return True; + when Type_Mode_Complex_Record + | Type_Mode_Complex_Array + | Type_Mode_Unbounded_Record + | Type_Mode_Unbounded_Array + | Type_Mode_Protected => + return False; + when Type_Mode_Unknown => + return False; + end case; + end Is_Static_Type; + function Is_Unbounded_Type (Tinfo : Type_Info_Acc) return Boolean is begin return Tinfo.Type_Mode in Type_Mode_Unbounded; @@ -1807,14 +1825,13 @@ package body Trans is | Type_Mode_Unbounded_Record | Type_Mode_Bounds_Acc => return Lv2M (L, Vtype, Mode); - when Type_Mode_Array - | Type_Mode_Record + when Type_Mode_Complex_Array + | Type_Mode_Complex_Record | Type_Mode_Protected => - if Is_Complex_Type (Vtype) then - return Lp2M (L, Vtype, Mode); - else - return Lv2M (L, Vtype, Mode); - end if; + return Lp2M (L, Vtype, Mode); + when Type_Mode_Static_Array + | Type_Mode_Static_Record => + return Lv2M (L, Vtype, Mode); when Type_Mode_Unknown => raise Internal_Error; end case; @@ -1831,14 +1848,13 @@ package body Trans is | Type_Mode_Unbounded_Record | Type_Mode_Bounds_Acc => return Dv2M (D, Vtype, Mode); - when Type_Mode_Array - | Type_Mode_Record + when Type_Mode_Complex_Array + | Type_Mode_Complex_Record | Type_Mode_Protected => - if Is_Complex_Type (Vtype) then - return Dp2M (D, Vtype, Mode); - else - return Dv2M (D, Vtype, Mode); - end if; + return Dp2M (D, Vtype, Mode); + when Type_Mode_Static_Array + | Type_Mode_Static_Record => + return Dv2M (D, Vtype, Mode); when Type_Mode_Unknown => raise Internal_Error; end case; diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads index 15ce5d117..2129739e2 100644 --- a/src/vhdl/translate/trans.ads +++ b/src/vhdl/translate/trans.ads @@ -917,18 +917,27 @@ package Trans is -- Thin access. Type_Mode_Acc, - -- Access to an unbounded type. + -- Access to an unbounded type (this is a thin pointer to bounds + -- followed by values). Type_Mode_Bounds_Acc, - -- Record. - Type_Mode_Record, + -- Record whose size is known at compile-time. Can be a boxed record + -- if the base type is unbounded. + Type_Mode_Static_Record, + -- Constrained record, but size is not known at compile time. Can be + -- a boxed record if the base type is unbounded. + Type_Mode_Complex_Record, -- Record with unbounded component(s). Type_Mode_Unbounded_Record, + -- Unbounded array type (used for unconstrained arrays). Type_Mode_Unbounded_Array, - -- Constrained array type (for constrained arrays). - Type_Mode_Array, - -- Protected type + -- Constrainted array type, with size known at compile-time. + Type_Mode_Static_Array, + -- Constrained array type (for constrained arrays), but size is + -- not known at compile time. + Type_Mode_Complex_Array, + -- Protected type (always handled as a complex type). Type_Mode_Protected); -- For backward source compatibility, to be removed (TODO). @@ -942,26 +951,33 @@ package Trans is -- Composite types, with the vhdl meaning: record and arrays. subtype Type_Mode_Composite is Type_Mode_Type range - Type_Mode_Record .. Type_Mode_Protected; + Type_Mode_Static_Record .. Type_Mode_Protected; subtype Type_Mode_Non_Composite is Type_Mode_Type range Type_Mode_B1 .. Type_Mode_Bounds_Acc; -- Array types. subtype Type_Mode_Arrays is Type_Mode_Type range - Type_Mode_Unbounded_Array .. Type_Mode_Array; + Type_Mode_Unbounded_Array .. Type_Mode_Complex_Array; + + subtype Type_Mode_Bounded_Arrays is Type_Mode_Type range + Type_Mode_Static_Array .. Type_Mode_Complex_Array; -- Record types. subtype Type_Mode_Records is Type_Mode_Type range - Type_Mode_Record .. Type_Mode_Unbounded_Record; + Type_Mode_Static_Record .. Type_Mode_Unbounded_Record; + + subtype Type_Mode_Bounded_Records is Type_Mode_Type range + Type_Mode_Static_Record .. Type_Mode_Complex_Record; -- Thin types, ie types whose length is a scalar. subtype Type_Mode_Thin is Type_Mode_Type range Type_Mode_B1 .. Type_Mode_Bounds_Acc; - -- Fat types, ie types whose length is longer than a scalar. - subtype Type_Mode_Fat is Type_Mode_Type range - Type_Mode_Record .. Type_Mode_Protected; + -- Aggregate types, ie types whose length is longer than a scalar. + subtype Type_Mode_Aggregate is Type_Mode_Type range + Type_Mode_Static_Record .. Type_Mode_Protected; + subtype Type_Mode_Fat is Type_Mode_Aggregate; subtype Type_Mode_Unbounded is Type_Mode_Type range Type_Mode_Unbounded_Record .. Type_Mode_Unbounded_Array; @@ -999,13 +1015,11 @@ package Trans is -- These parameters are passed by copy, ie the argument of the subprogram -- is the value of the object. - subtype Type_Mode_Pass_By_Copy is Type_Mode_Type range - Type_Mode_B1 .. Type_Mode_Bounds_Acc; + subtype Type_Mode_Pass_By_Copy is Type_Mode_Thin; -- The parameters are passed by address, ie the argument of the -- subprogram is an address to the object. - subtype Type_Mode_Pass_By_Address is Type_Mode_Type range - Type_Mode_Record .. Type_Mode_Protected; + subtype Type_Mode_Pass_By_Address is Type_Mode_Aggregate; -- Call conventions. subtype Type_Mode_Call_By_Value is Type_Mode_Non_Composite; @@ -1666,9 +1680,13 @@ package Trans is function Is_Composite (Info : Type_Info_Acc) return Boolean; pragma Inline (Is_Composite); + -- Type needs to be built. function Is_Complex_Type (Tinfo : Type_Info_Acc) return Boolean; pragma Inline (Is_Complex_Type); + -- 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); -- cgit v1.2.3