Commit a29262fd by Arnaud Charlet

[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
parent ad1536a1
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
......@@ -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;
......
......@@ -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)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment