diff options
-rw-r--r-- | src/vhdl/iirs.ads | 4 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap3.adb | 226 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap3.ads | 14 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap4.adb | 6 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap5.adb | 7 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap7.adb | 16 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap8.adb | 8 |
7 files changed, 211 insertions, 70 deletions
diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads index 4add8dd6e..04e410815 100644 --- a/src/vhdl/iirs.ads +++ b/src/vhdl/iirs.ads @@ -5068,6 +5068,10 @@ package Iirs is --Iir_Kind_Array_Subtype_Definition Iir_Kind_Record_Subtype_Definition; + subtype Iir_Kinds_Composite_Subtype_Definition is Iir_Kind range + Iir_Kind_Array_Subtype_Definition .. + Iir_Kind_Record_Subtype_Definition; + subtype Iir_Kinds_Type_Declaration is Iir_Kind range Iir_Kind_Type_Declaration .. --Iir_Kind_Anonymous_Type_Declaration 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) diff --git a/src/vhdl/translate/trans-chap3.ads b/src/vhdl/translate/trans-chap3.ads index ceb255d58..754705533 100644 --- a/src/vhdl/translate/trans-chap3.ads +++ b/src/vhdl/translate/trans-chap3.ads @@ -317,15 +317,15 @@ package Trans.Chap3 is (Value : O_Enode; Expr : Iir; Atype : Iir) return O_Enode; -- Return True iff all indexes of L_TYPE and R_TYPE have the same - -- length. They must be locally static. - function Locally_Array_Match (L_Type, R_Type : Iir) return Boolean; + -- length. They must be constrained. + function Locally_Array_Match (L_Type, R_Type : Iir) return Tri_State_Type; - -- Check bounds length of L match bounds length of R. - -- If L_TYPE (resp. R_TYPE) is not a thin array, then L_NODE + -- Check bounds of L match bounds of R. + -- If L_TYPE (resp. R_TYPE) is not a thin composite type, then L_NODE -- (resp. R_NODE) are not used (and may be Mnode_Null). - -- If L_TYPE (resp. T_TYPE) is a fat array, then L_NODE (resp. R_NODE) - -- must designate the array. - procedure Check_Array_Match + -- If L_TYPE (resp. T_TYPE) is a fat type, then L_NODE (resp. R_NODE) + -- must designate the object. + procedure Check_Composite_Match (L_Type : Iir; L_Node : Mnode; R_Type : Iir; R_Node : Mnode; Loc : Iir); -- Create a subtype range to be stored into RES from length LENGTH, which diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb index 11c5f1a8c..cdd424cc9 100644 --- a/src/vhdl/translate/trans-chap4.adb +++ b/src/vhdl/translate/trans-chap4.adb @@ -1692,8 +1692,9 @@ package body Trans.Chap4 is Stabilize (N); New_Assign_Stmt (Get_Var (A), M2E (Chap3.Get_Composite_Base (N))); - Chap3.Check_Array_Match (Decl_Type, T2M (Decl_Type, Mode), - Name_Type, N, Decl); + Chap3.Check_Composite_Match + (Decl_Type, T2M (Decl_Type, Mode), + Name_Type, N, Decl); when Type_Mode_Acc | Type_Mode_Bounds_Acc => New_Assign_Stmt (Get_Var (A), M2Addr (N)); @@ -1706,6 +1707,7 @@ package body Trans.Chap4 is end case; when Type_Mode_Bounded_Records => Stabilize (N); + -- FIXME: Check ? New_Assign_Stmt (Get_Var (A), M2Addr (N)); when others => raise Internal_Error; diff --git a/src/vhdl/translate/trans-chap5.adb b/src/vhdl/translate/trans-chap5.adb index cd02cf600..0b700189f 100644 --- a/src/vhdl/translate/trans-chap5.adb +++ b/src/vhdl/translate/trans-chap5.adb @@ -456,11 +456,12 @@ package body Trans.Chap5 is if Get_Kind (Formal_Type) in Iir_Kinds_Array_Type_Definition then -- Check length matches. + -- FIXME: records ? Stabilize (Formal_Sig); Stabilize (Actual_Sig); - Chap3.Check_Array_Match (Formal_Type, Formal_Sig, - Actual_Type, Actual_Sig, - Assoc); + Chap3.Check_Composite_Match (Formal_Type, Formal_Sig, + Actual_Type, Actual_Sig, + Assoc); end if; Data := (Actual_Sig => Actual_Sig, diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb index e594ec45a..e34c6f378 100644 --- a/src/vhdl/translate/trans-chap7.adb +++ b/src/vhdl/translate/trans-chap7.adb @@ -77,7 +77,7 @@ package body Trans.Chap7 is and then Get_Constraint_State (Res_Type) = Fully_Constrained then -- constrained to constrained. - if not Chap3.Locally_Array_Match (Expr_Type, Res_Type) then + if Chap3.Locally_Array_Match (Expr_Type, Res_Type) /= True then -- Sem should have replaced the expression by an overflow. raise Internal_Error; -- Chap6.Gen_Bound_Error (Loc); @@ -928,7 +928,7 @@ package body Trans.Chap7 is if Einfo.Type_Mode = Type_Mode_Static_Array then -- FIXME: optimize static vs non-static -- constrained to constrained. - if not Chap3.Locally_Array_Match (Expr_Type, Res_Type) then + if Chap3.Locally_Array_Match (Expr_Type, Res_Type) /= True then -- FIXME: generate a bound error ? -- Even if this is caught at compile-time, -- the code is not required to run. @@ -2769,7 +2769,8 @@ package body Trans.Chap7 is | Type_Mode_Bounds_Acc | Type_Mode_File => New_Assign_Stmt (M2Lv (Target), Val); - when Type_Mode_Unbounded_Array => + when Type_Mode_Unbounded_Array + | Type_Mode_Unbounded_Record => declare T : Mnode; E : O_Dnode; @@ -2779,7 +2780,7 @@ package body Trans.Chap7 is E := Create_Temp_Init (T_Info.Ortho_Ptr_Type (Mode_Value), Val); EM := Dp2M (E, T_Info, Mode_Value); - Chap3.Check_Array_Match + Chap3.Check_Composite_Match (Target_Type, T, Get_Type (Expr), EM, Loc); Chap3.Translate_Object_Copy (T, EM, Target_Type); end; @@ -2789,9 +2790,6 @@ package body Trans.Chap7 is -- necessary. Chap3.Translate_Object_Copy (Target, E2M (Val, T_Info, Mode_Value), Target_Type); - when Type_Mode_Unbounded_Record => - -- TODO - raise Internal_Error; when Type_Mode_Unknown | Type_Mode_Protected => raise Internal_Error; @@ -3886,7 +3884,7 @@ package body Trans.Chap7 is E := Stabilize (E2M (Expr, Expr_Info, Mode_Value)); case Res_Info.Type_Mode is when Type_Mode_Bounded_Arrays => - Chap3.Check_Array_Match + Chap3.Check_Composite_Match (Res_Type, T2M (Res_Type, Mode_Value), Expr_Type, E, Loc); @@ -3899,7 +3897,7 @@ package body Trans.Chap7 is begin Res := Create_Temp (Res_Info); Copy_Fat_Pointer (Res, E); - Chap3.Check_Array_Match (Res_Type, Res, Expr_Type, E, Loc); + Chap3.Check_Composite_Match (Res_Type, Res, Expr_Type, E, Loc); return M2Addr (Res); end; when others => diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb index bf0e83fc8..31c6803b5 100644 --- a/src/vhdl/translate/trans-chap8.adb +++ b/src/vhdl/translate/trans-chap8.adb @@ -4304,7 +4304,7 @@ package body Trans.Chap8 is if Is_Composite (Target_Tinfo) then Stabilize (Val); Stabilize (Stable_Targ); - Chap3.Check_Array_Match + Chap3.Check_Composite_Match (Target_Type, Stable_Targ, Get_Type (We), Val, We); end if; Arg := (Drv => Drv, @@ -4438,7 +4438,7 @@ package body Trans.Chap8 is then Stabilize (Targ2); Stabilize (Val); - Chap3.Check_Array_Match + Chap3.Check_Composite_Match (Target_Type, Targ2, Get_Type (Value), Val, Wf_Chain); end if; Gen_Simple_Signal_Assign (Targ2, Target_Type, M2E (Val)); @@ -4500,7 +4500,7 @@ package body Trans.Chap8 is Translate_Waveform_Expression (Value, Target_Type, Var_Targ, Val); Stabilize (Val); - Chap3.Check_Array_Match + Chap3.Check_Composite_Match (Target_Type, Var_Targ, Get_Type (Value), Val, We); end if; Data := Signal_Assign_Data'(Expr => Val, @@ -4532,7 +4532,7 @@ package body Trans.Chap8 is Val := Chap7.Translate_Expression (Value, Target_Type); if Is_Composite (Targ_Tinfo) then Stabilize (Val); - Chap3.Check_Array_Match + Chap3.Check_Composite_Match (Target_Type, Var_Targ, Get_Type (Value), Val, We); end if; end if; |