From 6cbd53c2277e5013d83fe73d5e73844066b651a7 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Wed, 3 Jul 2019 08:14:10 +0000 Subject: [PATCH] [Ada] Make loop labels unique for front-end inlined calls This patch transforms loop labels in the body of subprograms that are to be inlined by the front-end, to prevent accidental duplication of loop labels, which might make the resulting source illegal. ---- Source program: ---- package P is procedure Get_Rom_Addr_Offset with Inline_Always; end P; ---- package body P is procedure Get_Rom_Addr_Offset is X : Integer; begin Main_Block : for I in 1 .. 10 loop X := 2; exit Main_Block when I > 4; other_loop: for J in character'('a') .. 'z' loop if I < 5 then exit Main_Block when J = 'k'; else Exit Other_Loop; end if; end loop other_loop; end loop Main_Block; end Get_Rom_Addr_Offset; procedure P2 is begin Main_Block : for I in 1 .. 1 loop Get_Rom_Addr_Offset; end loop Main_Block; end P2; end P; ---- Command: gcc -c -gnatN -gnatd.u -gnatDG p.adb ---- Output ---- package body p is procedure p__get_rom_addr_offset is x : integer; other_loop : label main_block : label begin main_block : for i in 1 .. 10 loop x := 2; exit main_block when i > 4; other_loop : for j in 'a' .. 'z' loop if i < 5 then exit main_block when j = 'k'; else exit other_loop; end if; end loop other_loop; end loop main_block; return; end p__get_rom_addr_offset; procedure p__p2 is main_block : label begin main_block : for i in 1 .. 1 loop B6b : declare x : integer; other_loopL10b : label main_blockL9b : label begin main_blockL9b : for i in 1 .. 10 loop x := 2; exit main_blockL9b when i > 4; other_loopL10b : for j in 'a' .. 'z' loop if i < 5 then exit main_blockL9b when j = 'k'; else exit other_loopL10b; end if; end loop other_loopL10b; end loop main_blockL9b; end B6b; end loop main_block; return; end p__p2; begin null; end p; 2019-07-03 Ed Schonberg gcc/ada/ * inline.adb (Make_Loop_Labels_Unique): New procedure to modify the source code of subprograms that are inlined by the front-end, to prevent accidental duplication between loop labels in the inlined code and the code surrounding the inlined call. From-SVN: r272967 --- gcc/ada/ChangeLog | 7 ++++++ gcc/ada/inline.adb | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 69 insertions(+) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2115a38..443947c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-07-03 Ed Schonberg + + * inline.adb (Make_Loop_Labels_Unique): New procedure to modify + the source code of subprograms that are inlined by the + front-end, to prevent accidental duplication between loop labels + in the inlined code and the code surrounding the inlined call. + 2019-07-03 Hristian Kirtchev * doc/gnat_ugn/elaboration_order_handling_in_gnat.rst: Update diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 709513d..ae1c217 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -2381,6 +2381,11 @@ package body Inline is -- When generating C code, declare _Result, which may be used in the -- inlined _Postconditions procedure to verify the return value. + procedure Make_Loop_Labels_Unique (Stats : Node_Id); + -- When compiling for CCG and performing front-end inlining, replace + -- loop names and references to them so that they do not conflict + -- with homographs in the current subprogram. + procedure Make_Exit_Label; -- Build declaration for exit label to be used in Return statements, -- sets Exit_Lab (the label node) and Lab_Decl (corresponding implicit @@ -2474,6 +2479,59 @@ package body Inline is end if; end Make_Exit_Label; + ----------------------------- + -- Make_Loop_Labels_Unique -- + ----------------------------- + + procedure Make_Loop_Labels_Unique (Stats : Node_Id) is + S : Node_Id; + + function Process_Loop (N : Node_Id) return Traverse_Result; + + ------------------ + -- Process_Loop -- + ------------------ + + function Process_Loop (N : Node_Id) return Traverse_Result is + Id : Entity_Id; + + begin + if Nkind (N) = N_Loop_Statement + and then Present (Identifier (N)) + then + + -- Create new external name for loop. and update the + -- corresponding entity. + + Id := Entity (Identifier (N)); + Set_Chars (Id, New_External_Name (Chars (Id), 'L', -1)); + Set_Chars (Identifier (N), Chars (Id)); + + elsif Nkind (N) = N_Exit_Statement + and then Present (Name (N)) + then + + -- The exit statement must name an enclosing loop, whose + -- name has already been updated. + + Set_Chars (Name (N), Chars (Entity (Name (N)))); + end if; + + return OK; + end Process_Loop; + + procedure Update_Loop_Names is new Traverse_Proc (Process_Loop); + + begin + if Modify_Tree_For_C then + S := First (Statements (Stats)); + while Present (S) loop + Update_Loop_Names (S); + Next (S); + end loop; + end if; + end Make_Loop_Labels_Unique; + --------------------- -- Process_Formals -- --------------------- @@ -2742,6 +2800,8 @@ package body Inline is Fst : constant Node_Id := First (Statements (HSS)); begin + Make_Loop_Labels_Unique (HSS); + -- Optimize simple case: function body is a single return statement, -- which has been expanded into an assignment. @@ -2829,6 +2889,8 @@ package body Inline is HSS : constant Node_Id := Handled_Statement_Sequence (Blk); begin + Make_Loop_Labels_Unique (HSS); + -- If there is a transient scope for N, this will be the scope of the -- actions for N, and the statements in Blk need to be within this -- scope. For example, they need to have visibility on the constant -- 2.7.4