From 7c4f32677bb64c3423893441541d520097f238c5 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Fri, 23 Apr 2021 08:17:28 -0400 Subject: [PATCH] [Ada] Clean up Get_Index_Bounds gcc/ada/ * checks.adb, exp_aggr.adb, exp_ch5.adb, freeze.adb, sem_util.adb, sem_util.ads: Change L and H to be First and Last, to match the attributes in the RM. Change calls from procedure to function where appropriate. --- gcc/ada/checks.adb | 69 +++++----- gcc/ada/exp_aggr.adb | 381 ++++++++++++++++++++++++++------------------------- gcc/ada/exp_ch5.adb | 43 +++--- gcc/ada/freeze.adb | 10 +- gcc/ada/sem_util.adb | 4 +- gcc/ada/sem_util.ads | 4 +- 6 files changed, 266 insertions(+), 245 deletions(-) diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 1a39a82..6c49e67 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -9931,8 +9931,7 @@ package body Checks is declare Indx_Type : Node_Id; - Lo : Node_Id; - Hi : Node_Id; + Bounds : Range_Nodes; Do_Expand : Boolean := False; begin @@ -9942,37 +9941,38 @@ package body Checks is Next_Index (Indx_Type); end loop; - Get_Index_Bounds (Indx_Type, Lo, Hi); + Bounds := Get_Index_Bounds (Indx_Type); - if Nkind (Lo) = N_Identifier - and then Ekind (Entity (Lo)) = E_In_Parameter + if Nkind (Bounds.First) = N_Identifier + and then Ekind (Entity (Bounds.First)) = E_In_Parameter then - Lo := Get_Discriminal (E, Lo); + Bounds.First := Get_Discriminal (E, Bounds.First); Do_Expand := True; end if; - if Nkind (Hi) = N_Identifier - and then Ekind (Entity (Hi)) = E_In_Parameter + if Nkind (Bounds.Last) = N_Identifier + and then Ekind (Entity (Bounds.Last)) = E_In_Parameter then - Hi := Get_Discriminal (E, Hi); + Bounds.Last := Get_Discriminal (E, Bounds.Last); Do_Expand := True; end if; if Do_Expand then - if not Is_Entity_Name (Lo) then - Lo := Duplicate_Subexpr_No_Checks (Lo); + if not Is_Entity_Name (Bounds.First) then + Bounds.First := + Duplicate_Subexpr_No_Checks (Bounds.First); end if; - if not Is_Entity_Name (Hi) then - Lo := Duplicate_Subexpr_No_Checks (Hi); + if not Is_Entity_Name (Bounds.Last) then + Bounds.First := Duplicate_Subexpr_No_Checks (Bounds.Last); end if; N := Make_Op_Add (Loc, Left_Opnd => Make_Op_Subtract (Loc, - Left_Opnd => Hi, - Right_Opnd => Lo), + Left_Opnd => Bounds.Last, + Right_Opnd => Bounds.First), Right_Opnd => Make_Integer_Literal (Loc, 1)); return N; @@ -10215,10 +10215,8 @@ package body Checks is L_Index : Node_Id; R_Index : Node_Id; - L_Low : Node_Id; - L_High : Node_Id; - R_Low : Node_Id; - R_High : Node_Id; + L_Bounds : Range_Nodes; + R_Bounds : Range_Nodes; L_Length : Uint; R_Length : Uint; Ref_Node : Node_Id; @@ -10250,29 +10248,33 @@ package body Checks is or else Nkind (R_Index) = N_Raise_Constraint_Error) then - Get_Index_Bounds (L_Index, L_Low, L_High); - Get_Index_Bounds (R_Index, R_Low, R_High); + L_Bounds := Get_Index_Bounds (L_Index); + R_Bounds := Get_Index_Bounds (R_Index); -- Deal with compile time length check. Note that we -- skip this in the access case, because the access -- value may be null, so we cannot know statically. if not Do_Access - and then Compile_Time_Known_Value (L_Low) - and then Compile_Time_Known_Value (L_High) - and then Compile_Time_Known_Value (R_Low) - and then Compile_Time_Known_Value (R_High) + and then Compile_Time_Known_Value (L_Bounds.First) + and then Compile_Time_Known_Value (L_Bounds.Last) + and then Compile_Time_Known_Value (R_Bounds.First) + and then Compile_Time_Known_Value (R_Bounds.Last) then - if Expr_Value (L_High) >= Expr_Value (L_Low) then - L_Length := Expr_Value (L_High) - - Expr_Value (L_Low) + 1; + if Expr_Value (L_Bounds.Last) >= + Expr_Value (L_Bounds.First) + then + L_Length := Expr_Value (L_Bounds.Last) - + Expr_Value (L_Bounds.First) + 1; else L_Length := UI_From_Int (0); end if; - if Expr_Value (R_High) >= Expr_Value (R_Low) then - R_Length := Expr_Value (R_High) - - Expr_Value (R_Low) + 1; + if Expr_Value (R_Bounds.Last) >= + Expr_Value (R_Bounds.First) + then + R_Length := Expr_Value (R_Bounds.Last) - + Expr_Value (R_Bounds.First) + 1; else R_Length := UI_From_Int (0); end if; @@ -10304,8 +10306,9 @@ package body Checks is (Etype (L_Index), Etype (R_Index)) and then not - (Same_Bounds (L_Low, R_Low) - and then Same_Bounds (L_High, R_High)) + (Same_Bounds (L_Bounds.First, R_Bounds.First) + and then + Same_Bounds (L_Bounds.Last, R_Bounds.Last)) then Evolve_Or_Else (Cond, Length_E_Cond (Exptyp, T_Typ, Indx)); diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 56ec1be..7978b1c 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -375,15 +375,6 @@ package body Exp_Aggr is -- specifically optimized for the target. function Aggr_Assignment_OK_For_Backend (N : Node_Id) return Boolean is - Csiz : Uint := No_Uint; - Ctyp : Entity_Id; - Expr : Node_Id; - High : Node_Id; - Index : Entity_Id; - Low : Node_Id; - Nunits : Int; - Remainder : Uint; - Value : Uint; function Is_OK_Aggregate (Aggr : Node_Id) return Boolean; -- Return true if Aggr is suitable for back-end assignment @@ -422,6 +413,15 @@ package body Exp_Aggr is return Nkind (First (Assoc)) /= N_Iterated_Component_Association; end Is_OK_Aggregate; + Bounds : Range_Nodes; + Csiz : Uint := No_Uint; + Ctyp : Entity_Id; + Expr : Node_Id; + Index : Entity_Id; + Nunits : Int; + Remainder : Uint; + Value : Uint; + -- Start of processing for Aggr_Assignment_OK_For_Backend begin @@ -444,9 +444,9 @@ package body Exp_Aggr is Index := First_Index (Ctyp); while Present (Index) loop - Get_Index_Bounds (Index, Low, High); + Bounds := Get_Index_Bounds (Index); - if Is_Null_Range (Low, High) then + if Is_Null_Range (Bounds.First, Bounds.Last) then return False; end if; @@ -2282,10 +2282,12 @@ package body Exp_Aggr is Assoc : Node_Id; Choice : Node_Id; Expr : Node_Id; - High : Node_Id; - Low : Node_Id; Typ : Entity_Id; + Bounds : Range_Nodes; + Low : Node_Id renames Bounds.First; + High : Node_Id renames Bounds.Last; + Nb_Choices : Nat := 0; Table : Case_Table_Type (1 .. Number_Of_Choices (N)); -- Used to sort all the different choice values @@ -2347,7 +2349,7 @@ package body Exp_Aggr is exit; end if; - Get_Index_Bounds (Choice, Low, High); + Bounds := Get_Index_Bounds (Choice); if Low /= High then Set_Loop_Actions (Assoc, New_List); @@ -4508,11 +4510,9 @@ package body Exp_Aggr is Is_Array : constant Boolean := Is_Array_Type (Etype (N)); Aggr_In : Node_Id; - Aggr_Lo : Node_Id; - Aggr_Hi : Node_Id; + Aggr_Bounds : Range_Nodes; Obj_In : Node_Id; - Obj_Lo : Node_Id; - Obj_Hi : Node_Id; + Obj_Bounds : Range_Nodes; Parent_Kind : Node_Kind; Parent_Node : Node_Id; @@ -4823,16 +4823,17 @@ package body Exp_Aggr is end if; while Present (Aggr_In) loop - Get_Index_Bounds (Aggr_In, Aggr_Lo, Aggr_Hi); - Get_Index_Bounds (Obj_In, Obj_Lo, Obj_Hi); + Aggr_Bounds := Get_Index_Bounds (Aggr_In); + Obj_Bounds := Get_Index_Bounds (Obj_In); -- We require static bounds for the target and a static matching -- of low bound for the aggregate. - if not Compile_Time_Known_Value (Obj_Lo) - or else not Compile_Time_Known_Value (Obj_Hi) - or else not Compile_Time_Known_Value (Aggr_Lo) - or else Expr_Value (Aggr_Lo) /= Expr_Value (Obj_Lo) + if not Compile_Time_Known_Value (Obj_Bounds.First) + or else not Compile_Time_Known_Value (Obj_Bounds.Last) + or else not Compile_Time_Known_Value (Aggr_Bounds.First) + or else Expr_Value (Aggr_Bounds.First) /= + Expr_Value (Obj_Bounds.First) then return False; @@ -4848,8 +4849,9 @@ package body Exp_Aggr is elsif Parent_Kind = N_Assignment_Statement or else Is_Constrained (Etype (Parent_Node)) then - if not Compile_Time_Known_Value (Aggr_Hi) - or else Expr_Value (Aggr_Hi) /= Expr_Value (Obj_Hi) + if not Compile_Time_Known_Value (Aggr_Bounds.Last) + or else Expr_Value (Aggr_Bounds.Last) /= + Expr_Value (Obj_Bounds.Last) then return False; end if; @@ -5692,7 +5694,7 @@ package body Exp_Aggr is -- type using the computable sizes of the aggregate and its sub- -- aggregates. - procedure Check_Bounds (Aggr_Bounds : Node_Id; Index_Bounds : Node_Id); + procedure Check_Bounds (Aggr_Bounds_Node, Index_Bounds_Node : Node_Id); -- Checks that the bounds of Aggr_Bounds are within the bounds defined -- by Index_Bounds. @@ -5792,55 +5794,58 @@ package body Exp_Aggr is -- Check_Bounds -- ------------------ - procedure Check_Bounds (Aggr_Bounds : Node_Id; Index_Bounds : Node_Id) is - Aggr_Lo : Node_Id; - Aggr_Hi : Node_Id; - - Ind_Lo : Node_Id; - Ind_Hi : Node_Id; + procedure Check_Bounds (Aggr_Bounds_Node, Index_Bounds_Node : Node_Id) is + Aggr_Bounds : constant Range_Nodes := + Get_Index_Bounds (Aggr_Bounds_Node); + Ind_Bounds : constant Range_Nodes := + Get_Index_Bounds (Index_Bounds_Node); - Cond : Node_Id := Empty; + Cond : Node_Id := Empty; begin - Get_Index_Bounds (Aggr_Bounds, Aggr_Lo, Aggr_Hi); - Get_Index_Bounds (Index_Bounds, Ind_Lo, Ind_Hi); - -- Generate the following test: -- [constraint_error when - -- Aggr_Lo <= Aggr_Hi and then - -- (Aggr_Lo < Ind_Lo or else Aggr_Hi > Ind_Hi)] + -- Aggr_Bounds.First <= Aggr_Bounds.Last and then + -- (Aggr_Bounds.First < Ind_Bounds.First + -- or else Aggr_Bounds.Last > Ind_Bounds.Last)] -- As an optimization try to see if some tests are trivially vacuous -- because we are comparing an expression against itself. - if Aggr_Lo = Ind_Lo and then Aggr_Hi = Ind_Hi then + if Aggr_Bounds.First = Ind_Bounds.First + and then Aggr_Bounds.Last = Ind_Bounds.Last + then Cond := Empty; - elsif Aggr_Hi = Ind_Hi then + elsif Aggr_Bounds.Last = Ind_Bounds.Last then Cond := Make_Op_Lt (Loc, - Left_Opnd => Duplicate_Subexpr_Move_Checks (Aggr_Lo), - Right_Opnd => Duplicate_Subexpr_Move_Checks (Ind_Lo)); + Left_Opnd => + Duplicate_Subexpr_Move_Checks (Aggr_Bounds.First), + Right_Opnd => + Duplicate_Subexpr_Move_Checks (Ind_Bounds.First)); - elsif Aggr_Lo = Ind_Lo then + elsif Aggr_Bounds.First = Ind_Bounds.First then Cond := Make_Op_Gt (Loc, - Left_Opnd => Duplicate_Subexpr_Move_Checks (Aggr_Hi), - Right_Opnd => Duplicate_Subexpr_Move_Checks (Ind_Hi)); + Left_Opnd => Duplicate_Subexpr_Move_Checks (Aggr_Bounds.Last), + Right_Opnd => Duplicate_Subexpr_Move_Checks (Ind_Bounds.Last)); else Cond := Make_Or_Else (Loc, Left_Opnd => Make_Op_Lt (Loc, - Left_Opnd => Duplicate_Subexpr_Move_Checks (Aggr_Lo), - Right_Opnd => Duplicate_Subexpr_Move_Checks (Ind_Lo)), + Left_Opnd => + Duplicate_Subexpr_Move_Checks (Aggr_Bounds.First), + Right_Opnd => + Duplicate_Subexpr_Move_Checks (Ind_Bounds.First)), Right_Opnd => Make_Op_Gt (Loc, - Left_Opnd => Duplicate_Subexpr (Aggr_Hi), - Right_Opnd => Duplicate_Subexpr (Ind_Hi))); + Left_Opnd => Duplicate_Subexpr (Aggr_Bounds.Last), + Right_Opnd => Duplicate_Subexpr (Ind_Bounds.Last))); end if; if Present (Cond) then @@ -5848,8 +5853,10 @@ package body Exp_Aggr is Make_And_Then (Loc, Left_Opnd => Make_Op_Le (Loc, - Left_Opnd => Duplicate_Subexpr_Move_Checks (Aggr_Lo), - Right_Opnd => Duplicate_Subexpr_Move_Checks (Aggr_Hi)), + Left_Opnd => + Duplicate_Subexpr_Move_Checks (Aggr_Bounds.First), + Right_Opnd => + Duplicate_Subexpr_Move_Checks (Aggr_Bounds.Last)), Right_Opnd => Cond); @@ -6116,8 +6123,6 @@ package body Exp_Aggr is -- Used to sort all the different choice values J : Pos := 1; - Low : Node_Id; - High : Node_Id; begin Assoc := First (Component_Associations (Sub_Aggr)); @@ -6128,9 +6133,13 @@ package body Exp_Aggr is exit; end if; - Get_Index_Bounds (Choice, Low, High); - Table (J).Choice_Lo := Low; - Table (J).Choice_Hi := High; + declare + Bounds : constant Range_Nodes := + Get_Index_Bounds (Choice); + begin + Table (J).Choice_Lo := Bounds.First; + Table (J).Choice_Hi := Bounds.Last; + end; J := J + 1; Next (Choice); @@ -9144,14 +9153,6 @@ package body Exp_Aggr is declare Csiz : constant Nat := UI_To_Int (Component_Size (Typ)); - Lo : Node_Id; - Hi : Node_Id; - -- Bounds of index type - - Lob : Uint; - Hib : Uint; - -- Values of bounds if compile time known - function Get_Component_Val (N : Node_Id) return Uint; -- Given a expression value N of the component type Ctyp, returns a -- value of Csiz (component size) bits representing this value. If @@ -9193,147 +9194,154 @@ package body Exp_Aggr is return Val mod Uint_2 ** Csiz; end Get_Component_Val; + Bounds : constant Range_Nodes := Get_Index_Bounds (First_Index (Typ)); + -- Here we know we have a one dimensional bit packed array begin - Get_Index_Bounds (First_Index (Typ), Lo, Hi); - -- Cannot do anything if bounds are dynamic - if not Compile_Time_Known_Value (Lo) - or else - not Compile_Time_Known_Value (Hi) + if not (Compile_Time_Known_Value (Bounds.First) + and then + Compile_Time_Known_Value (Bounds.Last)) then return False; end if; - -- Or are silly out of range of int bounds - - Lob := Expr_Value (Lo); - Hib := Expr_Value (Hi); - - if not UI_Is_In_Int_Range (Lob) - or else - not UI_Is_In_Int_Range (Hib) - then - return False; - end if; + declare + Bounds_Vals : Range_Values; + -- Compile-time known values of bounds + begin + -- Or are silly out of range of int bounds - -- At this stage we have a suitable aggregate for handling at compile - -- time. The only remaining checks are that the values of expressions - -- in the aggregate are compile-time known (checks are performed by - -- Get_Component_Val), and that any subtypes or ranges are statically - -- known. + Bounds_Vals.First := Expr_Value (Bounds.First); + Bounds_Vals.Last := Expr_Value (Bounds.Last); - -- If the aggregate is not fully positional at this stage, then - -- convert it to positional form. Either this will fail, in which - -- case we can do nothing, or it will succeed, in which case we have - -- succeeded in handling the aggregate and transforming it into a - -- modular value, or it will stay an aggregate, in which case we - -- have failed to create a packed value for it. + if not UI_Is_In_Int_Range (Bounds_Vals.First) + or else + not UI_Is_In_Int_Range (Bounds_Vals.Last) + then + return False; + end if; - if Present (Component_Associations (N)) then - Convert_To_Positional (N, Handle_Bit_Packed => True); - return Nkind (N) /= N_Aggregate; - end if; + -- At this stage we have a suitable aggregate for handling at + -- compile time. The only remaining checks are that the values of + -- expressions in the aggregate are compile-time known (checks are + -- performed by Get_Component_Val), and that any subtypes or + -- ranges are statically known. - -- Otherwise we are all positional, so convert to proper value + -- If the aggregate is not fully positional at this stage, then + -- convert it to positional form. Either this will fail, in which + -- case we can do nothing, or it will succeed, in which case we + -- have succeeded in handling the aggregate and transforming it + -- into a modular value, or it will stay an aggregate, in which + -- case we have failed to create a packed value for it. - declare - Lov : constant Int := UI_To_Int (Lob); - Hiv : constant Int := UI_To_Int (Hib); + if Present (Component_Associations (N)) then + Convert_To_Positional (N, Handle_Bit_Packed => True); + return Nkind (N) /= N_Aggregate; + end if; - Len : constant Nat := Int'Max (0, Hiv - Lov + 1); - -- The length of the array (number of elements) + -- Otherwise we are all positional, so convert to proper value - Aggregate_Val : Uint; - -- Value of aggregate. The value is set in the low order bits of - -- this value. For the little-endian case, the values are stored - -- from low-order to high-order and for the big-endian case the - -- values are stored from high-order to low-order. Note that gigi - -- will take care of the conversions to left justify the value in - -- the big endian case (because of left justified modular type - -- processing), so we do not have to worry about that here. + declare + Len : constant Nat := + Int'Max (0, UI_To_Int (Bounds_Vals.Last) - + UI_To_Int (Bounds_Vals.First) + 1); + -- The length of the array (number of elements) - Lit : Node_Id; - -- Integer literal for resulting constructed value + Aggregate_Val : Uint; + -- Value of aggregate. The value is set in the low order bits + -- of this value. For the little-endian case, the values are + -- stored from low-order to high-order and for the big-endian + -- case the values are stored from high order to low order. + -- Note that gigi will take care of the conversions to left + -- justify the value in the big endian case (because of left + -- justified modular type processing), so we do not have to + -- worry about that here. - Shift : Nat; - -- Shift count from low order for next value + Lit : Node_Id; + -- Integer literal for resulting constructed value - Incr : Int; - -- Shift increment for loop + Shift : Nat; + -- Shift count from low order for next value - Expr : Node_Id; - -- Next expression from positional parameters of aggregate + Incr : Int; + -- Shift increment for loop - Left_Justified : Boolean; - -- Set True if we are filling the high order bits of the target - -- value (i.e. the value is left justified). + Expr : Node_Id; + -- Next expression from positional parameters of aggregate - begin - -- For little endian, we fill up the low order bits of the target - -- value. For big endian we fill up the high order bits of the - -- target value (which is a left justified modular value). + Left_Justified : Boolean; + -- Set True if we are filling the high order bits of the target + -- value (i.e. the value is left justified). - Left_Justified := Bytes_Big_Endian; + begin + -- For little endian, we fill up the low order bits of the + -- target value. For big endian we fill up the high order bits + -- of the target value (which is a left justified modular + -- value). - -- Switch justification if using -gnatd8 + Left_Justified := Bytes_Big_Endian; - if Debug_Flag_8 then - Left_Justified := not Left_Justified; - end if; + -- Switch justification if using -gnatd8 - -- Switch justfification if reverse storage order + if Debug_Flag_8 then + Left_Justified := not Left_Justified; + end if; - if Reverse_Storage_Order (Base_Type (Typ)) then - Left_Justified := not Left_Justified; - end if; + -- Switch justfification if reverse storage order - if Left_Justified then - Shift := Csiz * (Len - 1); - Incr := -Csiz; - else - Shift := 0; - Incr := +Csiz; - end if; + if Reverse_Storage_Order (Base_Type (Typ)) then + Left_Justified := not Left_Justified; + end if; - -- Loop to set the values + if Left_Justified then + Shift := Csiz * (Len - 1); + Incr := -Csiz; + else + Shift := 0; + Incr := +Csiz; + end if; - if Len = 0 then - Aggregate_Val := Uint_0; - else - Expr := First (Expressions (N)); - Aggregate_Val := Get_Component_Val (Expr) * Uint_2 ** Shift; + -- Loop to set the values - for J in 2 .. Len loop - Shift := Shift + Incr; - Next (Expr); - Aggregate_Val := - Aggregate_Val + Get_Component_Val (Expr) * Uint_2 ** Shift; - end loop; - end if; + if Len = 0 then + Aggregate_Val := Uint_0; + else + Expr := First (Expressions (N)); + Aggregate_Val := Get_Component_Val (Expr) * Uint_2 ** Shift; + + for J in 2 .. Len loop + Shift := Shift + Incr; + Next (Expr); + Aggregate_Val := + Aggregate_Val + + Get_Component_Val (Expr) * Uint_2 ** Shift; + end loop; + end if; - -- Now we can rewrite with the proper value + -- Now we can rewrite with the proper value - Lit := Make_Integer_Literal (Loc, Intval => Aggregate_Val); - Set_Print_In_Hex (Lit); + Lit := Make_Integer_Literal (Loc, Intval => Aggregate_Val); + Set_Print_In_Hex (Lit); - -- Construct the expression using this literal. Note that it is - -- important to qualify the literal with its proper modular type - -- since universal integer does not have the required range and - -- also this is a left justified modular type, which is important - -- in the big-endian case. + -- Construct the expression using this literal. Note that it + -- is important to qualify the literal with its proper modular + -- type since universal integer does not have the required + -- range and also this is a left justified modular type, + -- which is important in the big-endian case. - Rewrite (N, - Unchecked_Convert_To (Typ, - Make_Qualified_Expression (Loc, - Subtype_Mark => - New_Occurrence_Of (Packed_Array_Impl_Type (Typ), Loc), - Expression => Lit))); + Rewrite (N, + Unchecked_Convert_To (Typ, + Make_Qualified_Expression (Loc, + Subtype_Mark => + New_Occurrence_Of (Packed_Array_Impl_Type (Typ), Loc), + Expression => Lit))); - Analyze_And_Resolve (N, Typ); - return True; + Analyze_And_Resolve (N, Typ); + return True; + end; end; end; @@ -9408,8 +9416,6 @@ package body Exp_Aggr is (Obj_Type : Entity_Id; Typ : Entity_Id) return Boolean is - L1, L2, H1, H2 : Node_Id; - begin -- No sliding if the type of the object is not established yet, if it is -- an unconstrained type whose actual subtype comes from the aggregate, @@ -9427,20 +9433,25 @@ package body Exp_Aggr is else -- Sliding can only occur along the first dimension - Get_Index_Bounds (First_Index (Typ), L1, H1); - Get_Index_Bounds (First_Index (Obj_Type), L2, H2); + declare + Bounds1 : constant Range_Nodes := + Get_Index_Bounds (First_Index (Typ)); + Bounds2 : constant Range_Nodes := + Get_Index_Bounds (First_Index (Obj_Type)); - if not Is_OK_Static_Expression (L1) or else - not Is_OK_Static_Expression (L2) or else - not Is_OK_Static_Expression (H1) or else - not Is_OK_Static_Expression (H2) - then - return False; - else - return Expr_Value (L1) /= Expr_Value (L2) - or else - Expr_Value (H1) /= Expr_Value (H2); - end if; + begin + if not Is_OK_Static_Expression (Bounds1.First) or else + not Is_OK_Static_Expression (Bounds2.First) or else + not Is_OK_Static_Expression (Bounds1.Last) or else + not Is_OK_Static_Expression (Bounds2.Last) + then + return False; + else + return Expr_Value (Bounds1.First) /= Expr_Value (Bounds2.First) + or else + Expr_Value (Bounds1.Last) /= Expr_Value (Bounds2.Last); + end if; + end; end if; end Must_Slide; diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 0070706..4eba6fb 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -1500,12 +1500,13 @@ package body Exp_Ch5 is (if Nkind (Name (N)) = N_Slice then Get_Index_Bounds (Discrete_Range (Name (N))) else Larray_Bounds); - -- If the left-hand side is A (L..H), Larray_Bounds is A'Range, and - -- L_Bounds is L..H. If it's not a slice, we treat it like a slice - -- starting at A'First. + -- If the left-hand side is A (First..Last), Larray_Bounds is A'Range, + -- and L_Bounds is First..Last. If it's not a slice, we treat it like + -- a slice starting at A'First. L_Bit : constant Node_Id := - Make_Integer_Literal (Loc, (L_Bounds.L - Larray_Bounds.L) * C_Size); + Make_Integer_Literal + (Loc, (L_Bounds.First - Larray_Bounds.First) * C_Size); Rarray_Bounds : constant Range_Values := Get_Index_Bounds (First_Index (R_Typ)); @@ -1515,7 +1516,8 @@ package body Exp_Ch5 is else Rarray_Bounds); R_Bit : constant Node_Id := - Make_Integer_Literal (Loc, (R_Bounds.L - Rarray_Bounds.L) * C_Size); + Make_Integer_Literal + (Loc, (R_Bounds.First - Rarray_Bounds.First) * C_Size); Size : constant Node_Id := Make_Op_Multiply (Loc, @@ -1594,17 +1596,21 @@ package body Exp_Ch5 is Rev : Boolean) return Node_Id is + L : constant Node_Id := Name (N); + R : constant Node_Id := Expression (N); + -- Left- and right-hand sides of the assignment statement + Slices : constant Boolean := - Nkind (Name (N)) = N_Slice or else Nkind (Expression (N)) = N_Slice; + Nkind (L) = N_Slice or else Nkind (R) = N_Slice; L_Prefix_Comp : constant Boolean := -- True if the left-hand side is a slice of a component or slice - Nkind (Name (N)) = N_Slice - and then Nkind (Prefix (Name (N))) in + Nkind (L) = N_Slice + and then Nkind (Prefix (L)) in N_Selected_Component | N_Indexed_Component | N_Slice; R_Prefix_Comp : constant Boolean := -- Likewise for the right-hand side - Nkind (Expression (N)) = N_Slice - and then Nkind (Prefix (Expression (N))) in + Nkind (R) = N_Slice + and then Nkind (Prefix (R)) in N_Selected_Component | N_Indexed_Component | N_Slice; begin @@ -1664,27 +1670,28 @@ package body Exp_Ch5 is Get_Index_Bounds (Right_Base_Index); Known_Left_Slice_Low : constant Boolean := - (if Nkind (Name (N)) = N_Slice + (if Nkind (L) = N_Slice then Compile_Time_Known_Value - (Get_Index_Bounds (Discrete_Range (Name (N))).L)); + (Get_Index_Bounds (Discrete_Range (L)).First)); Known_Right_Slice_Low : constant Boolean := - (if Nkind (Expression (N)) = N_Slice + (if Nkind (R) = N_Slice then Compile_Time_Known_Value - (Get_Index_Bounds (Discrete_Range (Expression (N))).H)); + (Get_Index_Bounds (Discrete_Range (R)).Last)); Val_Bits : constant Pos := Standard_Long_Long_Integer_Size / 2; begin - if Left_Base_Range.H - Left_Base_Range.L < Val_Bits - and then Right_Base_Range.H - Right_Base_Range.L < Val_Bits + if Left_Base_Range.Last - Left_Base_Range.First < Val_Bits + and then Right_Base_Range.Last - Right_Base_Range.First < + Val_Bits and then Known_Esize (L_Type) and then Known_Esize (R_Type) and then Known_Left_Slice_Low and then Known_Right_Slice_Low and then Compile_Time_Known_Value - (Get_Index_Bounds (First_Index (Etype (Larray))).L) + (Get_Index_Bounds (First_Index (Etype (Larray))).First) and then Compile_Time_Known_Value - (Get_Index_Bounds (First_Index (Etype (Rarray))).L) + (Get_Index_Bounds (First_Index (Etype (Rarray))).First) and then not (Is_Enumeration_Type (Etype (Left_Base_Index)) and then Has_Enumeration_Rep_Clause diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 81e0e87..23b64a0 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -867,11 +867,8 @@ package body Freeze is ---------------- function Size_Known (T : Entity_Id) return Boolean is - Index : Entity_Id; Comp : Entity_Id; Ctyp : Entity_Id; - Low : Node_Id; - High : Node_Id; begin if Size_Known_At_Compile_Time (T) then @@ -918,8 +915,11 @@ package body Freeze is -- thus may be packable). declare - Size : Uint := Component_Size (T); - Dim : Uint; + Index : Entity_Id; + Low : Node_Id; + High : Node_Id; + Size : Uint := Component_Size (T); + Dim : Uint; begin Index := First_Index (T); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index e7e0c84..c0bc4b7 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -10978,7 +10978,7 @@ package body Sem_Util is Use_Full_View : Boolean := False) return Range_Nodes is Result : Range_Nodes; begin - Get_Index_Bounds (N, Result.L, Result.H, Use_Full_View); + Get_Index_Bounds (N, Result.First, Result.Last, Use_Full_View); return Result; end Get_Index_Bounds; @@ -10987,7 +10987,7 @@ package body Sem_Util is Use_Full_View : Boolean := False) return Range_Values is Nodes : constant Range_Nodes := Get_Index_Bounds (N, Use_Full_View); begin - return (Expr_Value (Nodes.L), Expr_Value (Nodes.H)); + return (Expr_Value (Nodes.First), Expr_Value (Nodes.Last)); end Get_Index_Bounds; ----------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 9f15f44..10f1ba5 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1177,11 +1177,11 @@ package Sem_Util is -- arise during normal compilation of semantically correct programs. type Range_Nodes is record - L, H : Node_Id; -- First and Last nodes of a discrete_range + First, Last : Node_Id; -- First and Last nodes of a discrete_range end record; type Range_Values is record - L, H : Uint; -- First and Last values of a discrete_range + First, Last : Uint; -- First and Last values of a discrete_range end record; function Get_Index_Bounds -- 2.7.4