aboutsummaryrefslogtreecommitdiffstats
path: root/src/vhdl/translate
diff options
context:
space:
mode:
Diffstat (limited to 'src/vhdl/translate')
-rw-r--r--src/vhdl/translate/trans-chap3.adb10
-rw-r--r--src/vhdl/translate/trans-chap3.ads2
-rw-r--r--src/vhdl/translate/trans-chap7.adb143
-rw-r--r--src/vhdl/translate/trans-chap8.adb19
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;