aboutsummaryrefslogtreecommitdiffstats
path: root/translate/translation.adb
diff options
context:
space:
mode:
Diffstat (limited to 'translate/translation.adb')
-rw-r--r--translate/translation.adb244
1 files changed, 184 insertions, 60 deletions
diff --git a/translate/translation.adb b/translate/translation.adb
index a0e63eef4..17c80f923 100644
--- a/translate/translation.adb
+++ b/translate/translation.adb
@@ -1995,12 +1995,12 @@ package body Translation is
-- Get the offset in the range pointed by RANGE_PTR of INDEX.
-- This checks INDEX belongs to the range.
-- INDEX_TYPE is the subtype of the array index.
- function Translate_Index_To_Offset (Range_Ptr : O_Dnode;
+ function Translate_Index_To_Offset (Rng : Mnode;
Index : O_Enode;
Index_Expr : Iir;
Index_Type : Iir;
Loc : Iir)
- return O_Enode;
+ return O_Enode;
end Chap6;
package Chap7 is
@@ -4277,15 +4277,13 @@ package body Translation is
end;
when Iir_Kind_Indexed_Name =>
declare
- Range_Ptr : O_Dnode;
+ Rng : Mnode;
begin
Open_Temp;
- Range_Ptr := Create_Temp_Ptr
- (Type_Info.T.Range_Ptr_Type,
- Get_Var (Get_Info (Iter_Type).T.Range_Var));
+ Rng := Stabilize (Chap3.Type_To_Range (Iter_Type));
Gen_Subblock_Call
(Chap6.Translate_Index_To_Offset
- (Range_Ptr,
+ (Rng,
Chap7.Translate_Expression
(Get_Nth_Element (Get_Index_List (Spec), 0),
Iter_Type),
@@ -4295,7 +4293,7 @@ package body Translation is
end;
when Iir_Kind_Slice_Name =>
declare
- Range_Ptr : O_Dnode;
+ Rng : Mnode;
Slice : O_Dnode;
Slice_Ptr : O_Dnode;
Left, Right : O_Dnode;
@@ -4305,9 +4303,7 @@ package body Translation is
Label : O_Snode;
begin
Open_Temp;
- Range_Ptr := Create_Temp_Ptr
- (Type_Info.T.Range_Ptr_Type,
- Get_Var (Get_Info (Iter_Type).T.Range_Var));
+ Rng := Stabilize (Chap3.Type_To_Range (Iter_Type));
Slice := Create_Temp (Type_Info.T.Range_Type);
Slice_Ptr := Create_Temp_Ptr
(Type_Info.T.Range_Ptr_Type, New_Obj (Slice));
@@ -4316,14 +4312,14 @@ package body Translation is
Left := Create_Temp_Init
(Ghdl_Index_Type,
Chap6.Translate_Index_To_Offset
- (Range_Ptr,
+ (Rng,
New_Value (New_Selected_Element
(New_Obj (Slice), Type_Info.T.Range_Left)),
Spec, Iter_Type, Spec));
Right := Create_Temp_Init
(Ghdl_Index_Type,
Chap6.Translate_Index_To_Offset
- (Range_Ptr,
+ (Rng,
New_Value (New_Selected_Element
(New_Obj (Slice),
Type_Info.T.Range_Right)),
@@ -4333,9 +4329,7 @@ package body Translation is
Start_If_Stmt
(If_Blk,
New_Compare_Op (ON_Eq,
- New_Value_Selected_Acc_Value
- (New_Obj (Range_Ptr),
- Type_Info.T.Range_Dir),
+ M2E (Chap3.Range_To_Dir (Rng)),
New_Value
(New_Selected_Element
(New_Obj (Slice),
@@ -12048,17 +12042,20 @@ package body Translation is
is
Rng : Iir;
begin
+ -- Do checks if type of the expression is not a subtype.
+ if Expr_Type = Null_Iir -- FIXME: to be removed (generate stmt)
+ or else
+ Get_Kind (Expr_Type) not in Iir_Kinds_Discrete_Subtype_Definition
+ then
+ return True;
+ end if;
+
-- No check if the expression has the type of the index.
if Expr_Type = Rng_Type then
return False;
end if;
-- No check for 'Range or 'Reverse_Range.
- if Get_Kind (Expr_Type) not in Iir_Kinds_Discrete_Subtype_Definition
- then
- return True;
- end if;
-
Rng := Get_Range_Constraint (Expr_Type);
if (Get_Kind (Rng) = Iir_Kind_Range_Array_Attribute
or Get_Kind (Rng) = Iir_Kind_Reverse_Range_Array_Attribute)
@@ -12070,42 +12067,174 @@ package body Translation is
return True;
end Need_Index_Check;
+ procedure Get_Deep_Range_Expression
+ (Atype : Iir; Rng : out Iir; Is_Reverse : out Boolean)
+ is
+ T : Iir;
+ R : Iir;
+ begin
+ Is_Reverse := False;
+
+ -- T is an integer/enumeration subtype.
+ T := Atype;
+ loop
+ if Get_Kind (T) not in Iir_Kinds_Discrete_Subtype_Definition then
+ Error_Kind ("get_deep_range_expression(1)", T);
+ end if;
- function Translate_Index_To_Offset (Range_Ptr : O_Dnode;
+ R := Get_Range_Constraint (T);
+ case Get_Kind (R) is
+ when Iir_Kind_Range_Expression =>
+ Rng := R;
+ return;
+ when Iir_Kind_Range_Array_Attribute =>
+ null;
+ when Iir_Kind_Reverse_Range_Array_Attribute =>
+ Is_Reverse := not Is_Reverse;
+ when others =>
+ Error_Kind ("get_deep_range_expression(2)", R);
+ end case;
+ T := Get_Index_Subtype (R);
+ if T = Null_Iir then
+ Rng := Null_Iir;
+ return;
+ end if;
+ end loop;
+ end Get_Deep_Range_Expression;
+
+ function Translate_Index_To_Offset (Rng : Mnode;
Index : O_Enode;
Index_Expr : Iir;
Index_Type : Iir;
Loc : Iir)
- return O_Enode
+ return O_Enode
is
+ Need_Check : Boolean;
Dir : O_Enode;
If_Blk : O_If_Block;
Res : O_Dnode;
Off : O_Dnode;
+ Bound : O_Enode;
Cond1, Cond2: O_Enode;
Index_Node : O_Dnode;
Bound_Node : O_Dnode;
Index_Info : Type_Info_Acc;
+ Deep_Rng : Iir;
+ Deep_Reverse : Boolean;
begin
Index_Info := Get_Info (Get_Base_Type (Index_Type));
+ Need_Check := Need_Index_Check (Get_Type (Index_Expr), Index_Type);
+ Get_Deep_Range_Expression (Index_Type, Deep_Rng, Deep_Reverse);
Res := Create_Temp (Ghdl_Index_Type);
Open_Temp;
+ Off := Create_Temp (Index_Info.Ortho_Type (Mode_Value));
+
+ Bound := M2E (Chap3.Range_To_Left (Rng));
+
+ if Deep_Rng /= Null_Iir then
+ if Get_Direction (Deep_Rng) = Iir_To xor Deep_Reverse then
+ -- Direction TO: INDEX - LEFT.
+ New_Assign_Stmt (New_Obj (Off),
+ New_Dyadic_Op (ON_Sub_Ov,
+ Index, Bound));
+ else
+ -- Direction DOWNTO: LEFT - INDEX.
+ New_Assign_Stmt (New_Obj (Off),
+ New_Dyadic_Op (ON_Sub_Ov,
+ Bound, Index));
+ end if;
+ else
+ Index_Node := Create_Temp_Init
+ (Index_Info.Ortho_Type (Mode_Value), Index);
+ Bound_Node := Create_Temp_Init
+ (Index_Info.Ortho_Type (Mode_Value), Bound);
+ Dir := M2E (Chap3.Range_To_Dir (Rng));
+
+ -- Non-static direction.
+ Start_If_Stmt (If_Blk,
+ New_Compare_Op (ON_Eq, Dir,
+ New_Lit (Ghdl_Dir_To_Node),
+ Ghdl_Bool_Type));
+ -- Direction TO: INDEX - LEFT.
+ New_Assign_Stmt (New_Obj (Off),
+ New_Dyadic_Op (ON_Sub_Ov,
+ New_Obj_Value (Index_Node),
+ New_Obj_Value (Bound_Node)));
+ New_Else_Stmt (If_Blk);
+ -- Direction DOWNTO: LEFT - INDEX.
+ New_Assign_Stmt (New_Obj (Off),
+ New_Dyadic_Op (ON_Sub_Ov,
+ New_Obj_Value (Bound_Node),
+ New_Obj_Value (Index_Node)));
+ Finish_If_Stmt (If_Blk);
+ end if;
+
+ -- Get the offset.
+ New_Assign_Stmt
+ (New_Obj (Res), New_Convert_Ov (New_Obj_Value (Off),
+ Ghdl_Index_Type));
+
+ -- Check bounds.
+ if Need_Check then
+ Cond1 := New_Compare_Op
+ (ON_Lt,
+ New_Obj_Value (Off),
+ New_Lit (New_Signed_Literal (Index_Info.Ortho_Type (Mode_Value),
+ 0)),
+ Ghdl_Bool_Type);
+
+ Cond2 := New_Compare_Op
+ (ON_Ge,
+ New_Obj_Value (Res),
+ M2E (Chap3.Range_To_Length (Rng)),
+ Ghdl_Bool_Type);
+ Check_Bound_Error (New_Dyadic_Op (ON_Or, Cond1, Cond2), Loc, 0);
+ end if;
+
+ Close_Temp;
+
+ return New_Obj_Value (Res);
+ end Translate_Index_To_Offset;
+
+ function Translate_Fat_Index_To_Offset (Rng : Mnode;
+ Index : O_Enode;
+ Index_Type : Iir;
+ Loc : Iir)
+ return O_Enode
+ is
+ Dir : O_Enode;
+ If_Blk : O_If_Block;
+ Res : O_Dnode;
+ Off : O_Dnode;
+ Bound : O_Enode;
+ Cond1, Cond2: O_Enode;
+ Index_Node : O_Dnode;
+ Bound_Node : O_Dnode;
+ Index_Info : Type_Info_Acc;
+ begin
+ Index_Info := Get_Info (Get_Base_Type (Index_Type));
+
+ Res := Create_Temp (Ghdl_Index_Type);
+
+ Open_Temp;
+
+ Off := Create_Temp (Index_Info.Ortho_Type (Mode_Value));
+
+ Bound := M2E (Chap3.Range_To_Left (Rng));
+
Index_Node := Create_Temp_Init
(Index_Info.Ortho_Type (Mode_Value), Index);
Bound_Node := Create_Temp_Init
- (Index_Info.Ortho_Type (Mode_Value),
- New_Value_Selected_Acc_Value (New_Obj (Range_Ptr),
- Index_Info.T.Range_Left));
- Off := Create_Temp (Index_Info.Ortho_Type (Mode_Value));
-
- Dir := New_Value_Selected_Acc_Value (New_Obj (Range_Ptr),
- Index_Info.T.Range_Dir);
+ (Index_Info.Ortho_Type (Mode_Value), Bound);
+ Dir := M2E (Chap3.Range_To_Dir (Rng));
+ -- Non-static direction.
Start_If_Stmt (If_Blk,
- New_Compare_Op (ON_Eq, Dir, New_Lit (Ghdl_Dir_To_Node),
+ New_Compare_Op (ON_Eq, Dir,
+ New_Lit (Ghdl_Dir_To_Node),
Ghdl_Bool_Type));
-- Direction TO: INDEX - LEFT.
New_Assign_Stmt (New_Obj (Off),
@@ -12126,27 +12255,24 @@ package body Translation is
Ghdl_Index_Type));
-- Check bounds.
- if Need_Index_Check (Get_Type (Index_Expr), Index_Type) then
- Cond1 := New_Compare_Op
- (ON_Lt,
- New_Obj_Value (Off),
- New_Lit (New_Signed_Literal (Index_Info.Ortho_Type (Mode_Value),
- 0)),
- Ghdl_Bool_Type);
-
- Cond2 := New_Compare_Op
- (ON_Ge,
- New_Obj_Value (Res),
- New_Value_Selected_Acc_Value (New_Obj (Range_Ptr),
- Index_Info.T.Range_Length),
- Ghdl_Bool_Type);
- Check_Bound_Error (New_Dyadic_Op (ON_Or, Cond1, Cond2), Loc, 0);
- end if;
+ Cond1 := New_Compare_Op
+ (ON_Lt,
+ New_Obj_Value (Off),
+ New_Lit (New_Signed_Literal (Index_Info.Ortho_Type (Mode_Value),
+ 0)),
+ Ghdl_Bool_Type);
+
+ Cond2 := New_Compare_Op
+ (ON_Ge,
+ New_Obj_Value (Res),
+ M2E (Chap3.Range_To_Length (Rng)),
+ Ghdl_Bool_Type);
+ Check_Bound_Error (New_Dyadic_Op (ON_Or, Cond1, Cond2), Loc, 0);
Close_Temp;
return New_Obj_Value (Res);
- end Translate_Index_To_Offset;
+ end Translate_Fat_Index_To_Offset;
-- Translate index EXPR in dimension DIM of thin array into an
-- offset.
@@ -12262,23 +12388,21 @@ package body Translation is
-- Compute index for the current dimension.
case Prefix_Info.Type_Mode is
when Type_Mode_Fat_Array =>
- Range_Ptr := Chap3.Get_Array_Range
- (Prefix, Prefix_Type, Dim);
+ Range_Ptr := Stabilize
+ (Chap3.Get_Array_Range (Prefix, Prefix_Type, Dim));
+ R := Translate_Fat_Index_To_Offset
+ (Range_Ptr,
+ Chap7.Translate_Expression (Index, Ibasetype),
+ Itype, Index);
when Type_Mode_Ptr_Array =>
+ -- Manually extract range since there is no infos for
+ -- index subtype.
Range_Ptr := Chap3.Bounds_To_Range
(Chap3.Get_Array_Type_Bounds (Prefix_Type),
Prefix_Type, Dim);
- when Type_Mode_Array =>
- null;
- when others =>
- raise Internal_Error;
- end case;
- case Prefix_Info.Type_Mode is
- when Type_Mode_Fat_Array
- | Type_Mode_Ptr_Array =>
- Range_Ptr := Stabilize (Range_Ptr);
+ Stabilize (Range_Ptr);
R := Translate_Index_To_Offset
- (M2Dp (Range_Ptr),
+ (Range_Ptr,
Chap7.Translate_Expression (Index, Ibasetype),
Index, Itype, Index);
when Type_Mode_Array =>