diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2009-04-08 14:44:17 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2009-04-08 14:44:17 +0200 |
commit | a29262fd4476d0d0e5144b794d966cc676e9cef3 (patch) | |
tree | a2a551bee270f1913fac097232a8bb8e6d194b68 /gcc/ada | |
parent | ad1536a1e7bb1b180235a79bed387ca53cf063c5 (diff) | |
download | gcc-a29262fd4476d0d0e5144b794d966cc676e9cef3.zip gcc-a29262fd4476d0d0e5144b794d966cc676e9cef3.tar.gz gcc-a29262fd4476d0d0e5144b794d966cc676e9cef3.tar.bz2 |
[multiple changes]
2009-04-08 Emmanuel Briot <briot@adacore.com>
* prj-nmsc.adb (Check_File, Process_Sources_In_Multi_Language_Mode):
avoid copies of Source_Data variables when possible, since these
involve calls to memcpy() which are done too many times.
2009-04-08 Robert Dewar <dewar@adacore.com>
* exp_ch4.adb (Expand_Concatenate): Clean up code
From-SVN: r145721
Diffstat (limited to 'gcc/ada')
-rw-r--r-- | gcc/ada/ChangeLog | 10 | ||||
-rw-r--r-- | gcc/ada/exp_ch4.adb | 105 | ||||
-rw-r--r-- | gcc/ada/prj-nmsc.adb | 199 |
3 files changed, 164 insertions, 150 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8acfe5e..91ac2e5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2009-04-08 Emmanuel Briot <briot@adacore.com> + + * prj-nmsc.adb (Check_File, Process_Sources_In_Multi_Language_Mode): + avoid copies of Source_Data variables when possible, since these + involve calls to memcpy() which are done too many times. + +2009-04-08 Robert Dewar <dewar@adacore.com> + + * exp_ch4.adb (Expand_Concatenate): Clean up code + 2009-04-07 Thomas Quinot <quinot@adacore.com> * exp_ch4.adb (Expand_Concatenate): Add missing conversion to index diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 771efd4..fa8ef46 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -62,7 +62,6 @@ with Sem_Warn; use Sem_Warn; with Sinfo; use Sinfo; with Snames; use Snames; with Stand; use Stand; -with Stringt; use Stringt; with Targparm; use Targparm; with Tbuild; use Tbuild; with Ttypes; use Ttypes; @@ -2168,7 +2167,14 @@ package body Exp_Ch4 is -- Number of concatenation operands including possibly null operands NN : Nat := 0; - -- Number of operands excluding any known to be null + -- Number of operands excluding any known to be null, except that the + -- last operand is always retained, in case it provides the bounds for + -- a null result. + + Opnd : Node_Id; + -- Current operand being processed in the loop through operands. After + -- this loop is complete, always contains the last operand (which is not + -- the same as Operands (NN), since null operands are skipped). -- Arrays describing the operands, only the first NN entries of each -- array are set (NN < N when we exclude known null operands). @@ -2177,7 +2183,8 @@ package body Exp_Ch4 is -- True if length of corresponding operand known at compile time Operands : array (1 .. N) of Node_Id; - -- Set to the corresponding entry in the Opnds list + -- Set to the corresponding entry in the Opnds list (but note that null + -- operands are excluded, so not all entries in the list are stored). Fixed_Length : array (1 .. N) of Uint; -- Set to length of operand. Entries in this array are set only if the @@ -2188,11 +2195,6 @@ package body Exp_Ch4 is -- where the bound is known at compile time, else actual lower bound. -- The operand low bound is of type Ityp. - Opnd_High_Bound : array (1 .. N) of Node_Id; - -- Set to upper bound of operand. Either an integer literal in the case - -- where the bound is known at compile time, else actual upper bound. - -- The operand bound is of type Ityp. - Var_Length : array (1 .. N) of Entity_Id; -- Set to an entity of type Natural that contains the length of an -- operand whose length is not known at compile time. Entries in this @@ -2211,6 +2213,12 @@ package body Exp_Ch4 is -- This is either an integer literal node, or an identifier reference to -- a constant entity initialized to the appropriate value. + Last_Opnd_High_Bound : Node_Id; + -- A tree node representing the high bound of the last operand. This + -- need only be set if the result could be null. It is used for the + -- special case of setting the right high bound for a null result. + -- This is of type Ityp. + High_Bound : Node_Id; -- A tree node representing the high bound of the result (of type Ityp) @@ -2274,7 +2282,7 @@ package body Exp_Ch4 is -- we analyzed and resolved the expression. Set_Parent (X, Cnode); - Analyze_And_Resolve (X, Intyp); + Analyze_And_Resolve (X); if Compile_Time_Compare (X, Type_High_Bound (Ityp), @@ -2302,7 +2310,6 @@ package body Exp_Ch4 is -- Local Declarations - Opnd : Node_Id; Opnd_Typ : Entity_Id; Ent : Entity_Id; Len : Uint; @@ -2383,9 +2390,8 @@ package body Exp_Ch4 is Fixed_Length (NN) := Uint_1; Result_May_Be_Null := False; - -- Set bounds of operand (no need to set high bound since we know - -- for sure that result won't be null, so we won't ever use - -- Opnd_High_Bound). + -- Set low bound of operand (no need to set Last_Opnd_High_Bound + -- since we know that the result cannot be null). Opnd_Low_Bound (NN) := Make_Attribute_Reference (Loc, @@ -2399,7 +2405,21 @@ package body Exp_Ch4 is elsif Nkind (Opnd) = N_String_Literal then Len := String_Literal_Length (Opnd_Typ); - -- Skip null string literal unless last operand + if Len /= 0 then + Result_May_Be_Null := False; + end if; + + -- Capture last operand high bound if result could be null + + if J = N and then Result_May_Be_Null then + Last_Opnd_High_Bound := + Make_Op_Add (Loc, + Left_Opnd => + New_Copy_Tree (String_Literal_Low_Bound (Opnd_Typ)), + Right_Opnd => Make_Integer_Literal (Loc, 1)); + end if; + + -- Skip null string literal if J < N and then Len = 0 then goto Continue; @@ -2416,14 +2436,7 @@ package body Exp_Ch4 is Opnd_Low_Bound (NN) := New_Copy_Tree (String_Literal_Low_Bound (Opnd_Typ)); - Opnd_High_Bound (NN) := - Make_Op_Add (Loc, - Left_Opnd => - New_Copy_Tree (String_Literal_Low_Bound (Opnd_Typ)), - Right_Opnd => Make_Integer_Literal (Loc, 1)); - Set := True; - Result_May_Be_Null := False; -- All other cases @@ -2456,10 +2469,18 @@ package body Exp_Ch4 is Result_May_Be_Null := False; end if; - -- Exclude null length case except for last operand - -- (where we may need it to get proper bounds). + -- Capture last operand bound if result could be null + + if J = N and then Result_May_Be_Null then + Last_Opnd_High_Bound := + Convert_To (Ityp, + Make_Integer_Literal (Loc, + Intval => Expr_Value (Hi))); + end if; + + -- Exclude null length case unless last operand - if Len = 0 and then J < N then + if J < N and then Len = 0 then goto Continue; end if; @@ -2472,10 +2493,6 @@ package body Exp_Ch4 is Make_Integer_Literal (Loc, Intval => Expr_Value (Lo))); - Opnd_High_Bound (NN) := To_Ityp ( - Make_Integer_Literal (Loc, - Intval => Expr_Value (Hi))); - Set := True; end; end if; @@ -2497,11 +2514,14 @@ package body Exp_Ch4 is Duplicate_Subexpr (Opnd, Name_Req => True), Attribute_Name => Name_First); - Opnd_High_Bound (NN) := - Make_Attribute_Reference (Loc, - Prefix => - Duplicate_Subexpr (Opnd, Name_Req => True), - Attribute_Name => Name_Last); + if J = N and Result_May_Be_Null then + Last_Opnd_High_Bound := + Convert_To (Ityp, + Make_Attribute_Reference (Loc, + Prefix => + Duplicate_Subexpr (Opnd, Name_Req => True), + Attribute_Name => Name_Last)); + end if; -- Capture length of operand in entity @@ -2593,14 +2613,10 @@ package body Exp_Ch4 is J := J + 1; end loop; - -- If we have only skipped null operands, return a null string literal. - -- Note that this means the lower bound is 1 and the type is string, - -- since we retained any null operands with a type other than string, - -- or a lower bound other than one, so this is a legitimate assumption. + -- If we have only skipped null operands, return the last operand if NN = 0 then - Start_String; - Result := Make_String_Literal (Loc, Strval => End_String); + Result := Opnd; goto Done; end if; @@ -2703,10 +2719,7 @@ package body Exp_Ch4 is end; end if; - -- Now find the upper bound. This is normally the Low_Bound + Length - 1 - -- but there is one exception, namely when the result is null in which - -- case the bounds come from the last operand (so that we get the proper - -- bounds if the last operand is super-flat). + -- Now find the upper bound, normally this is Low_Bound + Length - 1 High_Bound := To_Ityp ( @@ -2717,6 +2730,10 @@ package body Exp_Ch4 is Left_Opnd => New_Copy (Aggr_Length (NN)), Right_Opnd => Make_Integer_Literal (Loc, 1)))); + -- But there is one exception, namely when the result is null in which + -- case the bounds come from the last operand (so that we get the proper + -- bounds if the last operand is super-flat). + if Result_May_Be_Null then High_Bound := Make_Conditional_Expression (Loc, @@ -2724,7 +2741,7 @@ package body Exp_Ch4 is Make_Op_Eq (Loc, Left_Opnd => New_Copy (Aggr_Length (NN)), Right_Opnd => Make_Integer_Literal (Loc, 0)), - Opnd_High_Bound (NN), + Last_Opnd_High_Bound, High_Bound)); end if; diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index e447860..8ad0d7e 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -50,6 +50,8 @@ with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants; package body Prj.Nmsc is + type Source_Data_Access is access Source_Data; + No_Continuation_String : aliased String := ""; Continuation_String : aliased String := "\"; -- Used in Check_Library for continuation error messages at the same @@ -796,7 +798,7 @@ package body Prj.Nmsc is declare Language : Language_Index; Source : Source_Id; - Src_Data : Source_Data; + Src_Data : Source_Data_Access; Alt_Lang : Alternate_Language_Id; Alt_Lang_Data : Alternate_Language_Data; Continuation : Boolean := False; @@ -806,7 +808,8 @@ package body Prj.Nmsc is while Language /= No_Language_Index loop Source := Data.First_Source; Source_Loop : while Source /= No_Source loop - Src_Data := In_Tree.Sources.Table (Source); + Src_Data := + In_Tree.Sources.Table (Source)'Unrestricted_Access; exit Source_Loop when Src_Data.Language = Language; @@ -2494,7 +2497,7 @@ package body Prj.Nmsc is Name : File_Name_Type; Source : Source_Id; - Src_Data : Source_Data; + Src_Data : Source_Data_Access; Project_2 : Project_Id; Data_2 : Project_Data; @@ -2510,9 +2513,8 @@ package body Prj.Nmsc is loop Source := Data_2.First_Source; while Source /= No_Source loop - Src_Data := In_Tree.Sources.Table (Source); + Src_Data := In_Tree.Sources.Table (Source)'Unrestricted_Access; Src_Data.In_Interfaces := False; - In_Tree.Sources.Table (Source) := Src_Data; Source := Src_Data.Next_In_Project; end loop; @@ -2536,12 +2538,12 @@ package body Prj.Nmsc is loop Source := Data_2.First_Source; while Source /= No_Source loop - Src_Data := In_Tree.Sources.Table (Source); + Src_Data := + In_Tree.Sources.Table (Source)'Unrestricted_Access; if Src_Data.File = Name then if not Src_Data.Locally_Removed then - In_Tree.Sources.Table (Source).In_Interfaces := True; - In_Tree.Sources.Table - (Source).Declared_In_Interfaces := True; + Src_Data.In_Interfaces := True; + Src_Data.Declared_In_Interfaces := True; if Src_Data.Other_Part /= No_Source then In_Tree.Sources.Table @@ -2594,11 +2596,10 @@ package body Prj.Nmsc is if Data.Interfaces_Defined then Source := Data.First_Source; while Source /= No_Source loop - Src_Data := In_Tree.Sources.Table (Source); + Src_Data := In_Tree.Sources.Table (Source)'Unrestricted_Access; if not Src_Data.Declared_In_Interfaces then Src_Data.In_Interfaces := False; - In_Tree.Sources.Table (Source) := Src_Data; end if; Source := Src_Data.Next_In_Project; @@ -3529,7 +3530,7 @@ package body Prj.Nmsc is procedure Check_Library (Proj : Project_Id; Extends : Boolean) is Proj_Data : Project_Data; Src_Id : Source_Id; - Src : Source_Data; + Src : Source_Data_Access; begin if Proj /= No_Project then @@ -3543,7 +3544,7 @@ package body Prj.Nmsc is Src_Id := Proj_Data.First_Source; while Src_Id /= No_Source loop - Src := In_Tree.Sources.Table (Src_Id); + Src := In_Tree.Sources.Table (Src_Id)'Unrestricted_Access; exit when Src.Lang_Kind /= File_Based or else Src.Kind /= Spec; @@ -6412,8 +6413,6 @@ package body Prj.Nmsc is is Mains : constant Variable_Value := Prj.Util.Value_Of (Name_Main, Data.Decl.Attributes, In_Tree); - List : String_List_Id; - Elem : String_Element; begin Data.Mains := Mains.Values; @@ -6434,24 +6433,6 @@ package body Prj.Nmsc is (Project, In_Tree, "a library project file cannot have Main specified", Mains.Location); - - -- Normal case where Main was specified - - else - List := Mains.Values; - while List /= Nil_String loop - Elem := In_Tree.String_Elements.Table (List); - - if Length_Of_Name (Elem.Value) = 0 then - Error_Msg - (Project, In_Tree, - "?a main cannot have an empty name", - Elem.Location); - exit; - end if; - - List := Elem.Next; - end loop; end if; end Get_Mains; @@ -7385,12 +7366,12 @@ package body Prj.Nmsc is declare Source : Source_Id; - Src_Data : Source_Data; + Src_Data : Source_Data_Access; begin Source := Data.First_Source; while Source /= No_Source loop - Src_Data := In_Tree.Sources.Table (Source); + Src_Data := In_Tree.Sources.Table (Source)'Unrestricted_Access; if Src_Data.Naming_Exception and then Src_Data.Path = No_Path_Information @@ -8025,7 +8006,6 @@ package body Prj.Nmsc is Other_Part : Source_Id; Add_Src : Boolean; Src_Ind : Source_File_Index; - Src_Data : Source_Data; Unit : Name_Id; Source_To_Replace : Source_Id := No_Source; Language_Name : Name_Id; @@ -8131,86 +8111,94 @@ package body Prj.Nmsc is Source := In_Tree.First_Source; Add_Src := True; while Source /= No_Source loop - Src_Data := In_Tree.Sources.Table (Source); + declare + Src_Data : constant Source_Data_Access := + In_Tree.Sources.Table (Source)'Unrestricted_Access; + begin - if Unit /= No_Name - and then Src_Data.Unit = Unit - and then - ((Src_Data.Kind = Spec and then Kind = Impl) - or else - (Src_Data.Kind = Impl and then Kind = Spec)) - then - Other_Part := Source; + if Unit /= No_Name + and then Src_Data.Unit = Unit + and then + ((Src_Data.Kind = Spec and then Kind = Impl) + or else + (Src_Data.Kind = Impl and then Kind = Spec)) + then + Other_Part := Source; - elsif (Unit /= No_Name - and then Src_Data.Unit = Unit - and then - (Src_Data.Kind = Kind + elsif (Unit /= No_Name + and then Src_Data.Unit = Unit + and then + (Src_Data.Kind = Kind or else - (Src_Data.Kind = Sep and then Kind = Impl) + (Src_Data.Kind = Sep and then Kind = Impl) or else - (Src_Data.Kind = Impl and then Kind = Sep))) - or else (Unit = No_Name and then Src_Data.File = File_Name) - then - -- Duplication of file/unit in same project is only - -- allowed if order of source directories is known. + (Src_Data.Kind = Impl and then Kind = Sep))) + or else + (Unit = No_Name and then Src_Data.File = File_Name) + then + -- Duplication of file/unit in same project is only + -- allowed if order of source directories is known. - if Project = Src_Data.Project then - if Data.Known_Order_Of_Source_Dirs then - Add_Src := False; + if Project = Src_Data.Project then + if Data.Known_Order_Of_Source_Dirs then + Add_Src := False; - elsif Unit /= No_Name then - Error_Msg_Name_1 := Unit; - Error_Msg - (Project, In_Tree, "duplicate unit %%", No_Location); - Add_Src := False; + elsif Unit /= No_Name then + Error_Msg_Name_1 := Unit; + Error_Msg + (Project, In_Tree, "duplicate unit %%", + No_Location); + Add_Src := False; - else - Error_Msg_File_1 := File_Name; - Error_Msg - (Project, In_Tree, "duplicate source file name {", - No_Location); - Add_Src := False; - end if; + else + Error_Msg_File_1 := File_Name; + Error_Msg + (Project, In_Tree, "duplicate source file name {", + No_Location); + Add_Src := False; + end if; - -- Do not allow the same unit name in different - -- projects, except if one is extending the other. + -- Do not allow the same unit name in different + -- projects, except if one is extending the other. - -- For a file based language, the same file name - -- replaces a file in a project being extended, but - -- it is allowed to have the same file name in - -- unrelated projects. + -- For a file based language, the same file name + -- replaces a file in a project being extended, but + -- it is allowed to have the same file name in + -- unrelated projects. - elsif Is_Extending - (Project, Src_Data.Project, In_Tree) - then - Source_To_Replace := Source; + elsif Is_Extending + (Project, Src_Data.Project, In_Tree) + then + Source_To_Replace := Source; - elsif Unit /= No_Name - and then not Src_Data.Locally_Removed - then - Error_Msg_Name_1 := Unit; - Error_Msg - (Project, In_Tree, - "unit %% cannot belong to several projects", - No_Location); + elsif Unit /= No_Name + and then not Src_Data.Locally_Removed + then + Error_Msg_Name_1 := Unit; + Error_Msg + (Project, In_Tree, + "unit %% cannot belong to several projects", + No_Location); - Error_Msg_Name_1 := In_Tree.Projects.Table (Project).Name; - Error_Msg_Name_2 := Name_Id (Display_Path_Id); - Error_Msg - (Project, In_Tree, "\ project %%, %%", No_Location); + Error_Msg_Name_1 := + In_Tree.Projects.Table (Project).Name; + Error_Msg_Name_2 := Name_Id (Display_Path_Id); + Error_Msg + (Project, In_Tree, "\ project %%, %%", No_Location); - Error_Msg_Name_1 := - In_Tree.Projects.Table (Src_Data.Project).Name; - Error_Msg_Name_2 := Name_Id (Src_Data.Path.Display_Name); - Error_Msg - (Project, In_Tree, "\ project %%, %%", No_Location); + Error_Msg_Name_1 := + In_Tree.Projects.Table (Src_Data.Project).Name; + Error_Msg_Name_2 := + Name_Id (Src_Data.Path.Display_Name); + Error_Msg + (Project, In_Tree, "\ project %%, %%", No_Location); - Add_Src := False; + Add_Src := False; + end if; end if; - end if; - Source := Src_Data.Next_In_Sources; + Source := Src_Data.Next_In_Sources; + end; end loop; if Add_Src then @@ -8449,7 +8437,7 @@ package body Prj.Nmsc is procedure Process_Sources_In_Multi_Language_Mode is Source : Source_Id; - Src_Data : Source_Data; + Src_Data : Source_Data_Access; Name_Loc : Name_Location; OK : Boolean; FF : File_Found; @@ -8461,7 +8449,7 @@ package body Prj.Nmsc is Source := Data.First_Source; while Source /= No_Source loop - Src_Data := In_Tree.Sources.Table (Source); + Src_Data := In_Tree.Sources.Table (Source)'Unrestricted_Access; -- A file that is excluded cannot also be an exception file name @@ -8525,7 +8513,7 @@ package body Prj.Nmsc is Source := In_Tree.First_Source; while Source /= No_Source loop - Src_Data := In_Tree.Sources.Table (Source); + Src_Data := In_Tree.Sources.Table (Source)'Unrestricted_Access; if Src_Data.File = FF.File then @@ -8537,7 +8525,6 @@ package body Prj.Nmsc is then Src_Data.Locally_Removed := True; Src_Data.In_Interfaces := False; - In_Tree.Sources.Table (Source) := Src_Data; Add_Forbidden_File_Name (FF.File); OK := True; exit; @@ -8560,7 +8547,7 @@ package body Prj.Nmsc is Check_Object_File_Names : declare Src_Id : Source_Id; - Src_Data : Source_Data; + Src_Data : Source_Data_Access; Source_Name : File_Name_Type; procedure Check_Object; @@ -8596,7 +8583,7 @@ package body Prj.Nmsc is Object_File_Names.Reset; Src_Id := In_Tree.First_Source; while Src_Id /= No_Source loop - Src_Data := In_Tree.Sources.Table (Src_Id); + Src_Data := In_Tree.Sources.Table (Src_Id)'Unrestricted_Access; if Src_Data.Compiled and then Src_Data.Object_Exists and then Project_Extends (Project, Src_Data.Project, In_Tree) |