aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/vhdl/evaluation.adb131
-rw-r--r--src/vhdl/evaluation.ads7
-rw-r--r--src/vhdl/translate/trans-chap7.adb136
3 files changed, 226 insertions, 48 deletions
diff --git a/src/vhdl/evaluation.adb b/src/vhdl/evaluation.adb
index 7cc3608eb..72c5a9152 100644
--- a/src/vhdl/evaluation.adb
+++ b/src/vhdl/evaluation.adb
@@ -2392,6 +2392,7 @@ package body Evaluation is
El : Iir;
begin
Idx := Eval_Static_Expr (Get_Nth_Element (Indexes, 0));
+ Set_Nth_Element (Indexes, 0, Idx);
Pos := Eval_Pos_In_Range (Index_Range, Idx);
El := Get_Nth_Element (Get_Simple_Aggregate_List (Aggr), Natural (Pos));
@@ -2442,9 +2443,137 @@ package body Evaluation is
when others =>
Error_Kind ("eval_indexed_name", Prefix);
end case;
- return Null_Iir;
end Eval_Indexed_Name;
+ function Eval_Indexed_Aggregate_By_Offset
+ (Aggr : Iir; Off : Iir_Index32; Dim : Natural := 0) return Iir
+ is
+ Prefix_Type : constant Iir := Get_Type (Aggr);
+ Indexes_Type : constant Iir_Flist :=
+ Get_Index_Subtype_List (Prefix_Type);
+ Assoc : Iir;
+ Assoc_Expr : Iir;
+ Assoc_Len : Iir_Index32;
+ Aggr_Bounds : Iir;
+ Cur_Off : Iir_Index32;
+ Res : Iir;
+ Left_Pos : Iir_Int64;
+ Assoc_Pos : Iir_Int64;
+ begin
+ Aggr_Bounds := Eval_Static_Range (Get_Nth_Element (Indexes_Type, Dim));
+ Left_Pos := Eval_Pos (Eval_Discrete_Range_Left (Aggr_Bounds));
+
+ Cur_Off := 0;
+ Assoc := Get_Association_Choices_Chain (Aggr);
+ Assoc_Expr := Null_Iir;
+ while Assoc /= Null_Iir loop
+ if not Get_Same_Alternative_Flag (Assoc) then
+ Assoc_Expr := Assoc;
+ end if;
+ case Get_Kind (Assoc) is
+ when Iir_Kind_Choice_By_None =>
+ if Get_Element_Type_Flag (Assoc) then
+ if Off = Cur_Off then
+ return Get_Associated_Expr (Assoc);
+ end if;
+ Assoc_Len := 1;
+ else
+ Res := Get_Associated_Expr (Assoc);
+ Assoc_Len := Iir_Index32
+ (Eval_Discrete_Range_Length
+ (Get_Index_Type (Get_Type (Res), 0)));
+ if Off >= Cur_Off and then Off < Cur_Off + Assoc_Len then
+ return Eval_Indexed_Name_By_Offset (Res, Off - Cur_Off);
+ end if;
+ end if;
+ Cur_Off := Cur_Off + Assoc_Len;
+ when Iir_Kind_Choice_By_Expression =>
+ Assoc_Pos := Eval_Pos (Get_Choice_Expression (Assoc));
+ case Get_Direction (Aggr_Bounds) is
+ when Iir_To =>
+ Cur_Off := Iir_Index32 (Assoc_Pos - Left_Pos);
+ when Iir_Downto =>
+ Cur_Off := Iir_Index32 (Left_Pos - Assoc_Pos);
+ end case;
+ if Cur_Off = Off then
+ return Get_Associated_Expr (Assoc);
+ end if;
+ when Iir_Kind_Choice_By_Range =>
+ declare
+ Rng : Iir;
+ Left : Iir_Int64;
+ Right : Iir_Int64;
+ Hi, Lo : Iir_Int64;
+ Lo_Off, Hi_Off : Iir_Index32;
+ begin
+ Rng := Eval_Range (Get_Choice_Range (Assoc));
+ Set_Choice_Range (Assoc, Rng);
+
+ Left := Eval_Pos (Get_Left_Limit (Rng));
+ Right := Eval_Pos (Get_Right_Limit (Rng));
+ case Get_Direction (Rng) is
+ when Iir_To =>
+ Lo := Left;
+ Hi := Right;
+ when Iir_Downto =>
+ Lo := Right;
+ Hi := Left;
+ end case;
+ case Get_Direction (Aggr_Bounds) is
+ when Iir_To =>
+ Lo_Off := Iir_Index32 (Lo - Left_Pos);
+ Hi_Off := Iir_Index32 (Hi - Left_Pos);
+ when Iir_Downto =>
+ Lo_Off := Iir_Index32 (Left_Pos - Lo);
+ Hi_Off := Iir_Index32 (Left_Pos - Hi);
+ end case;
+ if Off >= Lo_Off and then Off <= Hi_Off then
+ Res := Get_Associated_Expr (Assoc);
+ if Get_Element_Type_Flag (Assoc) then
+ return Res;
+ else
+ return Eval_Indexed_Name_By_Offset
+ (Res, Off - Lo_Off);
+ end if;
+ end if;
+ end;
+ when Iir_Kind_Choice_By_Others =>
+ return Get_Associated_Expr (Assoc_Expr);
+ when others =>
+ raise Internal_Error;
+ end case;
+ Assoc := Get_Chain (Assoc);
+ end loop;
+ raise Internal_Error;
+ end Eval_Indexed_Aggregate_By_Offset;
+
+ function Eval_Indexed_Name_By_Offset (Prefix : Iir; Off : Iir_Index32)
+ return Iir
+ is
+ begin
+ case Get_Kind (Prefix) is
+ when Iir_Kind_Aggregate =>
+ return Eval_Indexed_Aggregate_By_Offset (Prefix, Off);
+ when Iir_Kind_String_Literal8 =>
+ declare
+ Id : constant String8_Id := Get_String8_Id (Prefix);
+ El_Type : constant Iir :=
+ Get_Element_Subtype (Get_Type (Prefix));
+ Enums : constant Iir_Flist :=
+ Get_Enumeration_Literal_List (El_Type);
+ Lit : Pos32;
+ begin
+ Lit := Str_Table.Element_String8 (Id, Int32 (Off + 1));
+ return Get_Nth_Element (Enums, Natural (Lit));
+ end;
+ when Iir_Kind_Simple_Aggregate =>
+ return Get_Nth_Element (Get_Simple_Aggregate_List (Prefix),
+ Natural (Off));
+ when others =>
+ Error_Kind ("eval_indexed_name_by_offset", Prefix);
+ end case;
+ end Eval_Indexed_Name_By_Offset;
+
function Eval_Static_Expr (Expr: Iir) return Iir
is
Res : Iir;
diff --git a/src/vhdl/evaluation.ads b/src/vhdl/evaluation.ads
index 05feac652..09975cd6a 100644
--- a/src/vhdl/evaluation.ads
+++ b/src/vhdl/evaluation.ads
@@ -166,6 +166,13 @@ package Evaluation is
function Eval_Value_Attribute
(Value : String; Atype : Iir; Orig : Iir) return Iir;
+ -- From one-dimensional array expression PREFIX extract element at
+ -- offset OFF (from 0 to length - 1). Note that the element is directly
+ -- returned, not a copy of it (so it should be referenced if stored in
+ -- the tree).
+ function Eval_Indexed_Name_By_Offset (Prefix : Iir; Off : Iir_Index32)
+ return Iir;
+
-- Return the simple name, character literal or operator sumbol of ID,
-- using the same format as SIMPLE_NAME attribute.
function Eval_Simple_Name (Id : Name_Id) return String;
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index e8034ffda..64cb3ec58 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -212,12 +212,36 @@ package body Trans.Chap7 is
Build_Array_Choices_Vector (Vect, Index_Range, Assocs);
if Dim = Nbr_Dims then
- for I in Vect'Range loop
- New_Array_Aggr_El
- (List,
- Translate_Static_Expression
- (Get_Associated_Expr (Vect (I)), El_Type));
- end loop;
+ declare
+ Idx : Natural;
+ Assoc : Iir;
+ Expr : Iir;
+ El : Iir;
+ Assoc_Len : Iir_Index32;
+ begin
+ Idx := 0;
+ while Idx < Natural (Len) loop
+ Assoc := Vect (Idx);
+ Expr := Get_Associated_Expr (Assoc);
+ if Get_Element_Type_Flag (Assoc) then
+ New_Array_Aggr_El
+ (List,
+ Translate_Static_Expression (Expr, El_Type));
+ Idx := Idx + 1;
+ else
+ Assoc_Len := Iir_Index32
+ (Eval_Discrete_Range_Length
+ (Get_Choice_Range (Assoc)));
+ for I in 0 .. Assoc_Len - 1 loop
+ El := Eval_Indexed_Name_By_Offset (Expr, I);
+ New_Array_Aggr_El
+ (List,
+ Translate_Static_Expression (El, El_Type));
+ Idx := Idx + 1;
+ end loop;
+ end if;
+ end loop;
+ end;
else
for I in Vect'Range loop
Translate_Static_Array_Aggregate_1
@@ -2928,13 +2952,12 @@ package body Trans.Chap7 is
Close_Temp;
end Translate_Array_Aggregate_Gen_String;
- procedure Translate_Array_Aggregate_Gen
- (Base_Ptr : Mnode;
- Bounds_Ptr : Mnode;
- Aggr : Iir;
- Aggr_Type : Iir;
- Dim : Natural;
- Var_Index : O_Dnode)
+ procedure Translate_Array_Aggregate_Gen (Base_Ptr : Mnode;
+ Bounds_Ptr : Mnode;
+ Aggr : Iir;
+ Aggr_Type : Iir;
+ Dim : Natural;
+ Var_Index : O_Dnode)
is
Index_List : Iir_Flist;
Expr_Type : Iir;
@@ -2942,16 +2965,16 @@ package body Trans.Chap7 is
-- Assign EXPR to current position (defined by index VAR_INDEX), and
-- update VAR_INDEX. Handles sub-aggregates.
- procedure Do_Assign (Assoc : Iir; Expr : Iir)
+ procedure Do_Assign (Assoc : Iir; Expr : Iir; Assoc_Len : out Iir_Int64)
is
Dest : Mnode;
- Len : Iir_Int64;
begin
if Final then
if Get_Element_Type_Flag (Assoc) then
Dest := Chap3.Index_Base (Base_Ptr, Aggr_Type,
New_Obj_Value (Var_Index));
Translate_Assign (Dest, Expr, Expr_Type);
+ Assoc_Len := 1;
Inc_Var (Var_Index);
else
Dest := Chap3.Slice_Base (Base_Ptr, Aggr_Type,
@@ -2959,17 +2982,19 @@ package body Trans.Chap7 is
Translate_Assign (Dest, Expr, Get_Type (Expr));
-- FIXME: handle non-static expression type (at least for
-- choice by range).
- Len := Eval_Discrete_Type_Length
+ Assoc_Len := Eval_Discrete_Type_Length
(Get_Index_Type (Get_Type (Expr), 0));
New_Assign_Stmt
(New_Obj (Var_Index),
- New_Dyadic_Op (ON_Add_Ov,
- New_Obj_Value (Var_Index),
- New_Lit (New_Index_Lit (Unsigned_64 (Len)))));
+ New_Dyadic_Op
+ (ON_Add_Ov,
+ New_Obj_Value (Var_Index),
+ New_Lit (New_Index_Lit (Unsigned_64 (Assoc_Len)))));
end if;
else
Translate_Array_Aggregate_Gen
(Base_Ptr, Bounds_Ptr, Expr, Aggr_Type, Dim + 1, Var_Index);
+ Assoc_Len := 1;
end if;
end Do_Assign;
@@ -2977,6 +3002,7 @@ package body Trans.Chap7 is
is
P : Natural;
El : Iir;
+ Assoc_Len : Iir_Int64;
begin
-- First, assign positionnal association.
-- FIXME: count the number of positionnal association and generate
@@ -2987,14 +3013,8 @@ package body Trans.Chap7 is
loop
exit when El = Null_Iir;
exit when Get_Kind (El) /= Iir_Kind_Choice_By_None;
- Do_Assign (El, Get_Associated_Expr (El));
- if not Final or else Get_Element_Type_Flag (El) then
- P := P + 1;
- else
- P := P + Natural
- (Eval_Discrete_Type_Length
- (Get_Index_Type (Get_Type (Get_Associated_Expr (El)), 0)));
- end if;
+ Do_Assign (El, Get_Associated_Expr (El), Assoc_Len);
+ P := P + Natural (Assoc_Len);
El := Get_Chain (El);
end loop;
@@ -3035,7 +3055,8 @@ package body Trans.Chap7 is
New_Lit (Ghdl_Index_0),
Ghdl_Bool_Type));
- Do_Assign (El, Get_Associated_Expr (El));
+ Do_Assign (El, Get_Associated_Expr (El), Assoc_Len);
+ pragma Assert (Assoc_Len = 1);
Dec_Var (Var_Len);
Finish_Loop_Stmt (Label);
Close_Temp;
@@ -3045,6 +3066,7 @@ package body Trans.Chap7 is
procedure Translate_Array_Aggregate_Gen_Named
is
El : Iir;
+ Assoc_Len : Iir_Int64;
begin
El := Get_Association_Choices_Chain (Aggr);
@@ -3057,9 +3079,11 @@ package body Trans.Chap7 is
-- Handled by positional.
raise Internal_Error;
when Iir_Kind_Choice_By_Expression =>
- Do_Assign (El, Get_Associated_Expr (El));
+ Do_Assign (El, Get_Associated_Expr (El), Assoc_Len);
return;
when Iir_Kind_Choice_By_Range =>
+ -- FIXME: todo.
+ pragma Assert (Get_Element_Type_Flag (El));
declare
Var_Length : O_Dnode;
Var_I : O_Dnode;
@@ -3077,7 +3101,7 @@ package body Trans.Chap7 is
New_Obj_Value (Var_I),
New_Obj_Value (Var_Length),
Ghdl_Bool_Type));
- Do_Assign (El, Get_Associated_Expr (El));
+ Do_Assign (El, Get_Associated_Expr (El), Assoc_Len);
Inc_Var (Var_I);
Finish_Loop_Stmt (Label);
Close_Temp;
@@ -3090,11 +3114,13 @@ package body Trans.Chap7 is
-- Several choices..
declare
- Range_Type : Iir;
+ Range_Type : constant Iir :=
+ Get_Base_Type (Get_Index_Type (Index_List, Dim - 1));
+ Rtinfo : constant Type_Info_Acc := Get_Info (Range_Type);
Var_Pos : O_Dnode;
Var_Len : O_Dnode;
+ Var_Alen : O_Dnode;
Range_Ptr : Mnode;
- Rtinfo : Type_Info_Acc;
If_Blk : O_If_Block;
Case_Blk : O_Case_Block;
Label : O_Snode;
@@ -3104,27 +3130,26 @@ package body Trans.Chap7 is
Open_Temp;
-- Create a loop from left +- number of positionnals associations
-- to/downto right.
- Range_Type := Get_Base_Type (Get_Index_Type (Index_List, Dim - 1));
- Rtinfo := Get_Info (Range_Type);
Var_Pos := Create_Temp (Rtinfo.Ortho_Type (Mode_Value));
Range_Ptr := Stabilize
(Chap3.Bounds_To_Range (Bounds_Ptr, Aggr_Type, Dim));
New_Assign_Stmt (New_Obj (Var_Pos),
M2E (Chap3.Range_To_Left (Range_Ptr)));
- Var_Len := Create_Temp (Ghdl_Index_Type);
+ Var_Len := Create_Temp (Ghdl_Index_Type);
Len_Tmp := M2E (Chap3.Range_To_Length (Range_Ptr));
New_Assign_Stmt (New_Obj (Var_Len), Len_Tmp);
+ Var_Alen := Create_Temp (Ghdl_Index_Type);
+
-- Start loop.
Start_Loop_Stmt (Label);
-- Check if end of loop.
- Gen_Exit_When
- (Label,
- New_Compare_Op (ON_Eq,
- New_Obj_Value (Var_Len),
- New_Lit (Ghdl_Index_0),
- Ghdl_Bool_Type));
+ Gen_Exit_When (Label,
+ New_Compare_Op (ON_Eq,
+ New_Obj_Value (Var_Len),
+ New_Lit (Ghdl_Index_0),
+ Ghdl_Bool_Type));
-- convert aggr into a case statement.
Start_Case_Stmt (Case_Blk, New_Obj_Value (Var_Pos));
@@ -3138,7 +3163,10 @@ package body Trans.Chap7 is
if not Get_Same_Alternative_Flag (El) then
Expr := Get_Associated_Expr (El);
end if;
- Do_Assign (El, Expr);
+ Do_Assign (El, Expr, Assoc_Len);
+ New_Assign_Stmt
+ (New_Obj (Var_Alen),
+ New_Lit (New_Index_Lit (Unsigned_64 (Assoc_Len))));
El := Get_Chain (El);
end loop;
Finish_Case_Stmt (Case_Blk);
@@ -3149,13 +3177,27 @@ package body Trans.Chap7 is
M2E (Chap3.Range_To_Dir (Range_Ptr)),
New_Lit (Ghdl_Dir_To_Node),
Ghdl_Bool_Type));
- Chap8.Gen_Update_Iterator (Var_Pos, Iir_To, Unsigned_64 (1),
- Range_Type);
+ New_Assign_Stmt
+ (New_Obj (Var_Pos),
+ New_Dyadic_Op
+ (ON_Add_Ov,
+ New_Obj_Value (Var_Pos),
+ New_Convert_Ov (New_Obj_Value (Var_Alen),
+ Rtinfo.Ortho_Type (Mode_Value))));
New_Else_Stmt (If_Blk);
- Chap8.Gen_Update_Iterator (Var_Pos, Iir_Downto, Unsigned_64 (1),
- Range_Type);
+ New_Assign_Stmt
+ (New_Obj (Var_Pos),
+ New_Dyadic_Op
+ (ON_Sub_Ov,
+ New_Obj_Value (Var_Pos),
+ New_Convert_Ov (New_Obj_Value (Var_Alen),
+ Rtinfo.Ortho_Type (Mode_Value))));
Finish_If_Stmt (If_Blk);
- Dec_Var (Var_Len);
+ -- Update var_len.
+ New_Assign_Stmt (New_Obj (Var_Len),
+ New_Dyadic_Op (ON_Sub_Ov,
+ New_Obj_Value (Var_Len),
+ New_Obj_Value (Var_Alen)));
Finish_Loop_Stmt (Label);
Close_Temp;
end;
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 17:00:13 +0000