public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-6458] [Ada] Remove unnecessary block in code for expansion of allocators
@ 2022-01-11 13:27 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2022-01-11 13:27 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:6e82658607075193c2bc85041b045ab748b14600
commit r12-6458-g6e82658607075193c2bc85041b045ab748b14600
Author: Piotr Trojanek <trojanek@adacore.com>
Date: Tue Jan 4 23:31:33 2022 +0100
[Ada] Remove unnecessary block in code for expansion of allocators
gcc/ada/
* exp_ch4.adb (Size_In_Storage_Elements): Remove unnecessary
DECLARE block; refill code and comments.
Diff:
---
gcc/ada/exp_ch4.adb | 176 +++++++++++++++++++++++++---------------------------
1 file changed, 85 insertions(+), 91 deletions(-)
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 8b42db96822..18f0f746cae 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -4345,116 +4345,110 @@ package body Exp_Ch4 is
------------------------------
function Size_In_Storage_Elements (E : Entity_Id) return Node_Id is
+ Idx : Node_Id := First_Index (E);
+ Len : Node_Id;
+ Res : Node_Id := Empty;
+
begin
-- Logically this just returns E'Max_Size_In_Storage_Elements.
- -- However, the reason for the existence of this function is
- -- to construct a test for sizes too large, which means near the
- -- 32-bit limit on a 32-bit machine, and precisely the trouble
- -- is that we get overflows when sizes are greater than 2**31.
+ -- However, the reason for the existence of this function is to
+ -- construct a test for sizes too large, which means near the 32-bit
+ -- limit on a 32-bit machine, and precisely the trouble is that we
+ -- get overflows when sizes are greater than 2**31.
-- So what we end up doing for array types is to use the expression:
-- number-of-elements * component_type'Max_Size_In_Storage_Elements
-- which avoids this problem. All this is a bit bogus, but it does
- -- mean we catch common cases of trying to allocate arrays that
- -- are too large, and which in the absence of a check results in
+ -- mean we catch common cases of trying to allocate arrays that are
+ -- too large, and which in the absence of a check results in
-- undetected chaos ???
- declare
- Idx : Node_Id := First_Index (E);
- Len : Node_Id;
- Res : Node_Id := Empty;
+ for J in 1 .. Number_Dimensions (E) loop
- begin
- for J in 1 .. Number_Dimensions (E) loop
+ if not Is_Modular_Integer_Type (Etype (Idx)) then
+ Len :=
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (E, Loc),
+ Attribute_Name => Name_Length,
+ Expressions => New_List (Make_Integer_Literal (Loc, J)));
- if not Is_Modular_Integer_Type (Etype (Idx)) then
- Len :=
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (E, Loc),
- Attribute_Name => Name_Length,
- Expressions => New_List
- (Make_Integer_Literal (Loc, J)));
+ -- For indexes that are modular types we cannot generate code to
+ -- compute 'Length since for large arrays 'Last -'First + 1 causes
+ -- overflow; therefore we compute 'Last - 'First (which is not the
+ -- exact number of components but it is valid for the purpose of
+ -- this runtime check on 32-bit targets).
- -- For indexes that are modular types we cannot generate code
- -- to compute 'Length since for large arrays 'Last -'First + 1
- -- causes overflow; therefore we compute 'Last - 'First (which
- -- is not the exact number of components but it is valid for
- -- the purpose of this runtime check on 32-bit targets).
+ else
+ declare
+ Len_Minus_1_Expr : Node_Id;
+ Test_Gt : Node_Id;
- else
- declare
- Len_Minus_1_Expr : Node_Id;
- Test_Gt : Node_Id;
+ begin
+ Test_Gt :=
+ Make_Op_Gt (Loc,
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (E, Loc),
+ Attribute_Name => Name_Last,
+ Expressions =>
+ New_List (Make_Integer_Literal (Loc, J))),
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (E, Loc),
+ Attribute_Name => Name_First,
+ Expressions =>
+ New_List (Make_Integer_Literal (Loc, J))));
- begin
- Test_Gt :=
- Make_Op_Gt (Loc,
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (E, Loc),
- Attribute_Name => Name_Last,
- Expressions =>
- New_List (Make_Integer_Literal (Loc, J))),
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (E, Loc),
- Attribute_Name => Name_First,
- Expressions =>
- New_List (Make_Integer_Literal (Loc, J))));
-
- Len_Minus_1_Expr :=
- Convert_To (Standard_Unsigned,
- Make_Op_Subtract (Loc,
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (E, Loc),
- Attribute_Name => Name_Last,
- Expressions =>
- New_List
- (Make_Integer_Literal (Loc, J))),
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (E, Loc),
- Attribute_Name => Name_First,
- Expressions =>
- New_List
- (Make_Integer_Literal (Loc, J)))));
-
- -- Handle superflat arrays, i.e. arrays with such bounds
- -- as 4 .. 2, to ensure that the result is correct.
-
- -- Generate:
- -- (if X'Last > X'First then X'Last - X'First else 0)
-
- Len :=
- Make_If_Expression (Loc,
- Expressions => New_List (
- Test_Gt,
- Len_Minus_1_Expr,
- Make_Integer_Literal (Loc, Uint_0)));
- end;
- end if;
+ Len_Minus_1_Expr :=
+ Convert_To (Standard_Unsigned,
+ Make_Op_Subtract (Loc,
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (E, Loc),
+ Attribute_Name => Name_Last,
+ Expressions =>
+ New_List (Make_Integer_Literal (Loc, J))),
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (E, Loc),
+ Attribute_Name => Name_First,
+ Expressions =>
+ New_List (Make_Integer_Literal (Loc, J)))));
- if J = 1 then
- Res := Len;
+ -- Handle superflat arrays, i.e. arrays with such bounds as
+ -- 4 .. 2, to ensure that the result is correct.
- else
- pragma Assert (Present (Res));
- Res :=
- Make_Op_Multiply (Loc,
- Left_Opnd => Res,
- Right_Opnd => Len);
- end if;
+ -- Generate:
+ -- (if X'Last > X'First then X'Last - X'First else 0)
- Next_Index (Idx);
- end loop;
+ Len :=
+ Make_If_Expression (Loc,
+ Expressions => New_List (
+ Test_Gt,
+ Len_Minus_1_Expr,
+ Make_Integer_Literal (Loc, Uint_0)));
+ end;
+ end if;
- return
- Make_Op_Multiply (Loc,
- Left_Opnd => Len,
- Right_Opnd =>
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Component_Type (E), Loc),
- Attribute_Name => Name_Max_Size_In_Storage_Elements));
- end;
+ if J = 1 then
+ Res := Len;
+
+ else
+ pragma Assert (Present (Res));
+ Res :=
+ Make_Op_Multiply (Loc,
+ Left_Opnd => Res,
+ Right_Opnd => Len);
+ end if;
+
+ Next_Index (Idx);
+ end loop;
+
+ return
+ Make_Op_Multiply (Loc,
+ Left_Opnd => Len,
+ Right_Opnd =>
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Component_Type (E), Loc),
+ Attribute_Name => Name_Max_Size_In_Storage_Elements));
end Size_In_Storage_Elements;
-- Local variables
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-01-11 13:27 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-01-11 13:27 [gcc r12-6458] [Ada] Remove unnecessary block in code for expansion of allocators 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).