mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-25 05:40:26 +08:00
Code Issues Packages Projects Releases Wiki Activity

par-ch4.adb (P_Simple_Expression): Fold long sequences of concatenations of string literals into a single literal...

Browse Source 
2007-08-31  Bob Duff  <duff@adacore.com>

	* par-ch4.adb (P_Simple_Expression): Fold long sequences of
	concatenations of string literals into a single literal, in order to
	avoid very deep recursion in the front end, which was causing stack
	overflow.

	* sem_eval.adb (Eval_Concatenation): If the left operand is the empty
	string, and the right operand is a string literal (the case of "" &
	"..."), optimize by avoiding copying the right operand -- just use the
	value of the right operand directly.

	* stringt.adb (Store_String_Chars): Optimize by growing the
	String_Chars table all at once, rather than appending characters one by
	one.
	(Write_String_Table_Entry): If the string to be printed is very long,
	just print the first few characters, followed by the length. Otherwise,
	doing "pn(n)" in the debugger can take an extremely long time.

	* sem_prag.adb (Process_Interface_Name): Replace loop doing
	Store_String_Char with Store_String_Chars.

From-SVN: r127977
This commit is contained in:
Bob Duff 2007-08-31 12:23:37 +02:00 committed by Arnaud Charlet
parent b90cfacd5f
commit b54ddf5adf
4 changed files with 174 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

128
gcc/ada/par-ch4.adb
View File

@ -28,6 +28,8 @@ pragma Style_Checks (All_Checks);
-- Turn off subprogram body ordering check. Subprograms are in order
-- by RM section rather than alphabetical
with Stringt; use Stringt;
separate (Par)
package body Ch4 is
@ -1870,18 +1872,122 @@ package body Ch4 is
Node1 := P_Term;
end if;
-- Scan out sequence of terms separated by binary adding operators
-- In the following, we special-case a sequence of concatentations of
-- string literals, such as "aaa" & "bbb" & ... & "ccc", with nothing
-- else mixed in. For such a sequence, we return a tree representing
-- "" & "aaabbb...ccc" (a single concatenation). This is done only if
-- the number of concatenations is large. If semantic analysis
-- resolves the "&" to a predefined one, then this folding gives the
-- right answer. Otherwise, semantic analysis will complain about a
-- capacity-exceeded error. The purpose of this trick is to avoid
-- creating a deeply nested tree, which would cause deep recursion
-- during semantics, causing stack overflow. This way, we can handle
-- enormous concatenations in the normal case of predefined "&". We
-- first build up the normal tree, and then rewrite it if
-- appropriate.
loop
exit when Token not in Token_Class_Binary_Addop;
Tokptr := Token_Ptr;
Node2 := New_Node (P_Binary_Adding_Operator, Tokptr);
Scan; -- past operator
Set_Left_Opnd (Node2, Node1);
Set_Right_Opnd (Node2, P_Term);
Set_Op_Name (Node2);
Node1 := Node2;
end loop;
declare
Num_Concats_Threshold : constant Positive := 1000;
-- Arbitrary threshold value to enable optimization
First_Node : constant Node_Id := Node1;
Is_Strlit_Concat : Boolean;
-- True iff we've parsed a sequence of concatenations of string
-- literals, with nothing else mixed in.
Num_Concats : Natural;
-- Number of "&" operators if Is_Strlit_Concat is True
begin
Is_Strlit_Concat :=
Nkind (Node1) = N_String_Literal
and then Token = Tok_Ampersand;
Num_Concats := 0;
-- Scan out sequence of terms separated by binary adding operators
loop
exit when Token not in Token_Class_Binary_Addop;
Tokptr := Token_Ptr;
Node2 := New_Node (P_Binary_Adding_Operator, Tokptr);
Scan; -- past operator
Set_Left_Opnd (Node2, Node1);
Node1 := P_Term;
Set_Right_Opnd (Node2, Node1);
Set_Op_Name (Node2);
-- Check if we're still concatenating string literals
Is_Strlit_Concat :=
Is_Strlit_Concat
and then Nkind (Node2) = N_Op_Concat
and then Nkind (Node1) = N_String_Literal;
if Is_Strlit_Concat then
Num_Concats := Num_Concats + 1;
end if;
Node1 := Node2;
end loop;
-- If we have an enormous series of concatenations of string
-- literals, rewrite as explained above. The Is_Folded_In_Parser
-- flag tells semantic analysis that if the "&" is not predefined,
-- the folded value is wrong.
if Is_Strlit_Concat
and then Num_Concats >= Num_Concats_Threshold
then
declare
Empty_String_Val : String_Id;
-- String_Id for ""
Strlit_Concat_Val : String_Id;
-- Contains the folded value (which will be correct if the
-- "&" operators are the predefined ones).
Cur_Node : Node_Id;
-- For walking up the tree
New_Node : Node_Id;
-- Folded node to replace Node1
Loc : constant Source_Ptr := Sloc (First_Node);
begin
-- Walk up the tree starting at the leftmost string literal
-- (First_Node), building up the Strlit_Concat_Val as we
-- go. Note that we do not use recursion here -- the whole
-- point is to avoid recursively walking that enormous tree.
Start_String;
Store_String_Chars (Strval (First_Node));
Cur_Node := Parent (First_Node);
while Present (Cur_Node) loop
pragma Assert (Nkind (Cur_Node) = N_Op_Concat and then
Nkind (Right_Opnd (Cur_Node)) = N_String_Literal);
Store_String_Chars (Strval (Right_Opnd (Cur_Node)));
Cur_Node := Parent (Cur_Node);
end loop;
Strlit_Concat_Val := End_String;
-- Create new folded node, and rewrite result with a concat-
-- enation of an empty string literal and the folded node.
Start_String;
Empty_String_Val := End_String;
New_Node :=
Make_Op_Concat (Loc,
Make_String_Literal (Loc, Empty_String_Val),
Make_String_Literal (Loc, Strlit_Concat_Val,
Is_Folded_In_Parser => True));
Rewrite (Node1, New_Node);
end;
end if;
end;
-- All done, we clearly do not have name or numeric literal so this
-- is a case of a simple expression which is some other possibility.

