aboutsummaryrefslogtreecommitdiffstats
path: root/src/vhdl
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2020-07-25 09:04:10 +0200
committerTristan Gingold <tgingold@free.fr>2020-07-25 11:28:51 +0200
commit2f37e351d2008e7b5be7a975dc34fe3485809a62 (patch)
tree5edbcb824862ddc40ce8816705a1c6c88b262617 /src/vhdl
parent0795210282e6ddb6190a4a16bca73aad18717cb7 (diff)
downloadghdl-2f37e351d2008e7b5be7a975dc34fe3485809a62.tar.gz
ghdl-2f37e351d2008e7b5be7a975dc34fe3485809a62.tar.bz2
ghdl-2f37e351d2008e7b5be7a975dc34fe3485809a62.zip
translate: improve support of unbounded records and arrays.
Diffstat (limited to 'src/vhdl')
-rw-r--r--src/vhdl/translate/trans-chap3.adb852
-rw-r--r--src/vhdl/translate/trans-chap4.adb9
-rw-r--r--src/vhdl/translate/trans-chap5.adb11
-rw-r--r--src/vhdl/translate/trans-chap6.adb122
-rw-r--r--src/vhdl/translate/trans-chap7.adb226
-rw-r--r--src/vhdl/translate/trans-chap7.ads4
-rw-r--r--src/vhdl/translate/trans-chap8.adb2
-rw-r--r--src/vhdl/translate/trans-helpers2.adb2
-rw-r--r--src/vhdl/translate/trans-rtis.adb6
-rw-r--r--src/vhdl/translate/trans-rtis.ads2
-rw-r--r--src/vhdl/translate/trans.ads411
-rw-r--r--src/vhdl/vhdl-nodes.ads3
-rw-r--r--src/vhdl/vhdl-sem_expr.adb6
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-23 19:58:19 +0000