diff options
Diffstat (limited to 'src/vhdl')
| -rw-r--r-- | src/vhdl/translate/trans-chap3.adb | 852 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap4.adb | 9 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap5.adb | 11 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap6.adb | 122 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap7.adb | 226 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap7.ads | 4 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap8.adb | 2 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-helpers2.adb | 2 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-rtis.adb | 6 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-rtis.ads | 2 | ||||
| -rw-r--r-- | src/vhdl/translate/trans.ads | 411 | ||||
| -rw-r--r-- | src/vhdl/vhdl-nodes.ads | 3 | ||||
| -rw-r--r-- | src/vhdl/vhdl-sem_expr.adb | 6 |
13 files changed, 854 insertions, 802 deletions
diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb index bc3078460..f05e328a8 100644 --- a/src/vhdl/translate/trans-chap3.adb +++ b/src/vhdl/translate/trans-chap3.adb @@ -42,19 +42,30 @@ package body Trans.Chap3 is function Get_Composite_Type_Layout (Info : Type_Info_Acc) return Mnode is - begin - case Info.Type_Mode is - when Type_Mode_Unbounded => - raise Internal_Error; - when Type_Mode_Bounded_Arrays - | Type_Mode_Bounded_Records => - return Varv2M (Info.S.Composite_Layout, - Info, Mode_Value, - Info.B.Layout_Type, - Info.B.Layout_Ptr_Type); - when others => - raise Internal_Error; - end case; + Res : O_Lnode; + begin + if Info.S.Subtype_Owner /= null then + pragma Assert (Info.S.Composite_Layout = Null_Var); + Res := M2Lv (Get_Composite_Type_Layout (Info.S.Subtype_Owner)); + if Info.S.Owner_Field = null then + -- From an array. + Res := New_Selected_Element + (Res, Info.S.Subtype_Owner.B.Layout_Bounds); + Res := New_Selected_Element + (Res, Info.S.Subtype_Owner.B.Bounds_El); + else + -- From a record + Res := New_Selected_Element + (Res, Info.S.Owner_Field.Field_Bound); + end if; + else + pragma Assert (Info.S.Composite_Layout /= Null_Var); + Res := Get_Var (Info.S.Composite_Layout); + end if; + return Lv2M (Res, + Info, Mode_Value, + Info.B.Layout_Type, + Info.B.Layout_Ptr_Type); end Get_Composite_Type_Layout; function Layout_To_Bounds (B : Mnode) return Mnode @@ -144,6 +155,39 @@ package body Trans.Chap3 is return Array_Bounds_To_Element_Layout (Layout_To_Bounds (B), Arr_Type); end Array_Layout_To_Element_Layout; + procedure Declare_Value_Type (Info : Type_Info_Acc) is + begin + New_Type_Decl (Create_Identifier, Info.Ortho_Type (Mode_Value)); + end Declare_Value_Type; + + procedure Declare_Signal_Type (Info : Type_Info_Acc) is + begin + if Info.Ortho_Type (Mode_Signal) /= O_Tnode_Null then + New_Type_Decl (Create_Identifier ("SIG"), + Info.Ortho_Type (Mode_Signal)); + end if; + end Declare_Signal_Type; + + procedure Declare_Value_Ptr_Type (Info : Type_Info_Acc) is + begin + Info.Ortho_Ptr_Type (Mode_Value) := + New_Access_Type (Info.Ortho_Type (Mode_Value)); + New_Type_Decl (Create_Identifier ("PTR"), + Info.Ortho_Ptr_Type (Mode_Value)); + end Declare_Value_Ptr_Type; + + procedure Declare_Signal_Ptr_Type (Info : Type_Info_Acc) is + begin + if Info.Ortho_Type (Mode_Signal) /= O_Tnode_Null then + Info.Ortho_Ptr_Type (Mode_Signal) := + New_Access_Type (Info.Ortho_Type (Mode_Signal)); + New_Type_Decl (Create_Identifier ("SIGPTR"), + Info.Ortho_Ptr_Type (Mode_Signal)); + else + Info.Ortho_Ptr_Type (Mode_Signal) := O_Tnode_Null; + end if; + end Declare_Signal_Ptr_Type; + -- Finish a type definition: declare the type, define and declare a -- pointer to the type. procedure Finish_Type_Definition @@ -151,35 +195,19 @@ package body Trans.Chap3 is begin -- Declare the type. if not Completion then - New_Type_Decl (Create_Identifier, Info.Ortho_Type (Mode_Value)); + Declare_Value_Type (Info); end if; -- Create an access to the type and declare it. - Info.Ortho_Ptr_Type (Mode_Value) := - New_Access_Type (Info.Ortho_Type (Mode_Value)); - New_Type_Decl (Create_Identifier ("PTR"), - Info.Ortho_Ptr_Type (Mode_Value)); + Declare_Value_Ptr_Type (Info); -- Signal type. if Info.Type_Mode in Type_Mode_Scalar then Info.Ortho_Type (Mode_Signal) := Ghdl_Signal_Ptr; - else - if Info.Ortho_Type (Mode_Signal) /= O_Tnode_Null then - New_Type_Decl (Create_Identifier ("SIG"), - Info.Ortho_Type (Mode_Signal)); - end if; - end if; - - -- Signal pointer type. - if Info.Type_Mode in Type_Mode_Composite - and then Info.Ortho_Type (Mode_Signal) /= O_Tnode_Null - then - Info.Ortho_Ptr_Type (Mode_Signal) := - New_Access_Type (Info.Ortho_Type (Mode_Signal)); - New_Type_Decl (Create_Identifier ("SIGPTR"), - Info.Ortho_Ptr_Type (Mode_Signal)); - else Info.Ortho_Ptr_Type (Mode_Signal) := O_Tnode_Null; + else + Declare_Signal_Type (Info); + Declare_Signal_Ptr_Type (Info); end if; end Finish_Type_Definition; @@ -551,6 +579,7 @@ package body Trans.Chap3 is Binfo : constant Type_Info_Acc := Get_Info (Base_Type); Indexes_List : constant Iir_Flist := Get_Index_Subtype_List (Def); Index : Iir; + El_Type : Iir; List : O_Record_Aggr_List; Res : O_Cnode; begin @@ -564,9 +593,9 @@ package body Trans.Chap3 is if Binfo.B.Bounds_El /= O_Fnode_Null then -- For arrays of unbounded type. + El_Type := Get_Element_Subtype (Def); New_Record_Aggr_El - (List, Create_Static_Composite_Subtype_Layout - (Get_Element_Subtype (Def))); + (List, Create_Static_Composite_Subtype_Layout (El_Type)); end if; Finish_Record_Aggr (List, Res); @@ -584,9 +613,9 @@ package body Trans.Chap3 is List : O_Record_Aggr_List; Res : O_Cnode; El : Iir; + El_Type : Iir; Bel : Iir; Bel_Info : Field_Info_Acc; - El_Info : Field_Info_Acc; Off : O_Cnode; begin Start_Record_Aggr (List, Binfo.B.Bounds_Type); @@ -597,21 +626,22 @@ package body Trans.Chap3 is Bel := Get_Nth_Element (El_Blist, I); Bel_Info := Get_Info (Bel); if Bel_Info.Field_Bound /= O_Fnode_Null then - El := Get_Nth_Element (El_List, I); - El_Info := Get_Info (El); for Kind in Mode_Value .. Type_To_Last_Object_Kind (Base_Type) loop if Info.Ortho_Type (Kind) /= O_Tnode_Null then - Off := New_Offsetof (Info.Ortho_Type (Kind), - El_Info.Field_Node (Kind), - Ghdl_Index_Type); + Off := New_Offsetof + (Info.Ortho_Type (Kind), + Info.S.Rec_Fields (Iir_Index32 (I)).Fields (Kind), + Ghdl_Index_Type); else Off := Ghdl_Index_0; end if; New_Record_Aggr_El (List, Off); end loop; + El := Get_Nth_Element (El_List, I); + El_Type := Get_Type (El); New_Record_Aggr_El - (List, Create_Static_Composite_Subtype_Layout (Get_Type (El))); + (List, Create_Static_Composite_Subtype_Layout (El_Type)); end if; end loop; @@ -646,21 +676,30 @@ package body Trans.Chap3 is end case; end Create_Static_Composite_Subtype_Layout; - procedure Elab_Composite_Subtype_Layout (Def : Iir; Target : Mnode) is + procedure Elab_Composite_Subtype_Layout (Def : Iir; Target : Mnode) + is + Tinfo : constant Type_Info_Acc := Get_Info (Def); begin Open_Temp; case Get_Kind (Def) is + when Iir_Kind_Array_Type_Definition + | Iir_Kind_Record_Type_Definition => + -- Fully unconstrained, no layout to fill. + null; + when Iir_Kind_Array_Subtype_Definition => declare Indexes_List : constant Iir_Flist := Get_Index_Subtype_List (Def); - Tinfo : constant Type_Info_Acc := Get_Info (Def); + El_Type : Iir; El_Tinfo : Type_Info_Acc; Targ : Mnode; Index : Iir; begin Targ := Layout_To_Bounds (Target); + + -- Indexes if Tinfo.B.Bounds_El /= O_Fnode_Null or else Get_Nbr_Elements (Indexes_List) > 1 then @@ -676,40 +715,47 @@ package body Trans.Chap3 is -- Element. if Tinfo.B.Bounds_El /= O_Fnode_Null then - -- TODO: should be directly elaborated in place. - if False then - El_Tinfo := Get_Info (Get_Element_Subtype (Def)); + El_Type := Get_Element_Subtype (Def); + El_Tinfo := Get_Info (El_Type); + if Get_Constraint_State (El_Type) = Unconstrained then + -- Fully unconstrained, so there is no layout variable + -- for it. + null; + elsif Get_Array_Element_Constraint (Def) = Null_Iir then + -- No new constraints. Gen_Memcpy (M2Addr (Array_Bounds_To_Element_Layout (Targ, Def)), M2Addr (Get_Composite_Type_Layout (El_Tinfo)), New_Lit (New_Sizeof (El_Tinfo.B.Layout_Type, Ghdl_Index_Type))); else + -- New constraints. Elab_Composite_Subtype_Layout - (Get_Element_Subtype (Def), - Array_Bounds_To_Element_Layout (Targ, Def)); + (El_Type, Array_Bounds_To_Element_Layout (Targ, Def)); end if; end if; end; - when Iir_Kind_Record_Type_Definition => - null; - when Iir_Kind_Record_Subtype_Definition => declare El_List : constant Iir_Flist := Get_Elements_Declaration_List (Def); + Base_El_List : constant Iir_Flist := + Get_Elements_Declaration_List (Get_Base_Type (Def)); Targ : Mnode; El : Iir; Base_El : Iir; + El_Type : Iir; begin Targ := Stabilize (Target); for I in Flist_First .. Flist_Last (El_List) loop El := Get_Nth_Element (El_List, I); - Base_El := Get_Base_Element_Declaration (El); + Base_El := Get_Nth_Element (Base_El_List, I); if Is_Unbounded_Type (Get_Info (Get_Type (Base_El))) then + -- FIXME: copy if not new. + El_Type := Get_Type (El); Elab_Composite_Subtype_Layout - (Get_Type (El), + (El_Type, Record_Layout_To_Element_Layout (Targ, El)); end if; end loop; @@ -726,9 +772,9 @@ package body Trans.Chap3 is is Info : constant Type_Info_Acc := Get_Info (Def); begin - if Is_Complex_Type (Info) then - Elab_Composite_Subtype_Layout (Def, Get_Composite_Type_Layout (Info)); + Elab_Composite_Subtype_Layout (Def, Get_Composite_Type_Layout (Info)); + if Is_Complex_Type (Info) then Gen_Call_Type_Builder (Get_Composite_Type_Layout (Info), Def, Mode_Value); if Get_Has_Signal_Flag (Def) then @@ -745,13 +791,15 @@ package body Trans.Chap3 is Info : constant Type_Info_Acc := Get_Info (Def); Val : O_Cnode; begin - if Info.S.Composite_Layout /= Null_Var then + if Info.S.Composite_Layout /= Null_Var + or else Info.S.Subtype_Owner /= null + then -- Already created. return; end if; - if Get_Constraint_State (Def) = Fully_Constrained - and then Are_Bounds_Locally_Static (Def) + if Info.Type_Mode = Type_Mode_Static_Array + or Info.Type_Mode = Type_Mode_Static_Record then if Global_Storage = O_Storage_External then -- Do not create the value of the type desc, since it @@ -764,7 +812,6 @@ package body Trans.Chap3 is (Create_Identifier ("STL"), Info.B.Layout_Type, Global_Storage, Val); else - pragma Assert (Get_Type_Staticness (Def) /= Locally); Info.S.Composite_Layout := Create_Var (Create_Var_Identifier ("STL"), Info.B.Layout_Type); if Elab_Now then @@ -848,40 +895,39 @@ package body Trans.Chap3 is New_Type_Decl (Create_Identifier ("LAYOUTP"), Info.B.Layout_Ptr_Type); end Create_Array_Type_Layout_Type; + -- Return the type of INFO for MODE when used as a subelement (of either + -- a record or an array). + function Get_Ortho_Type_Subelement + (Info : Type_Info_Acc; Mode : Object_Kind_Type) return O_Tnode is + begin + if Is_Unbounded_Type (Info) then + return Info.B.Base_Type (Mode); + else + return Info.Ortho_Type (Mode); + end if; + end Get_Ortho_Type_Subelement; + procedure Translate_Array_Type_Base (Def : Iir_Array_Type_Definition; Info : Type_Info_Acc) is - El_Type : constant Iir := Get_Element_Subtype (Def); - El_Tinfo : constant Type_Info_Acc := Get_Info (El_Type); + El_Type : constant Iir := Get_Element_Subtype (Def); + El_Tinfo : constant Type_Info_Acc := Get_Info (El_Type); begin Info.B.Align := El_Tinfo.B.Align; - if Is_Static_Type (El_Tinfo) then - -- Simple case: the array is really an array. - for Kind in Mode_Value .. Type_To_Last_Object_Kind (Def) loop - Info.B.Base_Type (Kind) := - New_Array_Type (El_Tinfo.Ortho_Type (Kind), Ghdl_Index_Type); - end loop; - -- Declare the types. - Finish_Unbounded_Type_Base (Info); - else - -- The element type is not static (like an array sub-type with - -- bounds that were computed). So an array cannot be created in - -- ortho. - if El_Tinfo.Type_Mode in Type_Mode_Arrays then - Info.B.Base_Type := El_Tinfo.B.Base_Ptr_Type; - Info.B.Base_Ptr_Type := El_Tinfo.B.Base_Ptr_Type; - else - Info.B.Base_Type := El_Tinfo.Ortho_Ptr_Type; - Info.B.Base_Ptr_Type := El_Tinfo.Ortho_Ptr_Type; - end if; - pragma Assert (Info.B.Align /= Align_Undef); - end if; + for Kind in Mode_Value .. Type_To_Last_Object_Kind (Def) loop + Info.B.Base_Type (Kind) := + New_Array_Type (Get_Ortho_Type_Subelement (El_Tinfo, Kind), + Ghdl_Index_Type); + end loop; + + -- Declare the types. + Finish_Unbounded_Type_Base (Info); end Translate_Array_Type_Base; procedure Translate_Array_Type (Def : Iir_Array_Type_Definition) is - Info : constant Type_Info_Acc := Get_Info (Def); + Info : constant Type_Info_Acc := Get_Info (Def); begin Info.Type_Mode := Type_Mode_Fat_Array; Info.B := Ortho_Info_Basetype_Array_Init; @@ -930,125 +976,58 @@ package body Trans.Chap3 is return Len; end Get_Array_Subtype_Length; - -- Create ortho unconstrained arrays for DEF, whose element subtype was - -- newly constrained. The element subtype must be a static type, so that - -- an array can indeed be created. - procedure Create_Array_For_Array_Subtype - (Def : Iir_Array_Subtype_Definition; - Base : out O_Tnode_Array; - Ptr : out O_Tnode_Array) - is - El_Tinfo : constant Type_Info_Acc := - Get_Info (Get_Element_Subtype (Def)); - pragma Assert (Is_Static_Type (El_Tinfo)); - Id : O_Ident; - begin - Base (Mode_Signal) := O_Tnode_Null; - Ptr (Mode_Signal) := O_Tnode_Null; - for I in Mode_Value .. Type_To_Last_Object_Kind (Def) loop - -- Element has been constrained by this subtype, so create the - -- base array (and the pointer). - case I is - when Mode_Value => - Id := Create_Identifier ("BARR"); - when Mode_Signal => - Id := Create_Identifier ("BARRSIG"); - end case; - Base (I) := New_Array_Type - (El_Tinfo.Ortho_Type (I), Ghdl_Index_Type); - New_Type_Decl (Id, Base (I)); - - case I is - when Mode_Value => - Id := Create_Identifier ("BARRPTR"); - when Mode_Signal => - Id := Create_Identifier ("BARRSIGPTR"); - end case; - Ptr (I) := New_Access_Type (Base (I)); - New_Type_Decl (Id, Ptr (I)); - end loop; - end Create_Array_For_Array_Subtype; - procedure Translate_Bounded_Array_Subtype_Definition (Def : Iir_Array_Subtype_Definition; Parent_Type : Iir) is El_Type : constant Iir := Get_Element_Subtype (Def); + El_Info : constant Type_Info_Acc := Get_Info (El_Type); + Info : constant Type_Info_Acc := Get_Info (Def); Pinfo : constant Type_Info_Acc := Get_Info (Parent_Type); - Len : Int64; + Last_Mode : constant Object_Kind_Type := Type_To_Last_Object_Kind (Def); - Id : O_Ident; - El_Constrained : Boolean; - Base : O_Tnode_Array; + Len : Int64; begin -- Note: info of indexes subtype are not created! Len := Get_Array_Subtype_Length (Def); Info.Type_Locally_Constrained := (Len >= 0); Info.B := Pinfo.B; - Info.S := Pinfo.S; - if not Info.Type_Locally_Constrained - or else not Is_Static_Type (Get_Info (El_Type)) + Info.S := Ortho_Info_Subtype_Array_Init; + + if Info.Type_Locally_Constrained + and then Is_Static_Type (El_Info) 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 := Pinfo.B.Base_Ptr_Type; - Info.Ortho_Ptr_Type := Pinfo.B.Base_Ptr_Type; - else - -- Length is known. Create a constrained array. - -- True if this definition has constrained the element. - El_Constrained := Is_Fully_Constrained_Type (El_Type) - and then not Is_Fully_Constrained_Type (Get_Element_Subtype - (Parent_Type)); + -- Element and length are static. Info.Type_Mode := Type_Mode_Static_Array; + + -- Create a subtype. Info.Ortho_Type (Mode_Signal) := O_Tnode_Null; - Info.Ortho_Ptr_Type (Mode_Signal) := O_Tnode_Null; - if El_Constrained then - -- Element has been constrained by this subtype, so create the - -- base array (and the pointer). - Create_Array_For_Array_Subtype (Def, Base, Info.Ortho_Ptr_Type); - Info.B.Base_Type := Base; - Info.B.Base_Ptr_Type := Info.Ortho_Ptr_Type; - else - Base := Pinfo.B.Base_Type; - Info.Ortho_Ptr_Type := Pinfo.B.Base_Ptr_Type; - end if; - for I in Mode_Value .. Type_To_Last_Object_Kind (Def) loop - case I is - when Mode_Value => - Id := Create_Identifier; - when Mode_Signal => - Id := Create_Identifier ("SIG"); - end case; - Info.Ortho_Type (I) := New_Array_Subtype - (Base (I), Get_Ortho_Type (El_Type, I), + for K in Mode_Value .. Last_Mode loop + Info.Ortho_Type (K) := New_Array_Subtype + (Pinfo.B.Base_Type (K), + El_Info.Ortho_Type (K), New_Index_Lit (Unsigned_64 (Len))); - New_Type_Decl (Id, Info.Ortho_Type (I)); end loop; + -- Declare the types. + Declare_Value_Type (Info); + Declare_Value_Ptr_Type (Info); + if Last_Mode = Mode_Signal then + Declare_Signal_Type (Info); + Declare_Signal_Ptr_Type (Info); + end if; + else + -- This is a complex type as the size is not known at compile + -- time. + Info.Type_Mode := Type_Mode_Complex_Array; + + -- Use the base type. + Info.Ortho_Type := Pinfo.B.Base_Type; + Info.Ortho_Ptr_Type := Pinfo.B.Base_Ptr_Type; end if; end Translate_Bounded_Array_Subtype_Definition; - procedure Translate_Array_Subtype_Definition_Constrained_Element - (Def : Iir_Array_Subtype_Definition; Parent_Type : Iir) - is - Info : constant Type_Info_Acc := Get_Info (Def); - Pinfo : constant Type_Info_Acc := Get_Info (Parent_Type); - begin - -- Note: info of indexes subtype are not created! - Info.Type_Locally_Constrained := False; - Info.Ortho_Type := Pinfo.Ortho_Type; - Info.Ortho_Ptr_Type := Pinfo.Ortho_Ptr_Type; - Info.B := Pinfo.B; - Info.S := Pinfo.S; - - -- This is a complex type as the size is not known at compile time. - Info.Type_Mode := Type_Mode_Unbounded_Array; - Create_Array_For_Array_Subtype - (Def, Info.B.Base_Type, Info.B.Base_Ptr_Type); - end Translate_Array_Subtype_Definition_Constrained_Element; - procedure Create_Array_Type_Builder (Def : Iir_Array_Type_Definition; Kind : Object_Kind_Type) is @@ -1098,40 +1077,49 @@ package body Trans.Chap3 is end Create_Array_Type_Builder; procedure Translate_Array_Subtype_Definition - (Def : Iir; Parent_Type : Iir; With_Vars : Boolean) + (Def : Iir; Parent_Type : Iir) is - El_Type : constant Iir := Get_Element_Subtype (Def); Parent_El_Type : constant Iir := Get_Element_Subtype (Parent_Type); + El_Type : constant Iir := Get_Element_Subtype (Def); + El_Tinfo : Type_Info_Acc; Mark : Id_Mark_Type; begin -- Handle element subtype. - if El_Type /= Parent_El_Type then - -- TODO: do not create vars for element subtype, but use + if Get_Array_Element_Constraint (Def) /= Null_Iir then + -- Do not create vars for element subtype, but use -- the layout field of the array vars. Push_Identifier_Prefix (Mark, "ET"); - Translate_Subtype_Definition (El_Type, Parent_El_Type, With_Vars); + Translate_Subtype_Definition (El_Type, Parent_El_Type, False); Pop_Identifier_Prefix (Mark); + + El_Tinfo := Get_Info (El_Type); + if Is_Composite (El_Tinfo) then + pragma Assert (El_Tinfo.S.Composite_Layout = Null_Var); + El_Tinfo.S.Subtype_Owner := Get_Info (Def); + end if; + elsif Get_Info (El_Type) = null then + -- if the element subtype is created for this subtype, be sure it + -- has infos. + -- FIXME: the test should be refined. There can be a new element + -- subtype because a resolver has been added. + Set_Info (El_Type, Get_Info (Parent_El_Type)); end if; - if Get_Constraint_State (Def) = Fully_Constrained then + if Get_Index_Constraint_Flag (Def) then + -- Index constrained. Translate_Bounded_Array_Subtype_Definition (Def, Parent_Type); - if With_Vars then - Create_Composite_Subtype_Layout_Var (Def, False); - end if; - elsif Is_Fully_Constrained_Type (El_Type) - and then not Is_Fully_Constrained_Type (Parent_El_Type) - and then Is_Static_Type (Get_Info (El_Type)) - then - -- The array subtype is not constrained, but the element - -- subtype was just contrained. Create an array for - -- ortho, if the element subtype is static. - Translate_Array_Subtype_Definition_Constrained_Element - (Def, Parent_Type); else -- An unconstrained array subtype. Use same infos as base -- type. - Free_Info (Def); - Set_Info (Def, Get_Info (Parent_Type)); + -- FIXME: what if bounds are added. + declare + Tinfo : constant Type_Info_Acc := Get_Info (Def); + Parent_Tinfo : constant Type_Info_Acc := Get_Info (Parent_Type); + begin + Tinfo.all := Parent_Tinfo.all; + Tinfo.S.Composite_Layout := Null_Var; + Tinfo.Type_Rti := O_Dnode_Null; + end; end if; end Translate_Array_Subtype_Definition; @@ -1206,23 +1194,21 @@ package body Trans.Chap3 is -- Then create the record type. Info.S := Ortho_Info_Subtype_Record_Init; Info.Ortho_Type (Mode_Signal) := O_Tnode_Null; - Is_Complex := False; for Kind in Mode_Value .. Type_To_Last_Object_Kind (Def) loop Start_Record_Type (El_List); - for I in Flist_First .. Flist_Last (List) loop - El := Get_Nth_Element (List, I); - Field_Info := Get_Info (El); - El_Tinfo := Get_Info (Get_Type (El)); - if Is_Complex_Type (El_Tinfo) - or else Is_Unbounded_Type (El_Tinfo) - then - Is_Complex := True; - else - New_Record_Field (El_List, Field_Info.Field_Node (Kind), - Create_Identifier_Without_Prefix (El), - El_Tinfo.Ortho_Type (Kind)); - end if; - + for Static in reverse Boolean loop + -- First static fields, then non-static ones. + for I in Flist_First .. Flist_Last (List) loop + El := Get_Nth_Element (List, I); + Field_Info := Get_Info (El); + El_Tinfo := Get_Info (Get_Type (El)); + if Is_Static_Type (El_Tinfo) = Static then + New_Record_Field + (El_List, Field_Info.Field_Node (Kind), + Create_Identifier_Without_Prefix (El), + Get_Ortho_Type_Subelement (El_Tinfo, Kind)); + end if; + end loop; end loop; Finish_Record_Type (El_List, Info.B.Base_Type (Kind)); end loop; @@ -1232,6 +1218,7 @@ package body Trans.Chap3 is Start_Record_Type (El_List); New_Record_Field (El_List, Info.B.Layout_Size, Get_Identifier ("size"), Ghdl_Sizes_Type); + Is_Complex := False; for I in Flist_First .. Flist_Last (List) loop declare El : constant Iir := Get_Nth_Element (List, I); @@ -1240,6 +1227,7 @@ package body Trans.Chap3 is Unbounded_El : constant Boolean := Is_Unbounded_Type (El_Tinfo); Complex_El : constant Boolean := Is_Complex_Type (El_Tinfo); begin + Is_Complex := Is_Complex or Complex_El; if Unbounded_El or Complex_El then -- Offset New_Record_Field @@ -1287,144 +1275,154 @@ package body Trans.Chap3 is end if; end Translate_Record_Type; - procedure Translate_Record_Subtype (Def : Iir; With_Vars : Boolean) + procedure Translate_Record_Subtype_Definition + (Def : Iir; Parent_Type : Iir) is Base_Type : constant Iir := Get_Base_Type (Def); Base_Info : constant Type_Info_Acc := Get_Info (Base_Type); Info : constant Type_Info_Acc := Get_Info (Def); El_List : constant Iir_Flist := Get_Elements_Declaration_List (Def); - Type_Mark : constant Iir := Get_Subtype_Type_Mark (Def); El_Blist : constant Iir_Flist := Get_Elements_Declaration_List (Base_Type); - Parent_Type : Iir; - Parent_Info : Type_Info_Acc; - El_Tm_List : Iir_Flist; + Parent_Info : constant Type_Info_Acc := Get_Info (Parent_Type); + El_Tm_List : constant Iir_Flist := + Get_Elements_Declaration_List (Parent_Type); El, B_El : Iir_Element_Declaration; - El_Type : Iir; - El_Btype : Iir; - - Has_New_Constraints : Boolean; - Has_Boxed_Elements : Boolean; - Rec : O_Element_List; - Field_Info : Ortho_Info_Acc; + Rec : O_Element_Sublist; El_Tinfo : Type_Info_Acc; - El_Tnode : O_Tnode; - Mark : Id_Mark_Type; + Mode : Type_Mode_Type; + Fields : Subtype_Fields_Array_Acc; begin - if Is_Valid (Type_Mark) then - Parent_Type := Get_Type (Get_Named_Entity (Type_Mark)); - else - -- Type_mark may be null for anonymous subtype, like ones created - -- for an aggregate. - Parent_Type := Get_Base_Type (Def); - end if; - El_Tm_List := Get_Elements_Declaration_List (Parent_Type); - Parent_Info := Get_Info (Parent_Type); - -- Translate the newly constrained elements. - Has_New_Constraints := False; - Has_Boxed_Elements := False; + El := Get_Owned_Elements_Chain (Def); + while El /= Null_Iir loop + declare + El_Type : constant Iir := Get_Type (El); + Pos : constant Iir_Index32 := Get_Element_Position (El); + B_El : constant Iir := + Get_Nth_Element (El_Tm_List, Natural (Pos)); + B_El_Type : constant Iir := Get_Type (B_El); + El_Info : Field_Info_Acc; + Mark : Id_Mark_Type; + begin + -- Copy info (for the bound field). + El_Info := Get_Info (B_El); + Set_Info (El, El_Info); + + if Get_Info (El_Type) = null then + -- Translate the new constraint. + -- Not triggered on ownership, because of aggregate where + -- the subtype of a whole aggregate may be defined with bounds + -- from an element which can be a string or an aggregate that + -- owns the bound. + Push_Identifier_Prefix (Mark, Get_Identifier (El)); + Translate_Subtype_Definition (El_Type, B_El_Type, False); + Pop_Identifier_Prefix (Mark); + + El_Tinfo := Get_Info (El_Type); + if Is_Composite (El_Tinfo) then + pragma Assert (El_Tinfo.S.Composite_Layout = Null_Var); + El_Tinfo.S.Subtype_Owner := Info; + El_Tinfo.S.Owner_Field := El_Info; + end if; + end if; + end; + El := Get_Chain (El); + end loop; + + -- Mode of the subtype. + Mode := Type_Mode_Static_Record; for I in Flist_First .. Flist_Last (El_List) loop - El := Get_Nth_Element (El_List, I); - El_Type := Get_Type (El); - El_Btype := Get_Type (Get_Nth_Element (El_Tm_List, I)); - -- Constrained can only be added. - if Is_Fully_Constrained_Type (El_Type) - and then not Is_Fully_Constrained_Type (El_Btype) - then - Has_New_Constraints := True; - if Get_Type_Staticness (El_Type) = Locally then - Has_Boxed_Elements := True; + declare + El : constant Iir := Get_Nth_Element (El_List, I); + El_Type : constant Iir := Get_Type (El); + El_Tinfo : constant Type_Info_Acc := Get_Info (El_Type); + begin + if Is_Unbounded_Type (El_Tinfo) then + Mode := Type_Mode_Unbounded_Record; + -- Cannot be 'worse' than unbounded. + exit; + elsif Is_Complex_Type (El_Tinfo) then + Mode := Type_Mode_Complex_Record; end if; - Push_Identifier_Prefix (Mark, Get_Identifier (El)); - Translate_Subtype_Definition (El_Type, El_Btype, With_Vars); - Pop_Identifier_Prefix (Mark); - end if; + end; end loop; -- By default, use the same representation as the parent type. Info.all := Parent_Info.all; - -- Info.S := Ortho_Info_Subtype_Record_Init; -- However, it is a different subtype which has its own rti. Info.Type_Rti := O_Dnode_Null; - if Get_Constraint_State (Def) /= Fully_Constrained - or else not Has_New_Constraints - then - -- The subtype is not completly constrained: it cannot be used to - -- create objects, so wait until it is completly constrained. - -- The subtype is simply an alias. - -- In both cases, use the same representation as its type mark. - + if Get_Owned_Elements_Chain (Def) = Null_Iir then + -- That's considered as an alias of the type mark. Maybe only the + -- resolution is different. return; end if; + -- Info.S := Ortho_Info_Subtype_Record_Init; - -- Record is constrained. - if Get_Type_Staticness (Def) = Locally then - Info.Type_Mode := Type_Mode_Static_Record; - else - Info.Type_Mode := Type_Mode_Complex_Record; - end if; + case Type_Mode_Records (Mode) is + when Type_Mode_Unbounded_Record => + pragma Assert (Parent_Info.Type_Mode = Type_Mode_Unbounded_Record); + -- The subtype is not completly constrained: it cannot be used to + -- create objects, so wait until it is completly constrained. + -- The subtype is simply an alias. + -- In both cases, use the same representation as its type mark. + null; - -- Then create the record type, containing the base record and the - -- fields. - if Has_Boxed_Elements then - Info.Ortho_Type (Mode_Signal) := O_Tnode_Null; - for Kind in Mode_Value .. Type_To_Last_Object_Kind (Def) loop - Start_Record_Type (Rec); - New_Record_Field (Rec, Info.S.Box_Field (Kind), Wki_Base, - Info.B.Base_Type (Kind)); - for I in Flist_First .. Flist_Last (El_Blist) loop - B_El := Get_Nth_Element (El_Blist, I); - El := Get_Nth_Element (El_List, I); - - -- This element has been locally constrained. - if Is_Unbounded_Type (Get_Info (Get_Type (B_El))) - and then Get_Type_Staticness (Get_Type (El)) = Locally - then - if Kind = Mode_Value then - Field_Info := Add_Info (El, Kind_Field); - else - Field_Info := Get_Info (El); - end if; - El := Get_Nth_Element (El_List, I); - El_Tinfo := Get_Info (Get_Type (El)); - El_Tnode := El_Tinfo.Ortho_Type (Kind); - New_Record_Field (Rec, Field_Info.Field_Node (Kind), - Create_Identifier_Without_Prefix (El), - El_Tnode); - Field_Info.Field_Bound := Get_Info (B_El).Field_Bound; - else - if Kind = Mode_Value and then El /= B_El then - Set_Info (El, Get_Info (B_El)); - end if; - end if; - end loop; - Finish_Record_Type (Rec, Info.Ortho_Type (Kind)); - end loop; + when Type_Mode_Complex_Record => + -- At least one field is not static. + -- Do not over-optimize and consider all the fields that were + -- initially unbounded as complex. + Info.Type_Mode := Type_Mode_Complex_Record; - Finish_Type_Definition (Info); - else - -- This is a complex type as the size is not known at compile - -- time. - Info.Ortho_Type := Base_Info.B.Base_Type; - Info.Ortho_Ptr_Type := Base_Info.B.Base_Ptr_Type; + Info.Ortho_Type := Base_Info.B.Base_Type; + Info.Ortho_Ptr_Type := Base_Info.B.Base_Ptr_Type; - for I in Flist_First .. Flist_Last (El_Blist) loop - B_El := Get_Nth_Element (El_Blist, I); - El := Get_Nth_Element (El_List, I); - if El /= B_El then - Set_Info (El, Get_Info (B_El)); - end if; - end loop; - end if; + when Type_Mode_Static_Record => + -- The subtype is static. + Info.Type_Mode := Type_Mode_Static_Record; - if With_Vars then - Create_Composite_Subtype_Layout_Var (Def, False); - end if; - end Translate_Record_Subtype; + -- Create the subtypes. + Info.Ortho_Type (Mode_Signal) := O_Tnode_Null; + Fields := new Subtype_Fields_Array + (0 .. Iir_Index32 (Get_Nbr_Elements (El_Blist)) - 1); + Fields.all := (others => Subtype_Fields_Null); + Info.S.Rec_Fields := Fields; + for Kind in Mode_Value .. Type_To_Last_Object_Kind (Def) loop + Start_Record_Subtype (Parent_Info.B.Base_Type (Kind), Rec); + for Static in reverse Boolean loop + for I in Flist_First .. Flist_Last (El_Blist) loop + B_El := Get_Nth_Element (El_Blist, I); + El_Tinfo := Get_Info (Get_Type (B_El)); + if Is_Static_Type (El_Tinfo) then + if Static then + -- First the bounded fields. + New_Subrecord_Field + (Rec, Fields (Iir_Index32 (I)).Fields (Kind), + El_Tinfo.Ortho_Type (Kind)); + Fields (Iir_Index32 (I)).Tinfo := El_Tinfo; + end if; + else + if not Static then + -- Then the bounded subtype of unbounded fields. + El := Get_Nth_Element (El_List, I); + El_Tinfo := Get_Info (Get_Type (El)); + New_Subrecord_Field + (Rec, Fields (Iir_Index32 (I)).Fields (Kind), + El_Tinfo.Ortho_Type (Kind)); + Fields (Iir_Index32 (I)).Tinfo := El_Tinfo; + end if; + end if; + end loop; + end loop; + Finish_Record_Subtype (Rec, Info.Ortho_Type (Kind)); + end loop; + + Finish_Type_Definition (Info); + end case; + end Translate_Record_Subtype_Definition; procedure Create_Record_Type_Builder (Def : Iir_Record_Type_Definition; Kind : Object_Kind_Type) @@ -1450,9 +1448,9 @@ package body Trans.Chap3 is Ghdl_Index_Type); -- Reserve memory for the record, ie: - -- OFF = SIZEOF (record). + -- off = RECORD_SIZEOF (record). Off_Val := New_Lit - (New_Sizeof (Info.B.Base_Type (Kind), Ghdl_Index_Type)); + (New_Record_Sizeof (Info.B.Base_Type (Kind), Ghdl_Index_Type)); New_Assign_Stmt (New_Obj (Off_Var), Off_Val); -- Set memory for each complex element. @@ -1926,19 +1924,13 @@ package body Trans.Chap3 is Info : Type_Info_Acc; begin case Get_Kind (Def) is - when Iir_Kind_Enumeration_Type_Definition - | Iir_Kinds_Scalar_Subtype_Definition => + when Iir_Kind_Enumeration_Type_Definition => Info := Get_Info (Def); if not Info.S.Same_Range then Target := Get_Var (Info.S.Range_Var); Elab_Scalar_Type_Range (Def, Target); end if; - when Iir_Kind_Array_Subtype_Definition => - if Get_Constraint_State (Def) = Fully_Constrained then - Elab_Composite_Subtype_Layout (Def); - end if; - when Iir_Kind_Array_Type_Definition => declare Index_List : constant Iir_Flist := @@ -1954,15 +1946,13 @@ package body Trans.Chap3 is end; return; - when Iir_Kind_Record_Subtype_Definition - | Iir_Kind_Record_Type_Definition => + when Iir_Kind_Record_Type_Definition => Info := Get_Info (Def); if Info.S.Composite_Layout /= Null_Var then Elab_Composite_Subtype_Layout (Def); end if; when Iir_Kind_Access_Type_Definition - | Iir_Kind_Access_Subtype_Definition | Iir_Kind_File_Type_Definition | Iir_Kind_Protected_Type_Declaration => return; @@ -2374,10 +2364,20 @@ package body Trans.Chap3 is end if; when Iir_Kind_Array_Subtype_Definition => - Translate_Array_Subtype_Definition (Def, Parent_Type, With_Vars); + Translate_Array_Subtype_Definition (Def, Parent_Type); + if With_Vars +-- and then Get_Index_Constraint_Flag (Def) + then + Create_Composite_Subtype_Layout_Var (Def, False); + end if; when Iir_Kind_Record_Subtype_Definition => - Translate_Record_Subtype (Def, With_Vars); + Translate_Record_Subtype_Definition (Def, Parent_Type); + if With_Vars + and then Get_Owned_Elements_Chain (Def) /= Null_Iir + then + Create_Composite_Subtype_Layout_Var (Def, False); + end if; when Iir_Kind_Access_Subtype_Definition => -- Like the access type. @@ -2469,9 +2469,10 @@ package body Trans.Chap3 is -- Initialize the objects related to a type (type range and type -- descriptor). procedure Elab_Type_Definition (Def : Iir); + procedure Elab_Subtype_Definition (Def : Iir); procedure Elab_Type_Definition_Depend is new Handle_Anonymous_Subtypes - (Handle_A_Subtype => Elab_Type_Definition); + (Handle_A_Subtype => Elab_Subtype_Definition); procedure Elab_Type_Definition (Def : Iir) is begin @@ -2598,7 +2599,7 @@ package body Trans.Chap3 is end if; raise Internal_Error; else - Elab_Type_Definition (Def); + Elab_Subtype_Definition (Def); end if; end; end Elab_Object_Subtype_Indication; @@ -2608,9 +2609,43 @@ package body Trans.Chap3 is Elab_Type_Definition (Get_Type_Definition (Decl)); end Elab_Type_Declaration; - procedure Elab_Subtype_Declaration (Decl : Iir_Subtype_Declaration) is + procedure Elab_Subtype_Definition (Def : Iir) + is + Target : O_Lnode; + Info : Type_Info_Acc; + begin + if Get_Type_Staticness (Def) = Locally then + return; + end if; + + case Get_Kind (Def) is + when Iir_Kinds_Scalar_Subtype_Definition => + Info := Get_Info (Def); + if not Info.S.Same_Range then + Target := Get_Var (Info.S.Range_Var); + Elab_Scalar_Type_Range (Def, Target); + end if; + + when Iir_Kind_Record_Subtype_Definition + | Iir_Kind_Array_Subtype_Definition => + Info := Get_Info (Def); + if Info.S.Composite_Layout /= Null_Var then + Elab_Composite_Subtype_Layout (Def); + end if; + + when Iir_Kind_Access_Subtype_Definition => + null; + + when others => + Error_Kind ("elab_subtype_definition", Def); + end case; + end Elab_Subtype_Definition; + + procedure Elab_Subtype_Declaration (Decl : Iir_Subtype_Declaration) + is + Def : constant Iir := Get_Type (Decl); begin - Elab_Type_Definition (Get_Type (Decl)); + Elab_Subtype_Definition (Def); end Elab_Subtype_Declaration; function Get_Static_Array_Length (Atype : Iir) return Int64 @@ -2847,24 +2882,6 @@ package body Trans.Chap3 is end case; end Get_Composite_Base; - function Unbox_Record (Obj : Mnode) return Mnode - is - Info : constant Type_Info_Acc := Get_Type_Info (Obj); - pragma Assert (Info.Type_Mode in Type_Mode_Bounded_Records); - Kind : constant Object_Kind_Type := Get_Object_Kind (Obj); - Box_Field : constant O_Fnode := Info.S.Box_Field (Kind); - begin - if Box_Field /= O_Fnode_Null then - -- Unbox the record. - return Lv2M (New_Selected_Element (M2Lv (Obj), Box_Field), - Info, Kind, - Info.B.Base_Type (Kind), - Info.B.Base_Ptr_Type (Kind)); - else - return Obj; - end if; - end Unbox_Record; - function Get_Composite_Unbounded_Base (Obj : Mnode) return Mnode is Info : constant Type_Info_Acc := Get_Type_Info (Obj); @@ -2878,7 +2895,7 @@ package body Trans.Chap3 is -- also an access to a constrained array. return Obj; when Type_Mode_Bounded_Records => - return Unbox_Record (Obj); + return Obj; when others => raise Internal_Error; end case; @@ -2927,51 +2944,42 @@ package body Trans.Chap3 is D_Info.B.Base_Ptr_Type (Mode_Value)); end Get_Bounds_Acc_Base; - function Reindex_Array - (Base : Mnode; Atype : Iir; Index : O_Enode; Stride : O_Enode) - return O_Enode - is - El_Type : constant Iir := Get_Element_Subtype (Atype); - El_Tinfo : constant Type_Info_Acc := Get_Info (El_Type); - Kind : constant Object_Kind_Type := Get_Object_Kind (Base); - begin - return Add_Pointer (M2E (Base), - New_Dyadic_Op (ON_Mul_Ov, Stride, Index), - El_Tinfo.Ortho_Ptr_Type (Kind)); - end Reindex_Array; - function Reindex_Complex_Array (Base : Mnode; Atype : Iir; Index : O_Enode; Res_Info : Type_Info_Acc) return Mnode is - El_Type : constant Iir := Get_Element_Subtype (Atype); Kind : constant Object_Kind_Type := Get_Object_Kind (Base); + El_Type : constant Iir := Get_Element_Subtype (Atype); + Stride : O_Enode; + Res : O_Enode; begin - return E2M (Reindex_Array - (Base, Atype, - Index, - Get_Subtype_Size (El_Type, Mnode_Null, Kind)), - Res_Info, Kind); + Stride := Get_Subtype_Size (El_Type, Mnode_Null, Kind); + Res := Add_Pointer (M2E (Base), + New_Dyadic_Op (ON_Mul_Ov, Stride, Index), + Res_Info.Ortho_Ptr_Type (Kind)); + return E2M (Res, Res_Info, Kind); end Reindex_Complex_Array; function Index_Base (Base : Mnode; Atype : Iir; Index : O_Enode) return Mnode is - El_Type : constant Iir := Get_Element_Subtype (Atype); - El_Tinfo : constant Type_Info_Acc := Get_Info (El_Type); - Kind : constant Object_Kind_Type := Get_Object_Kind (Base); + Arr_Tinfo : constant Type_Info_Acc := Get_Type_Info (Base); + Kind : constant Object_Kind_Type := Get_Object_Kind (Base); + El_Type : constant Iir := Get_Element_Subtype (Atype); + El_Tinfo : constant Type_Info_Acc := Get_Info (El_Type); begin - if Is_Unbounded_Type (El_Tinfo) then - -- It's not possible to index an unbounded array with only the base, - -- as the size of an element is not known. - -- Index_Array must be used instead. - raise Internal_Error; - elsif Is_Complex_Type (El_Tinfo) then - return Reindex_Complex_Array (Base, Atype, Index, El_Tinfo); - else + if Arr_Tinfo.Type_Mode = Type_Mode_Static_Array + or else Is_Static_Type (Get_Info (Get_Element_Subtype + (Get_Base_Type (Atype)))) + then + -- If the array is fully constrained it can be indexed. return Lv2M (New_Indexed_Element (M2Lv (Base), Index), El_Tinfo, Kind); end if; + + -- If the element type of the base type is static, the array + -- can be directly indexed. + return Reindex_Complex_Array (Base, Atype, Index, El_Tinfo); end Index_Base; function Convert_Array_Base (Arr : Mnode) return Mnode @@ -2999,33 +3007,22 @@ package body Trans.Chap3 is begin Base := Get_Composite_Base (Arr); -- For indexing, we need to consider the size of elements. - case Type_Mode_Valid (El_Tinfo.Type_Mode) is - when Type_Mode_Unbounded_Array - | Type_Mode_Unbounded_Record => - return E2M - (Add_Pointer - (M2E (Base), - New_Dyadic_Op - (ON_Mul_Ov, - Index, - New_Value (Array_Bounds_To_Element_Size - (Get_Composite_Bounds (Arr), Atype))), - El_Tinfo.B.Base_Ptr_Type (Kind)), - El_Tinfo, Kind, - El_Tinfo.B.Base_Type (Kind), - El_Tinfo.B.Base_Ptr_Type (Kind)); - when Type_Mode_Complex_Array - | Type_Mode_Complex_Record => - return Reindex_Complex_Array (Base, Atype, Index, El_Tinfo); - when Type_Mode_Thin - | Type_Mode_Static_Array - | Type_Mode_Static_Record => - Base := Convert_Array_Base (Base); - return Lv2M (New_Indexed_Element (M2Lv (Base), Index), - El_Tinfo, Kind); - when Type_Mode_Protected => - raise Internal_Error; - end case; + if Is_Unbounded_Type (El_Tinfo) then + return E2M + (Add_Pointer + (M2E (Base), + New_Dyadic_Op + (ON_Mul_Ov, + Index, + New_Value (Array_Bounds_To_Element_Size + (Get_Composite_Bounds (Arr), Atype))), + El_Tinfo.B.Base_Ptr_Type (Kind)), + El_Tinfo, Kind, + El_Tinfo.B.Base_Type (Kind), + El_Tinfo.B.Base_Ptr_Type (Kind)); + else + return Index_Base (Base, Atype, Index); + end if; end Index_Array; function Slice_Base (Base : Mnode; Atype : Iir; Index : O_Enode) @@ -3038,7 +3035,16 @@ package body Trans.Chap3 is begin if Is_Complex_Type (El_Tinfo) then return Reindex_Complex_Array (Base, Atype, Index, T_Info); + elsif T_Info.Type_Mode = Type_Mode_Static_Array then + -- Static array. Use the type of the array. + return Lv2M (New_Slice (M2Lv (Base), + T_Info.Ortho_Type (Kind), + Index), + T_Info, Kind, + T_Info.Ortho_Type (Kind), + T_Info.Ortho_Ptr_Type (Kind)); else + -- The base is sliced, so use the ortho type of the base. return Lv2M (New_Slice (M2Lv (Base), T_Info.B.Base_Type (Kind), Index), @@ -3082,11 +3088,11 @@ package body Trans.Chap3 is Tinfo.B.Bounds_Ptr_Type)); end Allocate_Unbounded_Composite_Bounds; + -- For aliases of a slice. procedure Translate_Array_Subtype (Arr_Type : Iir) is begin - Chap3.Translate_Subtype_Definition - (Arr_Type, Get_Base_Type (Arr_Type), False); - Chap3.Create_Composite_Subtype_Layout_Var (Arr_Type, False); + Translate_Subtype_Definition (Arr_Type, Get_Base_Type (Arr_Type), False); + Create_Composite_Subtype_Layout_Var (Arr_Type, False); end Translate_Array_Subtype; procedure Elab_Array_Subtype (Arr_Type : Iir) is diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb index 986c5f658..488dc9021 100644 --- a/src/vhdl/translate/trans-chap4.adb +++ b/src/vhdl/translate/trans-chap4.adb @@ -1757,15 +1757,18 @@ package body Trans.Chap4 is A : Var_Type renames Alias_Info.Alias_Var (Mode); Alias_Node : Mnode; begin + -- FIXME: use subtype conversion ? case Tinfo.Type_Mode is when Type_Mode_Unbounded => Stabilize (N); Alias_Node := Stabilize (Get_Var (A, Tinfo, Mode)); - Copy_Fat_Pointer (Alias_Node, N); + Chap7.Convert_Constrained_To_Unconstrained (Alias_Node, N); when Type_Mode_Bounded_Arrays => Stabilize (N); - New_Assign_Stmt (Get_Var (A), - M2E (Chap3.Get_Composite_Base (N))); + New_Assign_Stmt + (Get_Var (A), + New_Convert_Ov (M2E (Chap3.Get_Composite_Base (N)), + Tinfo.Ortho_Ptr_Type (Mode))); Chap3.Check_Composite_Match (Decl_Type, T2M (Decl_Type, Mode), Name_Type, N, Decl); diff --git a/src/vhdl/translate/trans-chap5.adb b/src/vhdl/translate/trans-chap5.adb index 4c508931c..20d4a3a19 100644 --- a/src/vhdl/translate/trans-chap5.adb +++ b/src/vhdl/translate/trans-chap5.adb @@ -72,8 +72,7 @@ package body Trans.Chap5 is Push_Identifier_Prefix_Uniq (Mark); if Is_Anonymous_Type_Definition (Spec_Type) then Push_Identifier_Prefix (Mark2, "OT"); - Chap3.Translate_Subtype_Definition - (Spec_Type, Get_Type (Attr), True); + Chap3.Translate_Subtype_Definition (Spec_Type, Get_Type (Attr), True); Pop_Identifier_Prefix (Mark2); end if; @@ -336,10 +335,14 @@ package body Trans.Chap5 is is pragma Unreferenced (Formal_Type); Res : Connect_Data; + Fel : Iir; begin + Fel := Get_Nth_Element + (Get_Elements_Declaration_List (Data.Actual_Type), + Natural (Get_Element_Position (El))); Res := (Actual_Sig => - Chap6.Translate_Selected_Element (Data.Actual_Sig, El), - Actual_Type => Get_Type (El), + Chap6.Translate_Selected_Element (Data.Actual_Sig, Fel), + Actual_Type => Get_Type (Fel), Mode => Data.Mode, By_Copy => Data.By_Copy); return Res; diff --git a/src/vhdl/translate/trans-chap6.adb b/src/vhdl/translate/trans-chap6.adb index f0ee207ad..aaf3fe280 100644 --- a/src/vhdl/translate/trans-chap6.adb +++ b/src/vhdl/translate/trans-chap6.adb @@ -913,43 +913,50 @@ package body Trans.Chap6 is function Translate_Selected_Element (Prefix : Mnode; El : Iir_Element_Declaration) return Mnode is - El_Type : constant Iir := Get_Type (El); - El_Btype : constant Iir := Get_Base_Type (El_Type); - El_Tinfo : constant Type_Info_Acc := Get_Info (El_Type); + -- Note: EL can be an element_declaration or a record_element_constraint + -- It can be an element_declaration even if the prefix is of a record + -- subtype with a constraint on EL. + Prefix_Tinfo : constant Type_Info_Acc := Get_Type_Info (Prefix); Kind : constant Object_Kind_Type := Get_Object_Kind (Prefix); - Base_El : constant Iir := Get_Base_Element_Declaration (El); - El_Info : Field_Info_Acc; - Base_Tinfo : Type_Info_Acc; + Pos : constant Iir_Index32 := Get_Element_Position (El); + Res_Type : constant Iir := Get_Type (El); + Res_Tinfo : constant Type_Info_Acc := Get_Info (Res_Type); + El_Tinfo : Type_Info_Acc; Stable_Prefix : Mnode; - Base, Res, Fat_Res : Mnode; - Rec_Layout : Mnode; - El_Descr : Mnode; - Box_Field : O_Fnode; - B : O_Lnode; + Base : Mnode; + Res, Fat_Res : Mnode; + Rec_Layout : Mnode; + El_Descr : Mnode; + F : O_Fnode; begin - -- There are 3 cases: - -- a) the record is bounded (and so is the element). - -- b) the record is unbounded and the element is bounded - -- c) the record is unbounded and the element is unbounded. - -- If the record is unbounded, PREFIX is a fat pointer. - -- On top of that, the element may be complex. - - -- For record subtypes, there is no info for elements that have not - -- changed. - El_Info := Get_Info (El); - if El_Info = null then - El_Info := Get_Info (Base_El); + -- RES_TINFO is the type info of the result. + -- EL_TINFO is the type info of the field. + -- They can be different when the record subtype is partially + -- constrained or is complex. + if Prefix_Tinfo.S.Rec_Fields /= null then + F := Prefix_Tinfo.S.Rec_Fields (Pos).Fields (Kind); + El_Tinfo := Prefix_Tinfo.S.Rec_Fields (Pos).Tinfo; + pragma Assert (El_Tinfo = Res_Tinfo); + else + -- Use the base element. + declare + Bel : constant Iir := Get_Base_Element_Declaration (El); + Bel_Info : constant Field_Info_Acc := Get_Info (Bel); + begin + F := Bel_Info.Field_Node (Kind); + El_Tinfo := Get_Info (Get_Type (Bel)); + end; end if; - if Is_Unbounded_Type (El_Tinfo) then + if Is_Unbounded_Type (Res_Tinfo) then Stable_Prefix := Stabilize (Prefix); -- Result is a fat pointer, create it and set bounds. -- FIXME: layout for record, bounds for array! - Fat_Res := Create_Temp (El_Tinfo, Kind); + Fat_Res := Create_Temp (Res_Tinfo, Kind); El_Descr := Chap3.Record_Layout_To_Element_Layout (Chap3.Get_Composite_Bounds (Stable_Prefix), El); - case El_Tinfo.Type_Mode is + case Res_Tinfo.Type_Mode is when Type_Mode_Unbounded_Record => null; when Type_Mode_Unbounded_Array => @@ -965,58 +972,41 @@ package body Trans.Chap6 is -- Get the base. Base := Chap3.Get_Composite_Base (Stable_Prefix); - Base_Tinfo := Get_Type_Info (Base); - Box_Field := Base_Tinfo.S.Box_Field (Kind); - if (Box_Field = O_Fnode_Null - or else Get_Type_Staticness (El_Type) /= Locally) - and then (Is_Complex_Type (El_Tinfo) or Is_Unbounded_Type (El_Tinfo)) + if Prefix_Tinfo.Type_Mode = Type_Mode_Static_Record + or else Is_Static_Type (El_Tinfo) then + -- If the base element type is static or if the prefix is static, + -- then the element can directly be accessed. + Res := Lv2M (New_Selected_Element (M2Lv (Base), F), El_Tinfo, Kind); + else + -- Unbounded or complex element. Stabilize (Base); - if Box_Field /= O_Fnode_Null - and then Get_Type_Staticness (El_Type) /= Locally - then - -- Unbox. - B := New_Selected_Element (M2Lv (Base), Box_Field); - else - B := M2Lv (Base); - end if; - -- The element is complex: it's an offset. Rec_Layout := Chap3.Get_Composite_Bounds (Stable_Prefix); - Res := E2M - (New_Unchecked_Address - (New_Slice - (New_Access_Element - (New_Unchecked_Address (M2Lv (Base), Char_Ptr_Type)), - Chararray_Type, - New_Value - (Chap3.Record_Layout_To_Element_Offset - (Rec_Layout, El, Kind))), - El_Tinfo.B.Base_Ptr_Type (Kind)), - El_Tinfo, Kind); - else - -- Normal element. - B := M2Lv (Base); - - if Box_Field /= O_Fnode_Null - and then El_Type = Get_Type (Base_El) - then - -- Unbox. - B := New_Selected_Element (B, Box_Field); - end if; - - Res := Lv2M (New_Selected_Element (B, El_Info.Field_Node (Kind)), - El_Tinfo, Kind); + Res := Lv2M + (New_Access_Element + (New_Unchecked_Address + (New_Slice + (New_Access_Element (New_Unchecked_Address (M2Lv (Base), + Char_Ptr_Type)), + Chararray_Type, + New_Value (Chap3.Record_Layout_To_Element_Offset + (Rec_Layout, El, Kind))), + El_Tinfo.B.Base_Ptr_Type (Kind))), + Res_Tinfo, + Kind, + Res_Tinfo.B.Base_Type (Kind), + Res_Tinfo.B.Base_Ptr_Type (Kind)); end if; - if Is_Unbounded_Type (El_Tinfo) then + if Is_Unbounded_Type (Res_Tinfo) then -- Ok, we know that Get_Composite_Base doesn't return a copy. New_Assign_Stmt (M2Lp (Chap3.Get_Composite_Base (Fat_Res)), New_Convert_Ov (M2Addr (Res), - Get_Info (El_Btype).B.Base_Ptr_Type (Kind))); + Res_Tinfo.B.Base_Ptr_Type (Kind))); return Fat_Res; else return Res; diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb index cd21d4755..add6deaf8 100644 --- a/src/vhdl/translate/trans-chap7.adb +++ b/src/vhdl/translate/trans-chap7.adb @@ -789,15 +789,13 @@ package body Trans.Chap7 is (Res, Get_Return_Type (Imp), Res_Type, Mode_Value, Left); end Translate_Operator_Function_Call; - function Convert_Constrained_To_Unconstrained - (Expr : Mnode; Res_Type : Iir) return Mnode + procedure Convert_Constrained_To_Unconstrained + (Res : in out Mnode; Expr : Mnode) is - Type_Info : constant Type_Info_Acc := Get_Info (Res_Type); + Type_Info : constant Type_Info_Acc := Get_Type_Info (Res); Kind : constant Object_Kind_Type := Get_Object_Kind (Expr); Stable_Expr : Mnode; - Res : Mnode; begin - Res := Create_Temp (Type_Info, Kind); Stable_Expr := Stabilize (Expr); New_Assign_Stmt (M2Lp (Chap3.Get_Composite_Base (Res)), @@ -806,6 +804,16 @@ package body Trans.Chap7 is New_Assign_Stmt (M2Lp (Chap3.Get_Composite_Bounds (Res)), M2Addr (Chap3.Get_Composite_Bounds (Stable_Expr))); + end Convert_Constrained_To_Unconstrained; + + function Convert_Constrained_To_Unconstrained + (Expr : Mnode; Res_Tinfo : Type_Info_Acc) return Mnode + is + Mode : constant Object_Kind_Type := Get_Object_Kind (Expr); + Res : Mnode; + begin + Res := Create_Temp (Res_Tinfo, Mode); + Convert_Constrained_To_Unconstrained (Res, Expr); return Res; end Convert_Constrained_To_Unconstrained; @@ -921,9 +929,9 @@ package body Trans.Chap7 is function Translate_Implicit_Array_Conversion (Expr : Mnode; Expr_Type : Iir; Res_Type : Iir; Loc : Iir) return Mnode is - Ainfo : Type_Info_Acc; + Res_Tinfo : Type_Info_Acc; Einfo : Type_Info_Acc; - Mode : Object_Kind_Type; + Mode : Object_Kind_Type; begin pragma Assert (Get_Kind (Expr_Type) in Iir_Kinds_Array_Type_Definition); @@ -932,9 +940,9 @@ package body Trans.Chap7 is return Expr; end if; - Ainfo := Get_Info (Res_Type); + Res_Tinfo := Get_Info (Res_Type); Einfo := Get_Info (Expr_Type); - case Ainfo.Type_Mode is + case Res_Tinfo.Type_Mode is when Type_Mode_Unbounded_Array => -- X to unconstrained. case Einfo.Type_Mode is @@ -943,7 +951,8 @@ package body Trans.Chap7 is return Expr; when Type_Mode_Bounded_Arrays => -- constrained to unconstrained. - return Convert_Constrained_To_Unconstrained (Expr, Res_Type); + return Convert_Constrained_To_Unconstrained + (Expr, Res_Tinfo); when others => raise Internal_Error; end case; @@ -962,8 +971,8 @@ package body Trans.Chap7 is -- different. Mode := Get_Object_Kind (Expr); return E2M (New_Convert_Ov (M2Addr (Expr), - Ainfo.Ortho_Ptr_Type (Mode)), - Ainfo, Mode); + Res_Tinfo.Ortho_Ptr_Type (Mode)), + Res_Tinfo, Mode); else -- Unbounded/bounded array to bounded array. return Convert_To_Constrained (Expr, Expr_Type, Res_Type, Loc); @@ -978,16 +987,16 @@ package body Trans.Chap7 is function Translate_Implicit_Record_Conversion (Expr : Mnode; Expr_Type : Iir; Res_Type : Iir; Loc : Iir) return Mnode is - Ainfo : Type_Info_Acc; + Res_Tinfo : Type_Info_Acc; Einfo : Type_Info_Acc; begin if Res_Type = Expr_Type then return Expr; end if; - Ainfo := Get_Info (Res_Type); + Res_Tinfo := Get_Info (Res_Type); Einfo := Get_Info (Expr_Type); - case Ainfo.Type_Mode is + case Res_Tinfo.Type_Mode is when Type_Mode_Unbounded_Record => -- X to unbounded. case Einfo.Type_Mode is @@ -996,7 +1005,8 @@ package body Trans.Chap7 is return Expr; when Type_Mode_Bounded_Records => -- bounded to unconstrained. - return Convert_Constrained_To_Unconstrained (Expr, Res_Type); + return Convert_Constrained_To_Unconstrained + (Expr, Res_Tinfo); when others => raise Internal_Error; end case; @@ -1461,9 +1471,11 @@ package body Trans.Chap7 is M2Addr (Chap3.Get_Composite_Bounds (M))); New_Assign_Stmt (M2Lp (Chap3.Get_Composite_Base (Var_Sub_Arr)), - M2Addr (Chap3.Slice_Base (Var_Arr, - Expr_Type, - New_Obj_Value (Var_Off)))); + New_Convert_Ov + (M2Addr (Chap3.Slice_Base (Var_Arr, + Expr_Type, + New_Obj_Value (Var_Off))), + Info.B.Base_Ptr_Type (Mode_Value))); -- Copy Chap3.Translate_Object_Copy (Var_Sub_Arr, M, Expr_Type); @@ -3234,16 +3246,13 @@ package body Trans.Chap7 is end case; end Translate_Array_Aggregate_Gen; - procedure Translate_Record_Aggregate (Target : Mnode; Aggr : Iir) + procedure Translate_Record_Aggregate + (Target : Mnode; Target_Type : Iir; Aggr : Iir) is - Targ : Mnode; - Aggr_Type : constant Iir := Get_Type (Aggr); - Aggr_Base_Type : constant Iir_Record_Type_Definition := - Get_Base_Type (Aggr_Type); - El_List : constant Iir_Flist := - Get_Elements_Declaration_List (Aggr_Base_Type); - El_Index : Natural; - Nbr_El : constant Natural := Get_Nbr_Elements (El_List); + El_List : constant Iir_Flist := + Get_Elements_Declaration_List (Target_Type); + El_Index : Natural; + Nbr_El : constant Natural := Get_Nbr_Elements (El_List); -- Record which elements of the record have been set. The 'others' -- clause applies to all elements not already set. @@ -3253,22 +3262,24 @@ package body Trans.Chap7 is -- The expression associated. El_Expr : Iir; - Assoc : Iir; + Assoc : Iir; + Targ : Mnode; -- Set an elements. procedure Set_El (El : Iir_Element_Declaration) is Info : constant Ortho_Info_Acc := Get_Info (Assoc); + El_Type : constant Iir := Get_Type (El); Dest : Mnode; begin 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)); + Chap3.Translate_Object_Copy (Dest, Info.Expr_Eval, El_Type); Clear_Info (Assoc); else - Translate_Assign (Dest, El_Expr, Get_Type (El)); + Translate_Assign (Dest, El_Expr, El_Type); end if; Set_Array (Natural (Get_Element_Position (El))) := True; end Set_El; @@ -3277,19 +3288,26 @@ package body Trans.Chap7 is begin Open_Temp; Targ := Stabilize (Target); + El_Index := 0; Assoc := Get_Association_Choices_Chain (Aggr); while Assoc /= Null_Iir loop + -- Get the associated expression, possibly from the first choice + -- in a lidt of choices. N_El_Expr := Get_Associated_Expr (Assoc); if N_El_Expr /= Null_Iir then El_Expr := N_El_Expr; end if; + case Get_Kind (Assoc) is when Iir_Kind_Choice_By_None => Set_El (Get_Nth_Element (El_List, El_Index)); El_Index := El_Index + 1; when Iir_Kind_Choice_By_Name => - Set_El (Get_Named_Entity (Get_Choice_Name (Assoc))); + El_Index := Natural + (Get_Element_Position + (Get_Named_Entity (Get_Choice_Name (Assoc)))); + Set_El (Get_Nth_Element (El_List, El_Index)); El_Index := Natural'Last; when Iir_Kind_Choice_By_Others => for J in Set_Array'Range loop @@ -3508,7 +3526,7 @@ package body Trans.Chap7 is end; when Iir_Kind_Record_Type_Definition | Iir_Kind_Record_Subtype_Definition => - Translate_Record_Aggregate (Target, Aggr); + Translate_Record_Aggregate (Target, Target_Type, Aggr); end case; end Translate_Aggregate; @@ -3564,6 +3582,7 @@ package body Trans.Chap7 is L : Mnode; begin Bnd := Chap3.Get_Composite_Type_Bounds (Expr_Type); + L := Chap3.Range_To_Length (Chap3.Bounds_To_Range (Bnd, Expr_Type, 1)); New_Assign_Stmt @@ -3937,10 +3956,10 @@ package body Trans.Chap7 is (Res : Mnode; Src : Mnode; Res_Type : Iir; Src_Type : Iir; Loc : Iir) is Res_Indexes : constant Iir_Flist := Get_Index_Subtype_List (Res_Type); - Src_Indexes : constant Iir_Flist := Get_Index_Subtype_List (Src_Type); - Res_Base_Type : constant Iir := Get_Base_Type (Res_Type); + Src_Indexes : constant Iir_Flist := Get_Index_Subtype_List (Src_Type); + Res_Base_Type : constant Iir := Get_Base_Type (Res_Type); Src_Base_Type : constant Iir := Get_Base_Type (Src_Type); - Res_Base_Indexes : constant Iir_Flist := + Res_Base_Indexes : constant Iir_Flist := Get_Index_Subtype_List (Res_Base_Type); Src_Base_Indexes : constant Iir_Flist := Get_Index_Subtype_List (Src_Base_Type); @@ -3990,12 +4009,12 @@ package body Trans.Chap7 is (Expr : O_Enode; Expr_Type : Iir; Res_Type : Iir; Loc : Iir) return O_Enode is - Res_Info : constant Type_Info_Acc := Get_Info (Res_Type); - Expr_Info : constant Type_Info_Acc := Get_Info (Expr_Type); + Res_Info : constant Type_Info_Acc := Get_Info (Res_Type); + Expr_Info : constant Type_Info_Acc := Get_Info (Expr_Type); - Res : Mnode; - E : Mnode; - Bounds : O_Dnode; + Res : Mnode; + E : Mnode; + Bounds : O_Dnode; begin Res := Create_Temp (Res_Info, Mode_Value); Bounds := Create_Temp (Res_Info.B.Bounds_Type); @@ -4173,6 +4192,69 @@ package body Trans.Chap7 is end if; end Translate_Overflow_Literal; + function Translate_Aggregate_Expression (Expr : Iir; Rtype : Iir) + return O_Enode + is + Expr_Type : constant Iir := Get_Type (Expr); + Aggr_Type : Iir; + Tinfo : Type_Info_Acc; + Bounds : Mnode; + Mres : Mnode; + Res : O_Enode; + begin + -- Extract the type of the aggregate. Use the type of the + -- context if it is fully constrained. + Aggr_Type := Expr_Type; + if Rtype /= Null_Iir + and then Is_Fully_Constrained_Type (Rtype) + then + Aggr_Type := Rtype; + end if; + + if Get_Constraint_State (Aggr_Type) /= Fully_Constrained then + Tinfo := Get_Info (Aggr_Type); + if Tinfo = null then + -- AGGR_TYPE may be a subtype that has not been + -- translated. Use the base type in that case. + Aggr_Type := Get_Base_Type (Aggr_Type); + Tinfo := Get_Info (Aggr_Type); + end if; + + Mres := Create_Temp (Tinfo); + 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 + 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); + Res := M2E (Mres); + + if Rtype /= Null_Iir and then Aggr_Type /= Rtype then + Res := Translate_Implicit_Conv + (Res, Aggr_Type, Rtype, Mode_Value, Expr); + end if; + return Res; + end Translate_Aggregate_Expression; + function Translate_Expression (Expr : Iir; Rtype : Iir := Null_Iir) return Mnode is @@ -4235,67 +4317,7 @@ package body Trans.Chap7 is if Get_Aggregate_Expand_Flag (Expr) then return Translate_Composite_Literal (Expr, Res_Type); else - declare - Aggr_Type : Iir; - Tinfo : Type_Info_Acc; - Bounds : Mnode; - Mres : Mnode; - begin - -- Extract the type of the aggregate. Use the type of the - -- context if it is fully constrained. - Aggr_Type := Expr_Type; - if Rtype /= Null_Iir - and then Is_Fully_Constrained_Type (Rtype) - then - Aggr_Type := Rtype; - end if; - - if Get_Constraint_State (Aggr_Type) /= Fully_Constrained - then - Tinfo := Get_Info (Aggr_Type); - if Tinfo = null then - -- AGGR_TYPE may be a subtype that has not been - -- translated. Use the base type in that case. - Aggr_Type := Get_Base_Type (Aggr_Type); - Tinfo := Get_Info (Aggr_Type); - end if; - - Mres := Create_Temp (Tinfo); - 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 - 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); - Res := M2E (Mres); - - if Rtype /= Null_Iir and then Aggr_Type /= Rtype then - Res := Translate_Implicit_Conv - (Res, Aggr_Type, Rtype, Mode_Value, Expr); - end if; - return Res; - end; + return Translate_Aggregate_Expression (Expr, Rtype); end if; when Iir_Kind_Null_Literal => diff --git a/src/vhdl/translate/trans-chap7.ads b/src/vhdl/translate/trans-chap7.ads index 3c1acdefa..5e52caebd 100644 --- a/src/vhdl/translate/trans-chap7.ads +++ b/src/vhdl/translate/trans-chap7.ads @@ -81,6 +81,10 @@ package Trans.Chap7 is (Expr : O_Enode; Expr_Type : Iir; Res_Type : Iir; Loc : Iir) return O_Enode; + -- Subtype conversions. + procedure Convert_Constrained_To_Unconstrained + (Res : in out Mnode; Expr : Mnode); + -- Convert bounds SRC (of type SRC_TYPE) to RES (of type RES_TYPE). procedure Translate_Type_Conversion_Bounds (Res : Mnode; Src : Mnode; Res_Type : Iir; Src_Type : Iir; Loc : Iir); diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb index 65b559963..539002dc4 100644 --- a/src/vhdl/translate/trans-chap8.adb +++ b/src/vhdl/translate/trans-chap8.adb @@ -1350,7 +1350,7 @@ package body Trans.Chap8 is begin New_Assign_Stmt (New_Selected_Element (New_Obj (Val_Node), Tinfo.B.Base_Field (Mode_Value)), - Val); + New_Convert (Val, Tinfo.B.Base_Ptr_Type (Mode_Value))); Func_Info := Get_Info (Func); Start_Association (Assoc, Func_Info.Operator_Node); Subprgs.Add_Subprg_Instance_Assoc (Assoc, Func_Info.Operator_Instance); diff --git a/src/vhdl/translate/trans-helpers2.adb b/src/vhdl/translate/trans-helpers2.adb index 22ea225d3..a773fa7aa 100644 --- a/src/vhdl/translate/trans-helpers2.adb +++ b/src/vhdl/translate/trans-helpers2.adb @@ -235,7 +235,7 @@ package body Trans.Helpers2 is case Type_Info.Type_Mode is when Type_Mode_Arrays => Res := Chap3.Get_Composite_Base (Res); - Res := Chap3.Convert_Array_Base (Res); + -- Res := Chap3.Convert_Array_Base (Res); when Type_Mode_Records => Res := Stabilize (Res); when others => diff --git a/src/vhdl/translate/trans-rtis.adb b/src/vhdl/translate/trans-rtis.adb index d52a025db..acd890548 100644 --- a/src/vhdl/translate/trans-rtis.adb +++ b/src/vhdl/translate/trans-rtis.adb @@ -286,8 +286,8 @@ package body Trans.Rtis is Ghdl_Rtik_Subtype_Array); New_Enum_Literal (Constr, - Get_Identifier ("__ghdl_rtik_subtype_unconstrained_array"), - Ghdl_Rtik_Subtype_Unconstrained_Array); + Get_Identifier ("__ghdl_rtik_subtype_unbounded_array"), + Ghdl_Rtik_Subtype_Unbounded_Array); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_subtype_record"), Ghdl_Rtik_Subtype_Record); @@ -1550,7 +1550,7 @@ package body Trans.Rtis is when Type_Mode_Bounded_Arrays => Kind := Ghdl_Rtik_Subtype_Array; when Type_Mode_Unbounded_Array => - Kind := Ghdl_Rtik_Subtype_Unconstrained_Array; + Kind := Ghdl_Rtik_Subtype_Unbounded_Array; when Type_Mode_Bounded_Records => Kind := Ghdl_Rtik_Subtype_Record; when Type_Mode_Unbounded_Record => diff --git a/src/vhdl/translate/trans-rtis.ads b/src/vhdl/translate/trans-rtis.ads index 1e4dd36ef..ebc878d62 100644 --- a/src/vhdl/translate/trans-rtis.ads +++ b/src/vhdl/translate/trans-rtis.ads @@ -58,7 +58,7 @@ package Trans.Rtis is Ghdl_Rtik_Type_File : O_Cnode; Ghdl_Rtik_Subtype_Scalar : O_Cnode; Ghdl_Rtik_Subtype_Array : O_Cnode; - Ghdl_Rtik_Subtype_Unconstrained_Array : O_Cnode; + Ghdl_Rtik_Subtype_Unbounded_Array : O_Cnode; Ghdl_Rtik_Subtype_Record : O_Cnode; Ghdl_Rtik_Subtype_Unbounded_Record : O_Cnode; Ghdl_Rtik_Subtype_Access : O_Cnode; diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads index 9546521e4..f36867e57 100644 --- a/src/vhdl/translate/trans.ads +++ b/src/vhdl/translate/trans.ads @@ -812,201 +812,6 @@ package Trans is function Align_Val (Algn : Alignment_Type) return O_Cnode; - type Ortho_Info_Basetype_Type - (Kind : Ortho_Info_Type_Kind := Kind_Type_Scalar) is record - -- For all types: - -- This is the maximum depth of RTI, that is the max of the depth of - -- the type itself and every types it depends on. - Rti_Max_Depth : Rti_Depth_Type; - - Align : Alignment_Type; - - case Kind is - when Kind_Type_Scalar => - -- For scalar types: - -- Ortho type for the range record type. - Range_Type : O_Tnode; - - -- Ortho type for an access to the range record type. - Range_Ptr_Type : O_Tnode; - - -- Fields of TYPE_RANGE_TYPE. - Range_Left : O_Fnode; - Range_Right : O_Fnode; - Range_Dir : O_Fnode; - Range_Length : O_Fnode; - - when Kind_Type_Array - | Kind_Type_Record => - -- For unbounded types: - -- The base type. - Base_Type : O_Tnode_Array; - Base_Ptr_Type : O_Tnode_Array; - -- The dope vector. - -- For arrays: - -- range of indexes - -- layout of element (if element is unbounded) - -- For record: - -- offsets of complex elements - -- layout of unbounded elements - Bounds_Type : O_Tnode; - Bounds_Ptr_Type : O_Tnode; - - -- For arrays with unbounded element, the layout field of the - -- bounds type. - Bounds_El : O_Fnode; - - -- Size + bounds. - -- Always created for arrays, created for unbounded and complex - -- records. - Layout_Type : O_Tnode; - Layout_Ptr_Type : O_Tnode; - - -- Size and bounds fields of the layout type. - Layout_Size : O_Fnode; - Layout_Bounds : O_Fnode; - - -- The ortho type is a fat pointer to the base and the bounds. - -- These are the fields of the fat pointer. - Base_Field : O_Fnode_Array; - Bounds_Field : O_Fnode_Array; - - -- Parameters for type builders. - -- NOTE: this is only set for types (and *not* for subtypes). - Builder : Complex_Type_Arr_Info; - - when Kind_Type_File => - -- Constant containing the signature of the file. - File_Signature : O_Dnode; - - when Kind_Type_Protected => - Prot_Scope : aliased Var_Scope_Type; - Prot_Prev_Scope : Var_Scope_Acc; - - -- Init procedure for the protected type. - Prot_Init_Subprg : O_Dnode; - Prot_Init_Instance : Subprgs.Subprg_Instance_Type; - -- Final procedure. - Prot_Final_Subprg : O_Dnode; - Prot_Final_Instance : Subprgs.Subprg_Instance_Type; - -- The outer instance, if any. - Prot_Subprg_Instance_Field : O_Fnode; - -- The LOCK field in the object type - Prot_Lock_Field : O_Fnode; - end case; - end record; - - type Ortho_Info_Subtype_Type - (Kind : Ortho_Info_Type_Kind := Kind_Type_Scalar) is record - case Kind is - when Kind_Type_Scalar => - -- For scalar types: - -- True if no need to check against low/high bound. - Nocheck_Low : Boolean := False; - Nocheck_Hi : Boolean := False; - - -- For scalar types: - -- Range_Var is the same as its type mark (there is no need to - -- create a new range var if the range is the same). - Same_Range : Boolean := False; - - -- Tree for the range record declaration. - Range_Var : Var_Type := Null_Var; - - when Kind_Type_Array - | Kind_Type_Record => - -- Variable containing the layout for a constrained type. - Composite_Layout : Var_Type; - - -- For a locally constrained record subtype whose base type has - -- unbounded elements: the field containing the base record. - Box_Field : O_Fnode_Array; - - when Kind_Type_File => - null; - - when Kind_Type_Protected => - null; - end case; - end record; - - -- Ortho_Info_Type_Scalar_Init : constant Ortho_Info_Type_Type := - -- (Kind => Kind_Type_Scalar, - -- Range_Type => O_Tnode_Null, - -- Range_Ptr_Type => O_Tnode_Null, - -- Range_Var => null, - -- Range_Left => O_Fnode_Null, - -- Range_Right => O_Fnode_Null, - -- Range_Dir => O_Fnode_Null, - -- Range_Length => O_Fnode_Null); - - Ortho_Info_Basetype_Array_Init : constant Ortho_Info_Basetype_Type := - (Kind => Kind_Type_Array, - Rti_Max_Depth => 0, - Align => Align_Undef, - Base_Type => (O_Tnode_Null, O_Tnode_Null), - Base_Ptr_Type => (O_Tnode_Null, O_Tnode_Null), - Bounds_Type => O_Tnode_Null, - Bounds_Ptr_Type => O_Tnode_Null, - Bounds_El => O_Fnode_Null, - Layout_Type => O_Tnode_Null, - Layout_Ptr_Type => O_Tnode_Null, - Layout_Size => O_Fnode_Null, - Layout_Bounds => O_Fnode_Null, - Base_Field => (O_Fnode_Null, O_Fnode_Null), - Bounds_Field => (O_Fnode_Null, O_Fnode_Null), - Builder => (others => (Builder_Instance => Subprgs.Null_Subprg_Instance, - Builder_Layout_Param => O_Dnode_Null, - Builder_Proc => O_Dnode_Null))); - - Ortho_Info_Subtype_Array_Init : constant Ortho_Info_Subtype_Type := - (Kind => Kind_Type_Array, - Composite_Layout => Null_Var, - Box_Field => (O_Fnode_Null, O_Fnode_Null)); - - Ortho_Info_Basetype_Record_Init : constant Ortho_Info_Basetype_Type := - (Kind => Kind_Type_Record, - Rti_Max_Depth => 0, - Align => Align_Undef, - Base_Type => (O_Tnode_Null, O_Tnode_Null), - Base_Ptr_Type => (O_Tnode_Null, O_Tnode_Null), - Bounds_Type => O_Tnode_Null, - Bounds_Ptr_Type => O_Tnode_Null, - Bounds_El => O_Fnode_Null, - Layout_Type => O_Tnode_Null, - Layout_Ptr_Type => O_Tnode_Null, - Layout_Size => O_Fnode_Null, - Layout_Bounds => O_Fnode_Null, - Base_Field => (O_Fnode_Null, O_Fnode_Null), - Bounds_Field => (O_Fnode_Null, O_Fnode_Null), - Builder => (others => (Builder_Instance => Subprgs.Null_Subprg_Instance, - Builder_Layout_Param => O_Dnode_Null, - Builder_Proc => O_Dnode_Null))); - - Ortho_Info_Subtype_Record_Init : constant Ortho_Info_Subtype_Type := - (Kind => Kind_Type_Record, - Composite_Layout => Null_Var, - Box_Field => (O_Fnode_Null, O_Fnode_Null)); - - Ortho_Info_Basetype_File_Init : constant Ortho_Info_Basetype_Type := - (Kind => Kind_Type_File, - Rti_Max_Depth => 0, - Align => Align_Undef, - File_Signature => O_Dnode_Null); - - Ortho_Info_Basetype_Prot_Init : constant Ortho_Info_Basetype_Type := - (Kind => Kind_Type_Protected, - Rti_Max_Depth => 0, - Align => Align_Undef, - Prot_Scope => Null_Var_Scope, - Prot_Prev_Scope => null, - Prot_Init_Subprg => O_Dnode_Null, - Prot_Init_Instance => Subprgs.Null_Subprg_Instance, - Prot_Final_Subprg => O_Dnode_Null, - Prot_Subprg_Instance_Field => O_Fnode_Null, - Prot_Final_Instance => Subprgs.Null_Subprg_Instance, - Prot_Lock_Field => O_Fnode_Null); - -- Mode of the type; roughly speaking, this corresponds to its size -- (for scalars) or its layout (for composite types). -- Used to select library subprograms for signals. @@ -1449,6 +1254,220 @@ package Trans is type Hexstr_Type is array (Integer range 0 .. 15) of Character; N2hex : constant Hexstr_Type := "0123456789abcdef"; + type Ortho_Info_Basetype_Type + (Kind : Ortho_Info_Type_Kind := Kind_Type_Scalar) is record + -- For all types: + -- This is the maximum depth of RTI, that is the max of the depth of + -- the type itself and every types it depends on. + Rti_Max_Depth : Rti_Depth_Type; + + Align : Alignment_Type; + + case Kind is + when Kind_Type_Scalar => + -- For scalar types: + -- Ortho type for the range record type. + Range_Type : O_Tnode; + + -- Ortho type for an access to the range record type. + Range_Ptr_Type : O_Tnode; + + -- Fields of TYPE_RANGE_TYPE. + Range_Left : O_Fnode; + Range_Right : O_Fnode; + Range_Dir : O_Fnode; + Range_Length : O_Fnode; + + when Kind_Type_Array + | Kind_Type_Record => + -- For unbounded types: + -- The base type. + Base_Type : O_Tnode_Array; + Base_Ptr_Type : O_Tnode_Array; + -- The dope vector. + -- For arrays: + -- range of indexes + -- layout of element (if element is unbounded) + -- For record: + -- offsets of complex elements + -- layout of unbounded elements + Bounds_Type : O_Tnode; + Bounds_Ptr_Type : O_Tnode; + + -- For arrays with unbounded element, the layout field of the + -- bounds type. + Bounds_El : O_Fnode; + + -- Size + bounds. + -- Always created for arrays, created for unbounded and complex + -- records. + Layout_Type : O_Tnode; + Layout_Ptr_Type : O_Tnode; + + -- Size and bounds fields of the layout type. + Layout_Size : O_Fnode; + Layout_Bounds : O_Fnode; + + -- The ortho type is a fat pointer to the base and the bounds. + -- These are the fields of the fat pointer. + Base_Field : O_Fnode_Array; + Bounds_Field : O_Fnode_Array; + + -- Parameters for type builders. + -- NOTE: this is only set for types (and *not* for subtypes). + Builder : Complex_Type_Arr_Info; + + when Kind_Type_File => + -- Constant containing the signature of the file. + File_Signature : O_Dnode; + + when Kind_Type_Protected => + Prot_Scope : aliased Var_Scope_Type; + Prot_Prev_Scope : Var_Scope_Acc; + + -- Init procedure for the protected type. + Prot_Init_Subprg : O_Dnode; + Prot_Init_Instance : Subprgs.Subprg_Instance_Type; + -- Final procedure. + Prot_Final_Subprg : O_Dnode; + Prot_Final_Instance : Subprgs.Subprg_Instance_Type; + -- The outer instance, if any. + Prot_Subprg_Instance_Field : O_Fnode; + -- The LOCK field in the object type + Prot_Lock_Field : O_Fnode; + end case; + end record; + + type Subtype_Fields_Type is record + Tinfo : Type_Info_Acc; + Fields : O_Fnode_Array; + end record; + + Subtype_Fields_Null : constant Subtype_Fields_Type := + (Tinfo => null, Fields => (others => O_Fnode_Null)); + + type Subtype_Fields_Array is + array (Iir_Index32 range <>) of Subtype_Fields_Type; + type Subtype_Fields_Array_Acc is access Subtype_Fields_Array; + + type Ortho_Info_Subtype_Type + (Kind : Ortho_Info_Type_Kind := Kind_Type_Scalar) is record + case Kind is + when Kind_Type_Scalar => + -- For scalar types: + -- True if no need to check against low/high bound. + Nocheck_Low : Boolean := False; + Nocheck_Hi : Boolean := False; + + -- For scalar types: + -- Range_Var is the same as its type mark (there is no need to + -- create a new range var if the range is the same). + Same_Range : Boolean := False; + + -- Tree for the range record declaration. + Range_Var : Var_Type := Null_Var; + + when Kind_Type_Array + | Kind_Type_Record => + -- Variable containing the layout for a constrained type. + Composite_Layout : Var_Type; + + Subtype_Owner : Type_Info_Acc := null; + Owner_Field : Field_Info_Acc := null; + + -- For static record subtype: the fields of the constraints. + Rec_Fields : Subtype_Fields_Array_Acc; + + when Kind_Type_File => + null; + + when Kind_Type_Protected => + null; + end case; + end record; + + -- Ortho_Info_Type_Scalar_Init : constant Ortho_Info_Type_Type := + -- (Kind => Kind_Type_Scalar, + -- Range_Type => O_Tnode_Null, + -- Range_Ptr_Type => O_Tnode_Null, + -- Range_Var => null, + -- Range_Left => O_Fnode_Null, + -- Range_Right => O_Fnode_Null, + -- Range_Dir => O_Fnode_Null, + -- Range_Length => O_Fnode_Null); + + Ortho_Info_Basetype_Array_Init : constant Ortho_Info_Basetype_Type := + (Kind => Kind_Type_Array, + Rti_Max_Depth => 0, + Align => Align_Undef, + Base_Type => (O_Tnode_Null, O_Tnode_Null), + Base_Ptr_Type => (O_Tnode_Null, O_Tnode_Null), + Bounds_Type => O_Tnode_Null, + Bounds_Ptr_Type => O_Tnode_Null, + Bounds_El => O_Fnode_Null, + Layout_Type => O_Tnode_Null, + Layout_Ptr_Type => O_Tnode_Null, + Layout_Size => O_Fnode_Null, + Layout_Bounds => O_Fnode_Null, + Base_Field => (O_Fnode_Null, O_Fnode_Null), + Bounds_Field => (O_Fnode_Null, O_Fnode_Null), + Builder => (others => (Builder_Instance => Subprgs.Null_Subprg_Instance, + Builder_Layout_Param => O_Dnode_Null, + Builder_Proc => O_Dnode_Null))); + + Ortho_Info_Subtype_Array_Init : constant Ortho_Info_Subtype_Type := + (Kind => Kind_Type_Array, + Composite_Layout => Null_Var, + Subtype_Owner => null, + Owner_Field => null, + Rec_Fields => null); + + Ortho_Info_Basetype_Record_Init : constant Ortho_Info_Basetype_Type := + (Kind => Kind_Type_Record, + Rti_Max_Depth => 0, + Align => Align_Undef, + Base_Type => (O_Tnode_Null, O_Tnode_Null), + Base_Ptr_Type => (O_Tnode_Null, O_Tnode_Null), + Bounds_Type => O_Tnode_Null, + Bounds_Ptr_Type => O_Tnode_Null, + Bounds_El => O_Fnode_Null, + Layout_Type => O_Tnode_Null, + Layout_Ptr_Type => O_Tnode_Null, + Layout_Size => O_Fnode_Null, + Layout_Bounds => O_Fnode_Null, + Base_Field => (O_Fnode_Null, O_Fnode_Null), + Bounds_Field => (O_Fnode_Null, O_Fnode_Null), + Builder => (others => (Builder_Instance => Subprgs.Null_Subprg_Instance, + Builder_Layout_Param => O_Dnode_Null, + Builder_Proc => O_Dnode_Null))); + + Ortho_Info_Subtype_Record_Init : constant Ortho_Info_Subtype_Type := + (Kind => Kind_Type_Record, + Composite_Layout => Null_Var, + Subtype_Owner => null, + Owner_Field => null, + Rec_Fields => null); + + Ortho_Info_Basetype_File_Init : constant Ortho_Info_Basetype_Type := + (Kind => Kind_Type_File, + Rti_Max_Depth => 0, + Align => Align_Undef, + File_Signature => O_Dnode_Null); + + Ortho_Info_Basetype_Prot_Init : constant Ortho_Info_Basetype_Type := + (Kind => Kind_Type_Protected, + Rti_Max_Depth => 0, + Align => Align_Undef, + Prot_Scope => Null_Var_Scope, + Prot_Prev_Scope => null, + Prot_Init_Subprg => O_Dnode_Null, + Prot_Init_Instance => Subprgs.Null_Subprg_Instance, + Prot_Final_Subprg => O_Dnode_Null, + Prot_Subprg_Instance_Field => O_Fnode_Null, + Prot_Final_Instance => Subprgs.Null_Subprg_Instance, + Prot_Lock_Field => O_Fnode_Null); + + -- In order to unify and have a common handling of Enode/Lnode/Dnode, -- let's introduce Mnode (yes, another node). -- @@ -1689,7 +1708,7 @@ package Trans is -- bounded record (complex or not) -> record -- constrained non-complex array -> constrained array -- constrained complex array -> the element - -- unboubded array or record -> fat pointer + -- unbounded array or record -> fat pointer -- access to unconstrained array -> fat pointer -- access (others) -> access -- file -> file_index_type diff --git a/src/vhdl/vhdl-nodes.ads b/src/vhdl/vhdl-nodes.ads index a7ea499f3..aa90a7c4d 100644 --- a/src/vhdl/vhdl-nodes.ads +++ b/src/vhdl/vhdl-nodes.ads @@ -2911,6 +2911,9 @@ package Vhdl.Nodes is -- index subtypes of the type_mark. -- Get/Set_Index_Subtype_List (Field9) -- + -- Set when the element is re-constrained. + -- Note that the element subtype may be different from the parent also if + -- it is resolved. This is mostly for ownership. -- Get/Set_Array_Element_Constraint (Field8) -- -- Get/Set_Tolerance (Field7) diff --git a/src/vhdl/vhdl-sem_expr.adb b/src/vhdl/vhdl-sem_expr.adb index 07da48d8d..0e6d17509 100644 --- a/src/vhdl/vhdl-sem_expr.adb +++ b/src/vhdl/vhdl-sem_expr.adb @@ -3240,6 +3240,7 @@ package body Vhdl.Sem_Expr is Rec_El : Iir; Rec_El_Type : Iir; New_Rec_El : Iir; + Assoc_Expr : Iir; Constraint : Iir_Constraint; Composite_Found : Boolean; Staticness : Iir_Staticness; @@ -3251,7 +3252,8 @@ package body Vhdl.Sem_Expr is Staticness := Locally; for I in Flist_First .. Flist_Last (El_List) loop El := Matches (I); - El_Type := Get_Type (Get_Associated_Expr (El)); + Assoc_Expr := Get_Associated_Expr (El); + El_Type := Get_Type (Assoc_Expr); Rec_El := Get_Nth_Element (Rec_El_List, I); Rec_El_Type := Get_Type (Rec_El); if Is_Fully_Constrained_Type (El_Type) @@ -4028,7 +4030,7 @@ package body Vhdl.Sem_Expr is -- Analyze aggregate EXPR whose type is expected to be A_TYPE. -- A_TYPE cannot be null_iir (this case is handled in sem_expression_ov) - -- If FORCE_CONSTRAINED is true, the aggregate type is constrained by the + -- If CONSTRAINED is true, the aggregate type is constrained by the -- context, even if its type isn't. This is to deal with cases like: -- procedure set (v : out string) is -- begin |