diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/vhdl/translate/trans-chap3.adb | 10 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap3.ads | 2 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap7.adb | 143 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap8.adb | 19 |
4 files changed, 160 insertions, 14 deletions
diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb index acc5d6537..442203e8e 100644 --- a/src/vhdl/translate/trans-chap3.adb +++ b/src/vhdl/translate/trans-chap3.adb @@ -3416,6 +3416,16 @@ package body Trans.Chap3 is Copy_Bounds (M2Addr (Dest), M2Addr (Src), Obj_Type); end Copy_Bounds; + procedure Copy_Range_No_Length (Dest : Mnode; Src : Mnode) is + begin + New_Assign_Stmt (M2Lv (Range_To_Left (Dest)), + M2E (Range_To_Left (Src))); + New_Assign_Stmt (M2Lv (Range_To_Right (Dest)), + M2E (Range_To_Right (Src))); + New_Assign_Stmt (M2Lv (Range_To_Dir (Dest)), + M2E (Range_To_Dir (Src))); + end Copy_Range_No_Length; + procedure Translate_Object_Allocation (Res : in out Mnode; Alloc_Kind : Allocation_Kind; diff --git a/src/vhdl/translate/trans-chap3.ads b/src/vhdl/translate/trans-chap3.ads index 53f9450f1..6952f9987 100644 --- a/src/vhdl/translate/trans-chap3.ads +++ b/src/vhdl/translate/trans-chap3.ads @@ -258,6 +258,8 @@ package Trans.Chap3 is procedure Copy_Bounds (Dest : O_Enode; Src : O_Enode; Obj_Type : Iir); procedure Copy_Bounds (Dest : Mnode; Src : Mnode; Obj_Type : Iir); + procedure Copy_Range_No_Length (Dest : Mnode; Src : Mnode); + -- Allocate an object of type OBJ_TYPE and set RES. -- RES must be a stable access of type ortho_ptr_type. -- For an unconstrained array, BOUNDS is a pointer to the boundaries of diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb index 5e89bf6c4..b7bcf97a8 100644 --- a/src/vhdl/translate/trans-chap7.adb +++ b/src/vhdl/translate/trans-chap7.adb @@ -970,15 +970,138 @@ package body Trans.Chap7 is end; end Convert_To_Constrained; + procedure Copy_Check_Bounds_Inner (Bnd : Mnode; + Expr_Type : Iir; + Res_Bnd : Mnode; + Res_Type : Iir; + Failure_Label : O_Snode) is + begin + case Iir_Kinds_Composite_Type_Definition (Get_Kind (Res_Type)) is + when Iir_Kind_Array_Type_Definition => + -- Unconstrained by definition. + raise Internal_Error; + when Iir_Kind_Array_Subtype_Definition => + if Get_Index_Constraint_Flag (Res_Type) then + declare + Expr_Indexes : constant Iir_Flist := + Get_Index_Subtype_List (Expr_Type); + Rng : Mnode; + Res_Rng : Mnode; + begin + for I in 1 .. Get_Nbr_Elements (Expr_Indexes) loop + Open_Temp; + Rng := Chap3.Bounds_To_Range (Bnd, Expr_Type, I); + Stabilize (Rng); + Res_Rng := Chap3.Bounds_To_Range (Res_Bnd, Res_Type, I); + Stabilize (Res_Rng); + Gen_Exit_When + (Failure_Label, + New_Compare_Op (ON_Neq, + M2E (Chap3.Range_To_Length (Rng)), + M2E (Chap3.Range_To_Length (Res_Rng)), + Ghdl_Bool_Type)); + + Chap3.Copy_Range_No_Length (Rng, Res_Rng); + Close_Temp; + end loop; + end; + end if; + + declare + Expr_El_Type : constant Iir := Get_Element_Subtype (Expr_Type); + Res_El_Type : constant Iir := Get_Element_Subtype (Res_Type); + begin + if (Get_Kind (Expr_El_Type) + not in Iir_Kinds_Composite_Type_Definition) + then + return; + end if; + + if Is_A_Derived_Type (Expr_El_Type, Res_El_Type) then + return; + end if; + + Copy_Check_Bounds_Inner + (Chap3.Array_Bounds_To_Element_Bounds (Bnd, Expr_Type), + Expr_El_Type, + Chap3.Array_Bounds_To_Element_Bounds (Res_Bnd, Res_Type), + Res_El_Type, + Failure_Label); + end; + when Iir_Kind_Record_Type_Definition => + -- Not derived by definition + raise Internal_Error; + when Iir_Kind_Record_Subtype_Definition => + declare + Expr_Els : constant Iir_Flist := + Get_Elements_Declaration_List (Expr_Type); + Res_Els : constant Iir_Flist := + Get_Elements_Declaration_List (Res_Type); + Expr_El, Res_El : Iir; + Expr_El_Type, Res_El_Type : Iir; + begin + for I in Flist_First .. Flist_Last (Expr_Els) loop + Expr_El := Get_Nth_Element (Expr_Els, I); + Res_El := Get_Nth_Element (Res_Els, I); + Expr_El_Type := Get_Type (Expr_El); + Res_El_Type := Get_Type (Res_El); + if Expr_El_Type /= Res_El_Type then + Copy_Check_Bounds_Inner + (Chap3.Record_Bounds_To_Element_Bounds + (Bnd, Expr_El), + Expr_El_Type, + Chap3.Record_Bounds_To_Element_Bounds + (Res_Bnd, Res_El), + Res_El_Type, + Failure_Label); + end if; + end loop; + end; + end case; + end Copy_Check_Bounds_Inner; + + -- Perform a subtype conversions on bounds. + -- BND are the bounds of the results and can be modified (it's a copy). + -- EXPR_TYPE is the composite type whose bounds are described by BND. + -- RES_TYPE is the composite type of the result (partially constrained), + -- while RES_BND are the bounds of the composite type. + procedure Copy_Check_Bounds + (Bnd : Mnode; Expr_Type : Iir; Res_Bnd : Mnode; Res_Type : Iir; Loc : Iir) + is + Success_Label : O_Snode; + Failure_Label : O_Snode; + begin + -- If ATYPE is a parent type of EXPR_TYPE, then all the constrained + -- are inherited and there is nothing to check. + if Is_A_Derived_Type (Expr_Type, Res_Type) then + return; + end if; + + Open_Temp; + -- Check each dimension. + Start_Loop_Stmt (Success_Label); + Start_Loop_Stmt (Failure_Label); + + Copy_Check_Bounds_Inner + (Bnd, Expr_Type, Res_Bnd, Res_Type, Failure_Label); + + New_Exit_Stmt (Success_Label); + + Finish_Loop_Stmt (Failure_Label); + Chap6.Gen_Bound_Error (Loc); + Finish_Loop_Stmt (Success_Label); + Close_Temp; + end Copy_Check_Bounds; + function Convert_To_Partially_Constrained - (Expr : Mnode; Expr_Type : Iir; Res_Type : Iir) return Mnode + (Expr : Mnode; Expr_Type : Iir; Res_Type : Iir; Loc : Iir) return Mnode is Res_Tinfo : constant Type_Info_Acc := Get_Info (Res_Type); Kind : constant Object_Kind_Type := Get_Object_Kind (Expr); Stable_Expr : Mnode; Res : Mnode; Bnd : Mnode; --- Res_Bnd : Mnode; + Res_Bnd : Mnode; Expr_Bnd : Mnode; begin if Is_A_Derived_Type (Expr_Type, Res_Type) then @@ -1010,21 +1133,21 @@ package body Trans.Chap7 is Ghdl_Index_Type))); -- Copy/check bounds. --- Res_Bnd := Chap3.Get_Composite_Type_Bounds (Res_Type); --- Copy_Check_Bounds (Bnd, Expr_Type, Res_Bnd, Res_Type); + Res_Bnd := Chap3.Get_Composite_Type_Bounds (Res_Type); + Copy_Check_Bounds (Bnd, Expr_Type, Res_Bnd, Res_Type, Loc); return Res; end Convert_To_Partially_Constrained; function Convert_Constrained_To_Partially_Constrained - (Expr : Mnode; Expr_Type : Iir; Res_Type : Iir) return Mnode + (Expr : Mnode; Expr_Type : Iir; Res_Type : Iir; Loc : Iir) return Mnode is Res_Tinfo : constant Type_Info_Acc := Get_Info (Res_Type); Kind : constant Object_Kind_Type := Get_Object_Kind (Expr); Stable_Expr : Mnode; Res : Mnode; Bnd : Mnode; --- Res_Bnd : Mnode; + Res_Bnd : Mnode; Expr_Bnd : Mnode; begin Stable_Expr := Stabilize (Expr); @@ -1058,8 +1181,8 @@ package body Trans.Chap7 is Ghdl_Index_Type))); -- Copy/check bounds. - -- Res_Bnd := Chap3.Get_Composite_Type_Bounds (Res_Type); - -- Copy_Check_Bounds (Bnd, Expr_Type, Res_Bnd, Res_Type); + Res_Bnd := Chap3.Get_Composite_Type_Bounds (Res_Type); + Copy_Check_Bounds (Bnd, Expr_Type, Res_Bnd, Res_Type, Loc); end if; return Res; end Convert_Constrained_To_Partially_Constrained; @@ -1116,7 +1239,7 @@ package body Trans.Chap7 is when Unconstrained | Partially_Constrained => return Convert_Constrained_To_Partially_Constrained - (Expr, Expr_Type, Res_Type); + (Expr, Expr_Type, Res_Type, Loc); end case; when Partially_Constrained | Unconstrained => @@ -1127,7 +1250,7 @@ package body Trans.Chap7 is return Expr; when Partially_Constrained => return Convert_To_Partially_Constrained - (Expr, Expr_Type, Res_Type); + (Expr, Expr_Type, Res_Type, Loc); when Fully_Constrained => return Convert_To_Constrained (Expr, Expr_Type, Res_Type, Loc); diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb index 9166d1e36..3d38b09fb 100644 --- a/src/vhdl/translate/trans-chap8.adb +++ b/src/vhdl/translate/trans-chap8.adb @@ -4593,19 +4593,29 @@ package body Trans.Chap8 is Target_Tinfo : Type_Info_Acc; Bounds : Mnode; + Layout : Mnode; + Constrained : Boolean; begin if Get_Kind (Target) = Iir_Kind_Aggregate then -- The target is an aggregate. - Chap3.Translate_Anonymous_Subtype_Definition (Target_Type, True); + Constrained := Get_Constraint_State (Target_Type) = Fully_Constrained; + Chap3.Translate_Anonymous_Subtype_Definition + (Target_Type, Constrained); Target_Tinfo := Get_Info (Target_Type); Targ := Create_Temp (Target_Tinfo, Mode_Signal); if Target_Tinfo.Type_Mode in Type_Mode_Unbounded then + pragma Assert (not Constrained); -- Unbounded array, allocate bounds. - Bounds := Dv2M (Create_Temp (Target_Tinfo.B.Bounds_Type), + pragma Assert (Target_Tinfo.S.Composite_Layout = Null_Var); + Target_Tinfo.S.Composite_Layout := + Create_Var (Create_Uniq_Identifier, Target_Tinfo.B.Layout_Type, + O_Storage_Local); + Layout := Lv2M (Get_Var (Target_Tinfo.S.Composite_Layout), Target_Tinfo, Mode_Value, - Target_Tinfo.B.Bounds_Type, - Target_Tinfo.B.Bounds_Ptr_Type); + Target_Tinfo.B.Layout_Type, + Target_Tinfo.B.Layout_Ptr_Type); + Bounds := Stabilize (Chap3.Layout_To_Bounds (Layout)); New_Assign_Stmt (M2Lp (Chap3.Get_Composite_Bounds (Targ)), M2Addr (Bounds)); -- Build bounds from aggregate. @@ -4615,6 +4625,7 @@ package body Trans.Chap8 is Translate_Signal_Target_Aggr (Chap3.Get_Composite_Base (Targ), Target, Target_Type); else + pragma Assert (Constrained); Chap4.Allocate_Complex_Object (Target_Type, Alloc_Stack, Targ); Translate_Signal_Target_Aggr (Targ, Target, Target_Type); end if; |