From: charlet Date: Thu, 16 Aug 2007 12:21:07 +0000 (+0000) Subject: 2007-08-16 Hristian Kirtchev X-Git-Tag: upstream/4.9.2~46862 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=e33d6af44b535351b7356725a1951e41ca608ef7;p=platform%2Fupstream%2Flinaro-gcc.git 2007-08-16 Hristian Kirtchev Bob Duff Nicolas Setton * sem_res.adb (Comes_From_Predefined_Lib_Unit): New. (Resolve): Alphabetize local variables. Add new variable From_Lib. When the statement which is being resolved comes from a predefined library unit, all non-predefined library interpretations are skipped. (Resolve_Op_Concat): If string concatenation was folded in the parser, but the "&" is user defined, give an error, because the folding would be wrong. * sinfo.ads, sinfo.adb (Is_Folded_In_Parser): New flag to indicate that the parser has folded a long sequence of concatenations of string literals. * trans.c (Handled_Sequence_Of_Statements_to_gnu): Mark "JMPBUF_SAVE" and "JMP_BUF" variables as artificial. (N_String_Literal): Do not use alloca for very long string literals. Use xmalloc/free instead. Otherwise the stack might overflow. * utils.c (init_gigi_decls): Mark "JMPBUF_T" type as created by the compiler. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127550 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 94a57c9..c1387f2 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -37,6 +37,7 @@ with Exp_Ch6; use Exp_Ch6; with Exp_Ch7; use Exp_Ch7; with Exp_Tss; use Exp_Tss; with Exp_Util; use Exp_Util; +with Fname; use Fname; with Freeze; use Freeze; with Itypes; use Itypes; with Lib; use Lib; @@ -1546,16 +1547,21 @@ package body Sem_Res is ------------- procedure Resolve (N : Node_Id; Typ : Entity_Id) is + Ambiguous : Boolean := False; + Ctx_Type : Entity_Id := Typ; + Expr_Type : Entity_Id := Empty; -- prevent junk warning + Err_Type : Entity_Id := Empty; + Found : Boolean := False; + From_Lib : Boolean; I : Interp_Index; - I1 : Interp_Index := 0; -- prevent junk warning + I1 : Interp_Index := 0; -- prevent junk warning It : Interp; It1 : Interp; - Found : Boolean := False; Seen : Entity_Id := Empty; -- prevent junk warning - Ctx_Type : Entity_Id := Typ; - Expr_Type : Entity_Id := Empty; -- prevent junk warning - Err_Type : Entity_Id := Empty; - Ambiguous : Boolean := False; + + function Comes_From_Predefined_Lib_Unit (Nod : Node_Id) return Boolean; + -- Determine whether a node comes from a predefined library unit or + -- Standard. procedure Patch_Up_Value (N : Node_Id; Typ : Entity_Id); -- Try and fix up a literal so that it matches its expected type. New @@ -1564,6 +1570,18 @@ package body Sem_Res is procedure Resolution_Failed; -- Called when attempt at resolving current expression fails + ------------------------------------ + -- Comes_From_Predefined_Lib_Unit -- + ------------------------------------- + + function Comes_From_Predefined_Lib_Unit (Nod : Node_Id) return Boolean is + begin + return + Sloc (Nod) = Standard_Location + or else Is_Predefined_File_Name (Unit_File_Name ( + Get_Source_Unit (Sloc (Nod)))); + end Comes_From_Predefined_Lib_Unit; + -------------------- -- Patch_Up_Value -- -------------------- @@ -1660,6 +1678,8 @@ package body Sem_Res is ("prefix must statically denote a non-remote subprogram", N); end if; + From_Lib := Comes_From_Predefined_Lib_Unit (N); + -- If the context is a Remote_Access_To_Subprogram, access attributes -- must be resolved with the corresponding fat pointer. There is no need -- to check for the attribute name since the return type of an @@ -1817,6 +1837,16 @@ package body Sem_Res is -- some more obscure cases are handled in Disambiguate. else + -- If the current statement is part of a predefined library + -- unit, then all interpretations which come from user level + -- packages should not be considered. + + if From_Lib + and then not Comes_From_Predefined_Lib_Unit (It.Nam) + then + goto Continue; + end if; + Error_Msg_Sloc := Sloc (Seen); It1 := Disambiguate (N, I1, I, Typ); @@ -6335,6 +6365,22 @@ package body Sem_Res is -- Start of processing for Resolve_Op_Concat begin + -- The parser folds an enormous sequence of concatenations of string + -- literals into "" & "...", where the Is_Folded_In_Parser flag is set + -- in the right. If the expression resolves to a predefined "&" + -- operator, all is well. Otherwise, the parser's folding is wrong, so + -- we give an error. See P_Simple_Expression in Par.Ch4. + + if Nkind (Op2) = N_String_Literal + and then Is_Folded_In_Parser (Op2) + and then Ekind (Entity (N)) = E_Function + then + pragma Assert (Nkind (Op1) = N_String_Literal -- should be "" + and then String_Length (Strval (Op1)) = 0); + Error_Msg_N ("too many user-defined concatenations", N); + return; + end if; + Set_Etype (N, Btyp); if Is_Limited_Composite (Btyp) then diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 033b60f..f664f92 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -1590,6 +1590,14 @@ package body Sinfo is return Flag8 (N); end Is_Entry_Barrier_Function; + function Is_Folded_In_Parser + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_String_Literal); + return Flag4 (N); + end Is_Folded_In_Parser; + function Is_In_Discriminant_Check (N : Node_Id) return Boolean is begin @@ -4289,6 +4297,14 @@ package body Sinfo is Set_Flag8 (N, Val); end Set_Is_Entry_Barrier_Function; + procedure Set_Is_Folded_In_Parser + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_String_Literal); + Set_Flag4 (N, Val); + end Set_Is_Folded_In_Parser; + procedure Set_Is_In_Discriminant_Check (N : Node_Id; Val : Boolean := True) is begin diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 403c5a2..65009c6 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -1202,11 +1202,6 @@ package Sinfo is -- conditions holds, and the flag is set, then the division or -- multiplication can be (and is) converted to a shift. - -- Is_Overloaded (Flag5-Sem) - -- A flag present in all expression nodes. Used temporarily during - -- overloading determination. The setting of this flag is not relevant - -- once overloading analysis is complete. - -- Is_Protected_Subprogram_Body (Flag7-Sem) -- A flag set in a Subprogram_Body block to indicate that it is the -- implemenation of a protected subprogram. Such a body needs cleanup @@ -1820,11 +1815,19 @@ package Sinfo is -- A STRING_ELEMENT is either a pair of quotation marks ("), or a -- single GRAPHIC_CHARACTER other than a quotation mark. + -- + -- Is_Folded_In_Parser is True if the parser created this literal by + -- folding a sequence of "&" operators. For example, if the source code + -- says "aaa" & "bbb" & "ccc", and the produces "aaabbbccc", the flag is + -- set. This flag is needed because the parser doesn't know about + -- visibility, so the folded result might be wrong, and semantic + -- analysis needs to check for that. -- N_String_Literal -- Sloc points to literal -- Strval (Str3) contains Id of string value -- Has_Wide_Character (Flag11-Sem) + -- Is_Folded_In_Parser (Flag4) -- plus fields for expression ------------------ @@ -7870,6 +7873,9 @@ package Sinfo is function Is_Entry_Barrier_Function (N : Node_Id) return Boolean; -- Flag8 + function Is_Folded_In_Parser + (N : Node_Id) return Boolean; -- Flag4 + function Is_In_Discriminant_Check (N : Node_Id) return Boolean; -- Flag11 @@ -8725,6 +8731,9 @@ package Sinfo is procedure Set_Is_Entry_Barrier_Function (N : Node_Id; Val : Boolean := True); -- Flag8 + procedure Set_Is_Folded_In_Parser + (N : Node_Id; Val : Boolean := True); -- Flag4 + procedure Set_Is_In_Discriminant_Check (N : Node_Id; Val : Boolean := True); -- Flag11 @@ -10817,6 +10826,7 @@ package Sinfo is pragma Inline (Is_Controlling_Actual); pragma Inline (Is_Dynamic_Coextension); pragma Inline (Is_Entry_Barrier_Function); + pragma Inline (Is_Folded_In_Parser); pragma Inline (Is_In_Discriminant_Check); pragma Inline (Is_Machine_Number); pragma Inline (Is_Null_Loop); @@ -11098,6 +11108,7 @@ package Sinfo is pragma Inline (Set_Is_Controlling_Actual); pragma Inline (Set_Is_Dynamic_Coextension); pragma Inline (Set_Is_Entry_Barrier_Function); + pragma Inline (Set_Is_Folded_In_Parser); pragma Inline (Set_Is_In_Discriminant_Check); pragma Inline (Set_Is_Machine_Number); pragma Inline (Set_Is_Null_Loop); diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c index 7a9b7f2..f6ba98c 100644 --- a/gcc/ada/trans.c +++ b/gcc/ada/trans.c @@ -101,6 +101,11 @@ DEF_VEC_ALLOC_P(parm_attr,gc); struct language_function GTY(()) { +/* We should avoid allocating more than ALLOCA_THRESHOLD bytes via alloca, for + fear of running out of stack space. If we need more, we use xmalloc/free + instead. */ +#define ALLOCA_THRESHOLD 1000 + VEC(parm_attr,gc) *parm_attr_cache; }; @@ -2508,6 +2513,8 @@ Handled_Sequence_Of_Statements_to_gnu (Node_Id gnat_node) build_call_0_expr (get_jmpbuf_decl), false, false, false, false, NULL, gnat_node); + DECL_ARTIFICIAL (gnu_jmpsave_decl) = 1; + /* The __builtin_setjmp receivers will immediately reinstall it. Now because of the unstructured form of EH used by setjmp_longjmp, there might be forward edges going to __builtin_setjmp receivers on which @@ -2517,6 +2524,7 @@ Handled_Sequence_Of_Statements_to_gnu (Node_Id gnat_node) NULL_TREE, jmpbuf_type, NULL_TREE, false, false, false, false, NULL, gnat_node); + DECL_ARTIFICIAL (gnu_jmpbuf_decl) = 1; set_block_jmpbuf_decl (gnu_jmpbuf_decl); @@ -3118,8 +3126,12 @@ gnat_to_gnu (Node_Id gnat_node) { String_Id gnat_string = Strval (gnat_node); int length = String_Length (gnat_string); - char *string = (char *) alloca (length + 1); int i; + char *string; + if (length >= ALLOCA_THRESHOLD) + string = xmalloc (length + 1); /* in case of large strings */ + else + string = (char *) alloca (length + 1); /* Build the string with the characters in the literal. Note that Ada strings are 1-origin. */ @@ -3135,6 +3147,9 @@ gnat_to_gnu (Node_Id gnat_node) /* Strings in GCC don't normally have types, but we want this to not be converted to the array type. */ TREE_TYPE (gnu_result) = gnu_result_type; + + if (length >= ALLOCA_THRESHOLD) /* free if heap-allocated */ + free (string); } else { diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c index d26395f..86e80f1 100644 --- a/gcc/ada/utils.c +++ b/gcc/ada/utils.c @@ -592,7 +592,7 @@ init_gigi_decls (tree long_long_float_type, tree exception_type) = build_array_type (gnat_type_for_mode (Pmode, 0), build_index_type (build_int_cst (NULL_TREE, 5))); create_type_decl (get_identifier ("JMPBUF_T"), jmpbuf_type, NULL, - false, true, Empty); + true, true, Empty); jmpbuf_ptr_type = build_pointer_type (jmpbuf_type); /* Functions to get and set the jumpbuf pointer for the current thread. */