public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-2009] [Ada] Clean up Get_Index_Bounds
@ 2021-07-05 13:13 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-07-05 13:13 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:7c4f32677bb64c3423893441541d520097f238c5
commit r12-2009-g7c4f32677bb64c3423893441541d520097f238c5
Author: Bob Duff <duff@adacore.com>
Date: Fri Apr 23 08:17:28 2021 -0400
[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.
Diff:
---
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 1a39a821f39..6c49e671e91 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 56ec1be5d7f..7978b1caf7c 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 00707060f1c..4eba6fb4208 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 81e0e87d4d1..23b64a0034d 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 e7e0c844301..c0bc4b77f97 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 9f15f440613..10f1ba52795 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
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-07-05 13:13 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-07-05 13:13 [gcc r12-2009] [Ada] Clean up Get_Index_Bounds Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).