diff options
Diffstat (limited to 'src/vhdl/translate/trans-chap7.adb')
| -rw-r--r-- | src/vhdl/translate/trans-chap7.adb | 349 |
1 files changed, 188 insertions, 161 deletions
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb index 0402b8e41..aeff43bf0 100644 --- a/src/vhdl/translate/trans-chap7.adb +++ b/src/vhdl/translate/trans-chap7.adb @@ -2930,8 +2930,7 @@ package body Trans.Chap7 is Expr_Type : Iir; Final : Boolean; - procedure Do_Assign (Expr : Iir) - is + procedure Do_Assign (Expr : Iir) is begin if Final then Translate_Assign (Chap3.Index_Base (Base_Ptr, Aggr_Type, @@ -2944,184 +2943,212 @@ package body Trans.Chap7 is end if; end Do_Assign; - P : Natural; - El : Iir; - begin - case Get_Kind (Aggr) is - when Iir_Kind_Aggregate => - -- Continue below. - null; - when Iir_Kind_String_Literal8 => - Translate_Array_Aggregate_Gen_String - (Base_Ptr, Aggr, Aggr_Type, Var_Index); - return; - when others => - raise Internal_Error; - end case; + procedure Translate_Array_Aggregate_Gen_Positional + is + P : Natural; + El : Iir; + begin + -- First, assign positionnal association. + -- FIXME: count the number of positionnal association and generate + -- an error if there is more positionnal association than elements + -- in the array. + El := Get_Association_Choices_Chain (Aggr); + P := 0; + loop + if El = Null_Iir then + return; + end if; + exit when Get_Kind (El) /= Iir_Kind_Choice_By_None; + Do_Assign (Get_Associated_Expr (El)); + P := P + 1; + El := Get_Chain (El); + end loop; - Index_List := Get_Index_Subtype_List (Aggr_Type); + pragma Assert (Get_Kind (El) = Iir_Kind_Choice_By_Others); - -- FINAL is true if the elements of the aggregate are elements of - -- the array. - if Get_Nbr_Elements (Index_List) = Dim then - Expr_Type := Get_Element_Subtype (Aggr_Type); - Final:= True; - else - Final := False; - end if; + -- Handle others. + declare + Var_Len : O_Dnode; + Range_Ptr : Mnode; + Label : O_Snode; + Len_Tmp : O_Enode; + begin + Open_Temp; + -- Create a loop from P to len. + Var_Len := Create_Temp (Ghdl_Index_Type); - El := Get_Association_Choices_Chain (Aggr); + Range_Ptr := Chap3.Bounds_To_Range (Bounds_Ptr, Aggr_Type, Dim); + Len_Tmp := M2E (Chap3.Range_To_Length (Range_Ptr)); + if P /= 0 then + Len_Tmp := New_Dyadic_Op + (ON_Sub_Ov, + Len_Tmp, New_Lit (New_Index_Lit (Unsigned_64 (P)))); + end if; + New_Assign_Stmt (New_Obj (Var_Len), Len_Tmp); - -- First, assign positionnal association. - -- FIXME: count the number of positionnal association and generate - -- an error if there is more positionnal association than elements - -- in the array. - P := 0; - loop - if El = Null_Iir then - -- There is only positionnal associations. - return; - end if; - exit when Get_Kind (El) /= Iir_Kind_Choice_By_None; - Do_Assign (Get_Associated_Expr (El)); - P := P + 1; - El := Get_Chain (El); - end loop; + -- 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)); - -- Then, assign named or others association. - if Get_Chain (El) = Null_Iir then - -- There is only one choice - case Get_Kind (El) is - when Iir_Kind_Choice_By_Others => - -- falltrough... - null; - when Iir_Kind_Choice_By_Expression => - Do_Assign (Get_Associated_Expr (El)); - return; - when Iir_Kind_Choice_By_Range => - declare - Var_Length : O_Dnode; - Var_I : O_Dnode; - Label : O_Snode; - begin - Open_Temp; - Var_Length := Create_Temp_Init - (Ghdl_Index_Type, - Chap7.Translate_Range_Length (Get_Choice_Range (El))); - Var_I := Create_Temp (Ghdl_Index_Type); - Init_Var (Var_I); - Start_Loop_Stmt (Label); - Gen_Exit_When (Label, - New_Compare_Op (ON_Eq, - New_Obj_Value (Var_I), - New_Obj_Value (Var_Length), - Ghdl_Bool_Type)); - Do_Assign (Get_Associated_Expr (El)); - Inc_Var (Var_I); - Finish_Loop_Stmt (Label); - Close_Temp; - end; - return; - when others => - Error_Kind ("translate_array_aggregate_gen", El); - end case; - end if; + Do_Assign (Get_Associated_Expr (El)); + Dec_Var (Var_Len); + Finish_Loop_Stmt (Label); + Close_Temp; + end; + end Translate_Array_Aggregate_Gen_Positional; - -- Several choices.. - declare - Range_Type : Iir; - Var_Pos : O_Dnode; - Var_Len : O_Dnode; - Range_Ptr : Mnode; - Rtinfo : Type_Info_Acc; - If_Blk : O_If_Block; - Case_Blk : O_Case_Block; - Label : O_Snode; - El_Assoc : Iir; - Len_Tmp : O_Enode; + procedure Translate_Array_Aggregate_Gen_Named + is + El : Iir; begin - 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); - if P /= 0 then + El := Get_Association_Choices_Chain (Aggr); + + -- Then, assign named or others association. + if Is_Chain_Length_One (El) then + -- There is only one choice + case Get_Kind (El) is + when Iir_Kind_Choice_By_Others => + -- falltrough... + null; + when Iir_Kind_Choice_By_Expression => + Do_Assign (Get_Associated_Expr (El)); + return; + when Iir_Kind_Choice_By_Range => + declare + Var_Length : O_Dnode; + Var_I : O_Dnode; + Label : O_Snode; + begin + Open_Temp; + Var_Length := Create_Temp_Init + (Ghdl_Index_Type, + Chap7.Translate_Range_Length (Get_Choice_Range (El))); + Var_I := Create_Temp (Ghdl_Index_Type); + Init_Var (Var_I); + Start_Loop_Stmt (Label); + Gen_Exit_When (Label, + New_Compare_Op (ON_Eq, + New_Obj_Value (Var_I), + New_Obj_Value (Var_Length), + Ghdl_Bool_Type)); + Do_Assign (Get_Associated_Expr (El)); + Inc_Var (Var_I); + Finish_Loop_Stmt (Label); + Close_Temp; + end; + return; + when others => + Error_Kind ("translate_array_aggregate_gen", El); + end case; + end if; + + -- Several choices.. + declare + Range_Type : Iir; + Var_Pos : O_Dnode; + Var_Len : O_Dnode; + Range_Ptr : Mnode; + Rtinfo : Type_Info_Acc; + If_Blk : O_If_Block; + Case_Blk : O_Case_Block; + Label : O_Snode; + El_Assoc : Iir; + Len_Tmp : O_Enode; + begin + 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); + + Len_Tmp := M2E (Chap3.Range_To_Length (Range_Ptr)); + New_Assign_Stmt (New_Obj (Var_Len), Len_Tmp); + + -- 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)); + + -- convert aggr into a case statement. + Start_Case_Stmt (Case_Blk, New_Obj_Value (Var_Pos)); + El_Assoc := Null_Iir; + while El /= Null_Iir loop + Start_Choice (Case_Blk); + Chap8.Translate_Case_Choice (El, Range_Type, Case_Blk); + if Get_Associated_Expr (El) /= Null_Iir then + El_Assoc := Get_Associated_Expr (El); + end if; + Finish_Choice (Case_Blk); + Do_Assign (El_Assoc); + El := Get_Chain (El); + end loop; + Finish_Case_Stmt (Case_Blk); + -- Update var_pos Start_If_Stmt (If_Blk, New_Compare_Op (ON_Eq, 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 (P), + Chap8.Gen_Update_Iterator (Var_Pos, Iir_To, Unsigned_64 (1), Range_Type); New_Else_Stmt (If_Blk); - Chap8.Gen_Update_Iterator (Var_Pos, Iir_Downto, Unsigned_64 (P), + Chap8.Gen_Update_Iterator (Var_Pos, Iir_Downto, Unsigned_64 (1), Range_Type); Finish_If_Stmt (If_Blk); - end if; + Dec_Var (Var_Len); + Finish_Loop_Stmt (Label); + Close_Temp; + end; + end Translate_Array_Aggregate_Gen_Named; - Len_Tmp := M2E (Chap3.Range_To_Length (Range_Ptr)); - if P /= 0 then - Len_Tmp := New_Dyadic_Op - (ON_Sub_Ov, - Len_Tmp, - New_Lit (New_Unsigned_Literal (Ghdl_Index_Type, - Unsigned_64 (P)))); - end if; - New_Assign_Stmt (New_Obj (Var_Len), Len_Tmp); + Assocs : Iir; + begin + if Get_Kind (Aggr) = Iir_Kind_String_Literal8 then + Translate_Array_Aggregate_Gen_String + (Base_Ptr, Aggr, Aggr_Type, Var_Index); + return; + end if; - -- 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)); - - -- convert aggr into a case statement. - Start_Case_Stmt (Case_Blk, New_Obj_Value (Var_Pos)); - El_Assoc := Null_Iir; - while El /= Null_Iir loop - Start_Choice (Case_Blk); - Chap8.Translate_Case_Choice (El, Range_Type, Case_Blk); - if Get_Associated_Expr (El) /= Null_Iir then - El_Assoc := Get_Associated_Expr (El); - end if; - Finish_Choice (Case_Blk); - Do_Assign (El_Assoc); - P := P + 1; - El := Get_Chain (El); - end loop; - Finish_Case_Stmt (Case_Blk); - -- Update var_pos - Start_If_Stmt - (If_Blk, - New_Compare_Op (ON_Eq, - 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_Else_Stmt (If_Blk); - Chap8.Gen_Update_Iterator (Var_Pos, Iir_Downto, Unsigned_64 (1), - Range_Type); - Finish_If_Stmt (If_Blk); - New_Assign_Stmt - (New_Obj (Var_Len), - New_Dyadic_Op (ON_Sub_Ov, - New_Obj_Value (Var_Len), - New_Lit (Ghdl_Index_1))); - Finish_Loop_Stmt (Label); - Close_Temp; - end; + pragma Assert (Get_Kind (Aggr) = Iir_Kind_Aggregate); + + Index_List := Get_Index_Subtype_List (Aggr_Type); + + -- FINAL is true if the elements of the aggregate are elements of + -- the array. + if Get_Nbr_Elements (Index_List) = Dim then + Expr_Type := Get_Element_Subtype (Aggr_Type); + Final:= True; + else + Final := False; + end if; + + Assocs := Get_Association_Choices_Chain (Aggr); + + case Get_Kind (Assocs) is + when Iir_Kind_Choice_By_None + | Iir_Kind_Choice_By_Others => + Translate_Array_Aggregate_Gen_Positional; + when others => + Translate_Array_Aggregate_Gen_Named; + end case; end Translate_Array_Aggregate_Gen; procedure Translate_Record_Aggregate (Target : Mnode; Aggr : Iir) |