From 722ea848fd2b382d9d14dcaf49e4bd95182b56f9 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Fri, 3 May 2019 06:37:39 +0200 Subject: vhdl/translate: check_composite_match: rename and handle records. Fix #807 --- src/vhdl/translate/trans-chap3.adb | 226 +++++++++++++++++++++++++++++-------- 1 file changed, 181 insertions(+), 45 deletions(-) (limited to 'src/vhdl/translate/trans-chap3.adb') diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb index a7985f6cd..7556f2b23 100644 --- a/src/vhdl/translate/trans-chap3.adb +++ b/src/vhdl/translate/trans-chap3.adb @@ -3422,7 +3422,10 @@ package body Trans.Chap3 is end if; end Maybe_Insert_Scalar_Check; - function Locally_Array_Match (L_Type, R_Type : Iir) return Boolean + function Locally_Types_Match (L_Type : Iir; R_Type : Iir) + return Tri_State_Type; + + function Locally_Array_Match (L_Type, R_Type : Iir) return Tri_State_Type is L_Indexes : constant Iir_Flist := Get_Index_Subtype_List (L_Type); R_Indexes : constant Iir_Flist := Get_Index_Subtype_List (R_Type); @@ -3432,64 +3435,197 @@ package body Trans.Chap3 is for I in Flist_First .. Flist_Last (L_Indexes) loop L_El := Get_Index_Type (L_Indexes, I); R_El := Get_Index_Type (R_Indexes, I); + if Get_Type_Staticness (L_El) /= Locally + or else Get_Type_Staticness (R_El) /= Locally + then + return Unknown; + end if; if Eval_Discrete_Type_Length (L_El) /= Eval_Discrete_Type_Length (R_El) then return False; end if; end loop; - return True; + return Locally_Types_Match (Get_Element_Subtype (L_Type), + Get_Element_Subtype (R_Type)); end Locally_Array_Match; - procedure Check_Array_Match (L_Type : Iir; - L_Node : Mnode; - R_Type : Iir; - R_Node : Mnode; - Loc : Iir) - is - L_Tinfo : constant Type_Info_Acc := Get_Info (L_Type); - R_Tinfo : constant Type_Info_Acc := Get_Info (R_Type); + function Locally_Record_Match (L_Type : Iir; R_Type : Iir) + return Tri_State_Type + is + L_List : constant Iir_Flist := Get_Elements_Declaration_List (L_Type); + R_List : constant Iir_Flist := Get_Elements_Declaration_List (R_Type); + Res : Tri_State_Type; + begin + Res := True; + for I in Flist_First .. Flist_Last (L_List) loop + case Locally_Types_Match (Get_Type (Get_Nth_Element (L_List, I)), + Get_Type (Get_Nth_Element (R_List, I))) is + when False => + return False; + when True => + null; + when Unknown => + Res := Unknown; + end case; + end loop; + return Res; + end Locally_Record_Match; + + -- Return True IFF locally static types L_TYPE and R_TYPE matches. + function Locally_Types_Match (L_Type : Iir; R_Type : Iir) + return Tri_State_Type is begin - if L_Tinfo.Type_Mode not in Type_Mode_Arrays then - return; + if L_Type = R_Type then + return True; + end if; + case Get_Kind (L_Type) is + when Iir_Kind_Array_Subtype_Definition => + return Locally_Array_Match (L_Type, R_Type); + when Iir_Kind_Record_Subtype_Definition + | Iir_Kind_Record_Type_Definition => + return Locally_Record_Match (L_Type, R_Type); + when Iir_Kinds_Scalar_Type_And_Subtype_Definition => + return True; + when Iir_Kind_Access_Type_Definition + | Iir_Kind_Access_Subtype_Definition => + return True; + when others => + Error_Kind ("locally_types_match", L_Type); + end case; + end Locally_Types_Match; + + function Types_Match (L_Type : Iir; R_Type : Iir) return Tri_State_Type is + begin + if Get_Kind (L_Type) not in Iir_Kinds_Composite_Type_Definition then + return True; end if; - -- FIXME: optimize for a statically bounded array of a complex type. - if L_Tinfo.Type_Mode in Type_Mode_Arrays - and then L_Tinfo.Type_Locally_Constrained - and then R_Tinfo.Type_Mode in Type_Mode_Arrays - and then R_Tinfo.Type_Locally_Constrained + if Get_Constraint_State (L_Type) /= Fully_Constrained + or else Get_Constraint_State (R_Type) /= Fully_Constrained then - -- Both left and right are thin array. - -- Check here the length are the same. - if not Locally_Array_Match (L_Type, R_Type) then - Chap6.Gen_Bound_Error (Loc); - end if; - else - -- Check length match. - declare - Index_List : constant Iir_Flist := - Get_Index_Subtype_List (L_Type); - Cond : O_Enode; - Sub_Cond : O_Enode; - begin - for I in 1 .. Get_Nbr_Elements (Index_List) loop - Sub_Cond := New_Compare_Op - (ON_Neq, - M2E (Range_To_Length - (Get_Array_Range (L_Node, L_Type, I))), - M2E (Range_To_Length - (Get_Array_Range (R_Node, R_Type, I))), - Ghdl_Bool_Type); - if I = 1 then - Cond := Sub_Cond; + -- If one of the type is not fully constrained, the check is dynamic. + return Unknown; + end if; + if L_Type = R_Type then + -- If the type is the same, they match (they are constrained). + return True; + end if; + -- We cannot use type staticness, as a record may not be locally static + -- because it has one scalar element with non-locally static bounds. + return Locally_Types_Match (L_Type, R_Type); + end Types_Match; + + function Check_Match_Cond (L_Type : Iir; + L_Bounds : Mnode; + R_Type : Iir; + R_Bounds : Mnode) return O_Enode is + begin + case Iir_Kinds_Composite_Type_Definition (Get_Kind (L_Type)) is + when Iir_Kinds_Array_Type_Definition => + -- Check length match. + declare + Index_List : constant Iir_Flist := + Get_Index_Subtype_List (L_Type); + Nbr_Dim : constant Natural := Get_Nbr_Elements (Index_List); + L_El : constant Iir := Get_Element_Subtype (L_Type); + R_El : constant Iir := Get_Element_Subtype (R_Type); + El_Match : Tri_State_Type; + Cond : O_Enode; + Sub_Cond : O_Enode; + L_Bounds1 : Mnode; + R_Bounds1 : Mnode; + begin + -- FIXME: stabilize. + El_Match := Types_Match (L_El, R_El); + if El_Match = Unknown or Nbr_Dim > 1 then + L_Bounds1 := Stabilize (L_Bounds); + R_Bounds1 := Stabilize (R_Bounds); else + L_Bounds1 := L_Bounds; + R_Bounds1 := R_Bounds; + end if; + + for I in 1 .. Nbr_Dim loop + Sub_Cond := New_Compare_Op + (ON_Neq, + M2E (Range_To_Length + (Bounds_To_Range (L_Bounds1, L_Type, I))), + M2E (Range_To_Length + (Bounds_To_Range (R_Bounds1, R_Type, I))), + Ghdl_Bool_Type); + if I = 1 then + Cond := Sub_Cond; + else + Cond := New_Dyadic_Op (ON_Or, Cond, Sub_Cond); + end if; + end loop; + if El_Match = Unknown then + Sub_Cond := Check_Match_Cond + (L_El, Array_Bounds_To_Element_Bounds (L_Bounds1, L_Type), + R_El, Array_Bounds_To_Element_Bounds (R_Bounds1, R_Type)); Cond := New_Dyadic_Op (ON_Or, Cond, Sub_Cond); end if; - end loop; - Chap6.Check_Bound_Error (Cond, Loc, 0); - end; - end if; - end Check_Array_Match; + return Cond; + end; + when Iir_Kind_Record_Type_Definition + | Iir_Kind_Record_Subtype_Definition => + declare + L_El_List : constant Iir_Flist := + Get_Elements_Declaration_List (L_Type); + R_El_List : constant Iir_Flist := + Get_Elements_Declaration_List (R_Type); + Cond : O_Enode; + Sub_Cond : O_Enode; + begin + Cond := O_Enode_Null; + for I in Flist_First .. Flist_Last (L_El_List) loop + declare + L_El : constant Iir := Get_Nth_Element (L_El_List, I); + R_El : constant Iir := Get_Nth_Element (R_El_List, I); + L_El_Type : constant Iir := Get_Type (L_El); + R_El_Type : constant Iir := Get_Type (R_El); + begin + if Types_Match (L_El_Type, R_El_Type) = Unknown then + Sub_Cond := Check_Match_Cond + (L_El_Type, + Record_Bounds_To_Element_Bounds (L_Bounds, L_El), + R_El_Type, + Record_Bounds_To_Element_Bounds (R_Bounds, R_El)); + if Cond = O_Enode_Null then + Cond := Sub_Cond; + else + Cond := New_Dyadic_Op (ON_Or, Cond, Sub_Cond); + end if; + end if; + end; + end loop; + pragma Assert (Cond /= O_Enode_Null); + return Cond; + end; + end case; + end Check_Match_Cond; + + procedure Check_Composite_Match (L_Type : Iir; + L_Node : Mnode; + R_Type : Iir; + R_Node : Mnode; + Loc : Iir) + is + Res : O_Enode; + begin + case Types_Match (L_Type, R_Type) is + when True => + return; + when False => + -- FIXME: emit a warning ? + Chap6.Gen_Bound_Error (Loc); + return; + when Unknown => + Res := Check_Match_Cond (L_Type, Get_Composite_Bounds (L_Node), + R_Type, Get_Composite_Bounds (R_Node)); + Chap6.Check_Bound_Error (Res, Loc, 0); + end case; + end Check_Composite_Match; procedure Create_Range_From_Array_Attribute_And_Length (Array_Attr : Iir; Length : O_Dnode; Res : Mnode) -- cgit v1.2.3