39
gcc/ada/sem_eval.adb
View File

@ -1451,9 +1451,10 @@ package body Sem_Eval is
-- concatenations with such aggregates.
declare
Left_Str : constant Node_Id := Get_String_Val (Left);
Left_Len : Nat;
Right_Str : constant Node_Id := Get_String_Val (Right);
Left_Str : constant Node_Id := Get_String_Val (Left);
Left_Len : Nat;
Right_Str : constant Node_Id := Get_String_Val (Right);
Folded_Val : String_Id;
begin
-- Establish new string literal, and store left operand. We make
@ -1465,26 +1466,36 @@ package body Sem_Eval is
if Nkind (Left_Str) = N_String_Literal then
Left_Len := String_Length (Strval (Left_Str));
Start_String (Strval (Left_Str));
-- If the left operand is the empty string, and the right operand
-- is a string literal (the case of "" & "..."), the result is the
-- value of the right operand. This optimization is important when
-- Is_Folded_In_Parser, to avoid copying an enormous right
-- operand.
if Left_Len = 0 and then Nkind (Right_Str) = N_String_Literal then
Folded_Val := Strval (Right_Str);
else
Start_String (Strval (Left_Str));
end if;
else
Start_String;
Store_String_Char (UI_To_CC (Char_Literal_Value (Left_Str)));
Left_Len := 1;
end if;
-- Now append the characters of the right operand
-- Now append the characters of the right operand, unless we
-- optimized the "" & "..." case above.
if Nkind (Right_Str) = N_String_Literal then
declare
S : constant String_Id := Strval (Right_Str);
begin
for J in 1 .. String_Length (S) loop
Store_String_Char (Get_String_Char (S, J));
end loop;
end;
if Left_Len /= 0 then
Store_String_Chars (Strval (Right_Str));
Folded_Val := End_String;
end if;
else
Store_String_Char (UI_To_CC (Char_Literal_Value (Right_Str)));
Folded_Val := End_String;
end if;
Set_Is_Static_Expression (N, Stat);
@ -1501,7 +1512,7 @@ package body Sem_Eval is
Set_Etype (N, Etype (Right));
end if;
Fold_Str (N, End_String, Static => True);
Fold_Str (N, Folded_Val, Static => True);
end if;
end;
end Eval_Concatenation;

9
gcc/ada/sem_prag.adb
View File

@ -3736,13 +3736,10 @@ package body Sem_Prag is
end if;
String_Val := Strval (Expr_Value_S (Link_Nam));
for J in 1 .. String_Length (String_Val) loop
Store_String_Char (Get_String_Char (String_Val, J));
end loop;
Store_String_Chars (String_Val);
Link_Nam :=
Make_String_Literal (Sloc (Link_Nam), End_String);
Make_String_Literal (Sloc (Link_Nam),
Strval => End_String);
end if;
Set_Encoded_Interface_Name

32
gcc/ada/stringt.adb
View File

@ -202,10 +202,27 @@ package body Stringt is
end Store_String_Chars;
procedure Store_String_Chars (S : String_Id) is
-- We are essentially doing this:
-- for J in 1 .. String_Length (S) loop
-- Store_String_Char (Get_String_Char (S, J));
-- end loop;
-- but when the string is long it's more efficient to grow the
-- String_Chars table all at once.
S_First : constant Int := Strings.Table (S).String_Index;
S_Len : constant Int := String_Length (S);
Old_Last : constant Int := String_Chars.Last;
New_Last : constant Int := Old_Last + S_Len;
begin
for J in 1 .. String_Length (S) loop
Store_String_Char (Get_String_Char (S, J));
end loop;
String_Chars.Set_Last (New_Last);
String_Chars.Table (Old_Last + 1 .. New_Last) :=
String_Chars.Table (S_First .. S_First + S_Len - 1);
Strings.Table (Strings.Last).Length :=
Strings.Table (Strings.Last).Length + S_Len;
end Store_String_Chars;
----------------------
@ -417,6 +434,15 @@ package body Stringt is
else
Write_Char_Code (C);
end if;
-- If string is very long, quit
if J >= 1000 then -- arbitrary limit
Write_Str ("""...etc (length = ");
Write_Int (String_Length (Id));
Write_Str (")");
return;
end if;
end loop;
Write_Char ('"');