Skip to content

R
riscv-gcc-1
Commit 75a64833 by Arnaud Charlet
Options

[multiple changes] 

2009-09-16  Thomas Quinot  <quinot@adacore.com>

	* freeze.adb, exp_intr.adb (Expand_Intrinsic_Call): Leave calls to
	intrinsics untouched (to be expanded later on by gigi) if an external
	name has been specified.
	(Freeze_Entity): Do not generate a default external name for
	imported subprograms with convention Intrinsic (so that the above code
	can identify the case where an external name has been explicitly
	provided).

	* s-oscons-tmplt.c: Quote TARGET_OS early so that it is not erroneously
	replaced by something else due to an existing #define clause.

2009-09-16  Ed Schonberg  <schonberg@adacore.com>

	* sinfo.ads, sinfo.adb (Is_Accessibility_Actual): New flag on
	Parameter_Association node, created for the extra actual generated for
	an access parameter of a function that dispatches on result, to prevent
	double generation of such actuals when the call is rewritten is a
	dispatching call.
	* exp_ch6.adb (Expand_Call): Set Is_Accessibility_Actual when needed.
	* exp_disp.adb (Expand_Dispatching_Call): Do not transfer extra actuals
	that carry this flag when rewriting the original call as a dispatching
	call, after propagating the controlling tag.

2009-09-16  Vincent Celier  <celier@adacore.com>

	* prj-nmsc.adb (Add_Source): New parameter Source_Dir_Rank to be put
	in the source data.
	(Check_File): New parameter Source_Dir_Rank, to check if a duplicate
	source is allowed.
	(Find_Source_Dirs): New parameter Rank to be recorded with the source
	directories.
	(Search_Directories): Call Check_File with the rank of the directory
	* prj.adb (Project_Empty): Add new component Source_Dir_Ranks
	(Free): Free also Number_Lists
	(Reset): Init also Number_Lists
	* prj.ads (Number_List_Table): New dynamic table for lists of numbers
	(Source_Data): New component Source_Dir_Rank. Remove component
	Known_Order_Of_Source_Dirs, no longer needed.
	(Project_Data): New component Source_Dir_Ranks
	(Project_Tree_Data): New components Number_Lists

From-SVN: r151749
parent bac7206d
Showing with 302 additions and 98 deletions
gcc/ada/ChangeLog
2009-09-16 Thomas Quinot <quinot@adacore.com>
* freeze.adb, exp_intr.adb (Expand_Intrinsic_Call): Leave calls to
intrinsics untouched (to be expanded later on by gigi) if an external
name has been specified.
(Freeze_Entity): Do not generate a default external name for
imported subprograms with convention Intrinsic (so that the above code
can identify the case where an external name has been explicitly
provided).
* s-oscons-tmplt.c: Quote TARGET_OS early so that it is not erroneously
replaced by something else due to an existing #define clause.
2009-09-16 Ed Schonberg <schonberg@adacore.com>
* sinfo.ads, sinfo.adb (Is_Accessibility_Actual): New flag on
Parameter_Association node, created for the extra actual generated for
an access parameter of a function that dispatches on result, to prevent
double generation of such actuals when the call is rewritten is a
dispatching call.
* exp_ch6.adb (Expand_Call): Set Is_Accessibility_Actual when needed.
* exp_disp.adb (Expand_Dispatching_Call): Do not transfer extra actuals
that carry this flag when rewriting the original call as a dispatching
call, after propagating the controlling tag.
2009-09-16 Vincent Celier <celier@adacore.com>
* prj-nmsc.adb (Add_Source): New parameter Source_Dir_Rank to be put
in the source data.
(Check_File): New parameter Source_Dir_Rank, to check if a duplicate
source is allowed.
(Find_Source_Dirs): New parameter Rank to be recorded with the source
directories.
(Search_Directories): Call Check_File with the rank of the directory
* prj.adb (Project_Empty): Add new component Source_Dir_Ranks
(Free): Free also Number_Lists
(Reset): Init also Number_Lists
* prj.ads (Number_List_Table): New dynamic table for lists of numbers
(Source_Data): New component Source_Dir_Rank. Remove component
Known_Order_Of_Source_Dirs, no longer needed.
(Project_Data): New component Source_Dir_Ranks
(Project_Tree_Data): New components Number_Lists
2009-09-16 Vincent Celier <celier@adacore.com>
* gprep.adb (Yes_No): New global constant
......
gcc/ada/exp_ch6.adb
......@@ -496,6 +496,7 @@ package body Exp_Ch6 is
declare
Activation_Chain_Actual : Node_Id;
Activation_Chain_Formal : Node_Id;
begin
-- Locate implicit activation chain parameter in the called function
......@@ -1807,6 +1808,10 @@ package body Exp_Ch6 is
Make_Identifier (Loc, Chars (EF))));
Analyze_And_Resolve (Expr, Etype (EF));
if Nkind (N) = N_Function_Call then
Set_Is_Accessibility_Actual (Parent (Expr));
end if;
end Add_Extra_Actual;
---------------------------
......@@ -2282,31 +2287,15 @@ package body Exp_Ch6 is
when N_Attribute_Reference =>
case Get_Attribute_Id (Attribute_Name (Prev_Orig)) is
-- For X'Access, pass on the level of the prefix X.
-- If the call is a rewritten attribute reference to
-- 'Input and the prefix is a tagged type, prevent
-- double expansion (once as a function call and once
-- as a dispatching call)
-- For X'Access, pass on the level of the prefix X
when Attribute_Access =>
declare
Onode : constant Node_Id :=
Original_Node (Parent (N));
begin
if Nkind (Onode) = N_Attribute_Reference
and then Attribute_Name (Onode) = Name_Input
and then Is_Tagged_Type (Etype (Subp))
then
null;
else
Add_Extra_Actual
(Make_Integer_Literal (Loc,
Intval =>
Object_Access_Level
(Prefix (Prev_Orig))),
Add_Extra_Actual
(Make_Integer_Literal (Loc,
Intval =>
Object_Access_Level
(Prefix (Prev_Orig))),
Extra_Accessibility (Formal));
end if;
end;
-- Treat the unchecked attributes as library-level
......
gcc/ada/exp_disp.adb
......@@ -692,7 +692,9 @@ package body Exp_Disp is
Append_To (New_Params,
Duplicate_Subexpr_Move_Checks (Param));
else
elsif Nkind (Parent (Param)) /= N_Parameter_Association
or else not Is_Accessibility_Actual (Parent (Param))
then
Append_To (New_Params, Relocate_Node (Param));
end if;
......
gcc/ada/exp_intr.adb
......@@ -394,6 +394,13 @@ package body Exp_Intr is
Nam : Name_Id;
begin
-- If an external name is specified for the intrinsic, it is handled
-- by the back-end: leave the call node unchanged for now.
if Present (Interface_Name (E)) then
return;
end if;
-- If the intrinsic subprogram is generic, gets its original name
if Present (Parent (E))
......
gcc/ada/freeze.adb
......@@ -2443,11 +2443,16 @@ package body Freeze is
-- If entity is exported or imported and does not have an external
-- name, now is the time to provide the appropriate default name.
-- Skip this if the entity is stubbed, since we don't need a name
-- for any stubbed routine.
-- for any stubbed routine. For the case on intrinsics, if no
-- external name is specified, then calls will be handled in
-- Exp_Intr.Expand_Intrinsic_Call, and no name is needed; if
-- an external name is provided, then Expand_Intrinsic_Call leaves
-- calls in place for expansion by GIGI.
if (Is_Imported (E) or else Is_Exported (E))
and then No (Interface_Name (E))
and then Convention (E) /= Convention_Stubbed
and then Convention (E) /= Convention_Intrinsic
then
Set_Encoded_Interface_Name
(E, Get_Default_External_Name (E));
......@@ -3335,9 +3340,7 @@ package body Freeze is
-- For bit-packed arrays, check the size
if Is_Bit_Packed_Array (E)
and then Known_RM_Size (E)
then
if Is_Bit_Packed_Array (E) and then Known_RM_Size (E) then
declare
SizC : constant Node_Id := Size_Clause (E);
......
gcc/ada/prj-nmsc.adb
......@@ -192,6 +192,7 @@ package body Prj.Nmsc is
(Id : out Source_Id;
Data : in out Tree_Processing_Data;
Project : Project_Id;
Source_Dir_Rank : Natural;
Lang_Id : Language_Ptr;
Kind : Source_Kind;
File_Name : File_Name_Type;
......@@ -295,6 +296,7 @@ package body Prj.Nmsc is
procedure Check_File
(Project : in out Project_Processing_Data;
Data : in out Tree_Processing_Data;
Source_Dir_Rank : Natural;
Path : Path_Name_Type;
File_Name : File_Name_Type;
Display_File_Name : File_Name_Type;
......@@ -539,6 +541,7 @@ package body Prj.Nmsc is
(Id : out Source_Id;
Data : in out Tree_Processing_Data;
Project : Project_Id;
Source_Dir_Rank : Natural;
Lang_Id : Language_Ptr;
Kind : Source_Kind;
File_Name : File_Name_Type;
......@@ -598,7 +601,7 @@ package body Prj.Nmsc is
if Data.Flags.Allow_Duplicate_Basenames then
Add_Src := True;
elsif Project.Known_Order_Of_Source_Dirs then
elsif Source_Dir_Rank /= Source.Source_Dir_Rank then
Add_Src := False;
else
......@@ -610,7 +613,7 @@ package body Prj.Nmsc is
end if;
else
if Project.Known_Order_Of_Source_Dirs then
if Source_Dir_Rank /= Source.Source_Dir_Rank then
Add_Src := False;
-- We might be seeing the same file through a different path
......@@ -722,6 +725,7 @@ package body Prj.Nmsc is
end if;
Id.Project := Project;
Id.Source_Dir_Rank := Source_Dir_Rank;
Id.Language := Lang_Id;
Id.Kind := Kind;
Id.Alternate_Languages := Alternate_Languages;
......@@ -2807,6 +2811,7 @@ package body Prj.Nmsc is
(Id => Source,
Data => Data,
Project => Project,
Source_Dir_Rank => 0,
Lang_Id => Lang_Id,
Kind => Kind,
File_Name => File_Name,
......@@ -2916,16 +2921,17 @@ package body Prj.Nmsc is
if Unit /= No_Name then
Add_Source
(Id => Source,
Data => Data,
Project => Project,
Lang_Id => Lang_Id,
Kind => Kind,
File_Name => File_Name,
Display_File => File_Name_Type (Element.Value.Value),
Unit => Unit,
Index => Index,
Location => Element.Value.Location,
(Id => Source,
Data => Data,
Project => Project,
Source_Dir_Rank => 0,
Lang_Id => Lang_Id,
Kind => Kind,
File_Name => File_Name,
Display_File => File_Name_Type (Element.Value.Value),
Unit => Unit,
Index => Index,
Location => Element.Value.Location,
Naming_Exception => True);
end if;
......@@ -4675,7 +4681,8 @@ package body Prj.Nmsc is
(Name_Source_Files,
Project.Decl.Attributes, Data.Tree);
Last_Source_Dir : String_List_Id := Nil_String;
Last_Source_Dir : String_List_Id := Nil_String;
Last_Src_Dir_Rank : Number_List_Index := No_Number_List;
Languages : constant Variable_Value :=
Prj.Util.Value_Of
......@@ -4684,6 +4691,7 @@ package body Prj.Nmsc is
procedure Find_Source_Dirs
(From : File_Name_Type;
Location : Source_Ptr;
Rank : Natural;
Removed : Boolean := False);
-- Find one or several source directories, and add (or remove, if
-- Removed is True) them to list of source directories of the project.
......@@ -4695,6 +4703,7 @@ package body Prj.Nmsc is
procedure Find_Source_Dirs
(From : File_Name_Type;
Location : Source_Ptr;
Rank : Natural;
Removed : Boolean := False)
is
Directory : constant String := Get_Name_String (From);
......@@ -4714,6 +4723,8 @@ package body Prj.Nmsc is
Last : Natural;
List : String_List_Id;
Prev : String_List_Id;
Rank_List : Number_List_Index;
Prev_Rank : Number_List_Index;
Element : String_Element;
Found : Boolean := False;
......@@ -4756,6 +4767,8 @@ package body Prj.Nmsc is
List := Project.Source_Dirs;
Prev := Nil_String;
Rank_List := Project.Source_Dir_Ranks;
Prev_Rank := No_Number_List;
while List /= Nil_String loop
Element := Data.Tree.String_Elements.Table (List);
......@@ -4766,6 +4779,8 @@ package body Prj.Nmsc is
Prev := List;
List := Element.Next;
Prev_Rank := Rank_List;
Rank_List := Data.Tree.Number_Lists.Table (Rank_List).Next;
end loop;
-- If directory is not already in list, put it there
......@@ -4785,11 +4800,15 @@ package body Prj.Nmsc is
Next => Nil_String,
Index => 0);
Number_List_Table.Increment_Last (Data.Tree.Number_Lists);
-- Case of first source directory
if Last_Source_Dir = Nil_String then
Project.Source_Dirs :=
String_Element_Table.Last (Data.Tree.String_Elements);
Project.Source_Dir_Ranks :=
Number_List_Table.Last (Data.Tree.Number_Lists);
-- Here we already have source directories
......@@ -4798,7 +4817,11 @@ package body Prj.Nmsc is
Data.Tree.String_Elements.Table
(Last_Source_Dir).Next :=
String_Element_Table.Last (Data.Tree.String_Elements);
String_Element_Table.Last (Data.Tree.String_Elements);
Data.Tree.Number_Lists.Table
(Last_Src_Dir_Rank).Next :=
Number_List_Table.Last (Data.Tree.Number_Lists);
end if;
-- And register this source directory as the new last
......@@ -4806,14 +4829,22 @@ package body Prj.Nmsc is
Last_Source_Dir :=
String_Element_Table.Last (Data.Tree.String_Elements);
Data.Tree.String_Elements.Table (Last_Source_Dir) := Element;
Last_Src_Dir_Rank :=
Number_List_Table.Last (Data.Tree.Number_Lists);
Data.Tree.Number_Lists.Table (Last_Src_Dir_Rank) :=
(Number => Rank, Next => No_Number_List);
elsif Removed and Found then
if Prev = Nil_String then
Project.Source_Dirs :=
Data.Tree.String_Elements.Table (List).Next;
Project.Source_Dir_Ranks :=
Data.Tree.Number_Lists.Table (Rank_List).Next;
else
Data.Tree.String_Elements.Table (Prev).Next :=
Data.Tree.String_Elements.Table (List).Next;
Data.Tree.Number_Lists.Table (Prev_Rank).Next :=
Data.Tree.Number_Lists.Table (Rank_List).Next;
end if;
end if;
......@@ -4872,6 +4903,8 @@ package body Prj.Nmsc is
if Current_Verbosity = High and then not Removed then
Write_Str ("Find_Source_Dirs (""");
Write_Str (Directory);
Write_Str (",");
Write_Str (Rank'Img);
Write_Line (""")");
end if;
......@@ -4884,10 +4917,6 @@ package body Prj.Nmsc is
or else
Directory (Directory'Last - 2) = Directory_Separator)
then
if not Removed then
Project.Known_Order_Of_Source_Dirs := False;
end if;
Name_Len := Directory'Length - 3;
if Name_Len = 0 then
......@@ -4960,6 +4989,8 @@ package body Prj.Nmsc is
Path_Name : Path_Information;
List : String_List_Id;
Prev : String_List_Id;
Rank_List : Number_List_Index;
Prev_Rank : Number_List_Index;
Dir_Exists : Boolean;
begin
......@@ -5011,70 +5042,105 @@ package body Prj.Nmsc is
(Display_Path'First .. Last_Display_Path));
Display_Path_Id := Name_Find;
-- Check if the directory is already in the list
Prev := Nil_String;
Prev_Rank := No_Number_List;
-- Look for source dir in current list
List := Project.Source_Dirs;
Rank_List := Project.Source_Dir_Ranks;
while List /= Nil_String loop
Element := Data.Tree.String_Elements.Table (List);
exit when Element.Value = Path_Id;
Prev := List;
List := Element.Next;
Prev_Rank := Rank_List;
Rank_List :=
Data.Tree.Number_Lists.Table (Prev_Rank).Next;
end loop;
-- The directory is in the list if List is not Nil_String
if not Removed then
-- As it is an existing directory, we add it to the
-- list of directories.
-- list of directories, if it is not already in the
-- list.
String_Element_Table.Increment_Last
(Data.Tree.String_Elements);
Element :=
(Value => Path_Id,
Index => 0,
Display_Value => Display_Path_Id,
Location => No_Location,
Flag => False,
Next => Nil_String);
if List = Nil_String then
String_Element_Table.Increment_Last
(Data.Tree.String_Elements);
Element :=
(Value => Path_Id,
Index => 0,
Display_Value => Display_Path_Id,
Location => No_Location,
Flag => False,
Next => Nil_String);
Number_List_Table.Increment_Last
(Data.Tree.Number_Lists);
if Last_Source_Dir = Nil_String then
if Last_Source_Dir = Nil_String then
-- This is the first source directory
-- This is the first source directory
Project.Source_Dirs := String_Element_Table.Last
(Data.Tree.String_Elements);
Project.Source_Dirs :=
String_Element_Table.Last
(Data.Tree.String_Elements);
Project.Source_Dir_Ranks :=
Number_List_Table.Last
(Data.Tree.Number_Lists);
else
-- We already have source directories, link the
-- previous last to the new one.
else
-- We already have source directories, link the
-- previous last to the new one.
Data.Tree.String_Elements.Table
(Last_Source_Dir).Next :=
String_Element_Table.Last
(Data.Tree.String_Elements);
Data.Tree.Number_Lists.Table
(Last_Src_Dir_Rank).Next :=
Number_List_Table.Last
(Data.Tree.Number_Lists);
Data.Tree.String_Elements.Table
(Last_Source_Dir).Next :=
end if;
-- And register this source directory as the new
-- last.
Last_Source_Dir :=
String_Element_Table.Last
(Data.Tree.String_Elements);
Data.Tree.String_Elements.Table
(Last_Source_Dir) := Element;
Last_Src_Dir_Rank :=
Number_List_Table.Last
(Data.Tree.Number_Lists);
Data.Tree.Number_Lists.Table
(Last_Src_Dir_Rank) :=
(Number => Rank, Next => No_Number_List);
end if;
-- And register this source directory as the new last
Last_Source_Dir := String_Element_Table.Last
(Data.Tree.String_Elements);
Data.Tree.String_Elements.Table
(Last_Source_Dir) := Element;
else
-- Remove source dir, if present
Prev := Nil_String;
-- Look for source dir in current list
List := Project.Source_Dirs;
while List /= Nil_String loop
Element := Data.Tree.String_Elements.Table (List);
exit when Element.Value = Path_Id;
Prev := List;
List := Element.Next;
end loop;
if List /= Nil_String then
-- Source dir was found, remove it from the list
if Prev = Nil_String then
Project.Source_Dirs :=
Data.Tree.String_Elements.Table (List).Next;
Project.Source_Dir_Ranks :=
Data.Tree.Number_Lists.Table (Rank_List).Next;
else
Data.Tree.String_Elements.Table (Prev).Next :=
Data.Tree.String_Elements.Table (List).Next;
Data.Tree.Number_Lists.Table (Prev_Rank).Next :=
Data.Tree.Number_Lists.Table (Rank_List).Next;
end if;
end if;
end if;
......@@ -5276,6 +5342,13 @@ package body Prj.Nmsc is
Project.Source_Dirs :=
String_Element_Table.Last (Data.Tree.String_Elements);
Number_List_Table.Append
(Data.Tree.Number_Lists,
(Number => 1, Next => No_Number_List));
Project.Source_Dir_Ranks :=
Number_List_Table.Last (Data.Tree.Number_Lists);
if Current_Verbosity = High then
Write_Attr
("Default source directory",
......@@ -5296,15 +5369,17 @@ package body Prj.Nmsc is
declare
Source_Dir : String_List_Id;
Element : String_Element;
Rank : Natural;
begin
-- Process the source directories for each element of the list
Source_Dir := Source_Dirs.Values;
Rank := 0;
while Source_Dir /= Nil_String loop
Element := Data.Tree.String_Elements.Table (Source_Dir);
Rank := Rank + 1;
Find_Source_Dirs
(File_Name_Type (Element.Value), Element.Location);
(File_Name_Type (Element.Value), Element.Location, Rank);
Source_Dir := Element.Next;
end loop;
end;
......@@ -5326,6 +5401,7 @@ package body Prj.Nmsc is
Find_Source_Dirs
(File_Name_Type (Element.Value),
Element.Location,
0,
Removed => True);
Source_Dir := Element.Next;
end loop;
......@@ -6582,6 +6658,7 @@ package body Prj.Nmsc is
procedure Check_File
(Project : in out Project_Processing_Data;
Data : in out Tree_Processing_Data;
Source_Dir_Rank : Natural;
Path : Path_Name_Type;
File_Name : File_Name_Type;
Display_File_Name : File_Name_Type;
......@@ -6606,6 +6683,14 @@ package body Prj.Nmsc is
Kind : Source_Kind := Spec;
begin
if Current_Verbosity = High then
Write_Line ("Checking file:");
Write_Str (" Path = ");
Write_Line (Get_Name_String (Path));
Write_Str (" Rank =");
Write_Line (Source_Dir_Rank'Img);
end if;
if Name_Loc = No_Name_Location then
Check_Name := For_All_Sources;
......@@ -6615,7 +6700,7 @@ package body Prj.Nmsc is
-- Check if it is OK to have the same file name in several
-- source directories.
if not Project.Project.Known_Order_Of_Source_Dirs then
if Source_Dir_Rank = Name_Loc.Source.Source_Dir_Rank then
Error_Msg_File_1 := File_Name;
Error_Msg
(Data.Flags,
......@@ -6689,6 +6774,7 @@ package body Prj.Nmsc is
Add_Source
(Id => Source,
Project => Project.Project,
Source_Dir_Rank => Source_Dir_Rank,
Lang_Id => Language,
Kind => Kind,
Data => Data,
......@@ -6713,6 +6799,8 @@ package body Prj.Nmsc is
is
Source_Dir : String_List_Id;
Element : String_Element;
Src_Dir_Rank : Number_List_Index;
Num_Nod : Number_Node;
Dir : Dir_Type;
Name : String (1 .. 1_000);
Last : Natural;
......@@ -6727,12 +6815,21 @@ package body Prj.Nmsc is
-- Loop through subdirectories
Source_Dir := Project.Project.Source_Dirs;
Src_Dir_Rank := Project.Project.Source_Dir_Ranks;
while Source_Dir /= Nil_String loop
begin
Num_Nod := Data.Tree.Number_Lists.Table (Src_Dir_Rank);
Element := Data.Tree.String_Elements.Table (Source_Dir);
if Element.Value /= No_Name then
Get_Name_String (Element.Display_Value);
if Current_Verbosity = High then
Write_Str ("Directory: ");
Write_Str (Name_Buffer (1 .. Name_Len));
Write_Line (Num_Nod.Number'Img);
end if;
declare
Source_Directory : constant String :=
Name_Buffer (1 .. Name_Len) &
......@@ -6819,7 +6916,7 @@ package body Prj.Nmsc is
-- still need to add it to the list: if we
-- don't, the file will not appear in the
-- mapping file and will cause the compiler
-- to fail
-- to fail.
To_Remove := True;
end if;
......@@ -6827,6 +6924,7 @@ package body Prj.Nmsc is
Check_File
(Project => Project,
Source_Dir_Rank => Num_Nod.Number,
Data => Data,
Path => Path,
File_Name => File_Name,
......@@ -6847,6 +6945,7 @@ package body Prj.Nmsc is
end;
Source_Dir := Element.Next;
Src_Dir_Rank := Num_Nod.Next;
end loop;
if Current_Verbosity = High then
......@@ -7176,7 +7275,13 @@ package body Prj.Nmsc is
begin
if Current_Verbosity = High then
Write_Str ("Removing source ");
Write_Line (Get_Name_String (Id.File) & " at" & Id.Index'Img);
Write_Str (Get_Name_String (Id.File));
if Id.Index /= 0 then
Write_Str (" at" & Id.Index'Img);
end if;
Write_Eol;
end if;
if Replaced_By /= No_Source then
......
gcc/ada/prj.adb
......@@ -89,7 +89,7 @@ package body Prj is
Include_Path => null,
Include_Data_Set => False,
Source_Dirs => Nil_String,
Known_Order_Of_Source_Dirs => True,
Source_Dir_Ranks => No_Number_List,
Object_Directory => No_Path_Information,
Library_TS => Empty_Time_Stamp,
Exec_Directory => No_Path_Information,
......@@ -841,6 +841,7 @@ package body Prj is
begin
if Tree /= null then
Name_List_Table.Free (Tree.Name_Lists);
Number_List_Table.Free (Tree.Number_Lists);
String_Element_Table.Free (Tree.String_Elements);
Variable_Element_Table.Free (Tree.Variable_Elements);
Array_Element_Table.Free (Tree.Array_Elements);
......@@ -868,6 +869,7 @@ package body Prj is
-- Visible tables
Name_List_Table.Init (Tree.Name_Lists);
Number_List_Table.Init (Tree.Number_Lists);
String_Element_Table.Init (Tree.String_Elements);
Variable_Element_Table.Init (Tree.Variable_Elements);
Array_Element_Table.Init (Tree.Array_Elements);
......
gcc/ada/prj.ads
......@@ -314,7 +314,23 @@ package Prj is
Table_Low_Bound => 1,
Table_Initial => 10,
Table_Increment => 100);
-- The table for lists of names used in package Language_Processing
-- The table for lists of names
type Number_List_Index is new Nat;
No_Number_List : constant Number_List_Index := 0;
type Number_Node is record
Number : Natural := 0;
Next : Number_List_Index := No_Number_List;
end record;
package Number_List_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Number_Node,
Table_Index_Type => Number_List_Index,
Table_Low_Bound => 1,
Table_Initial => 10,
Table_Increment => 100);
-- The table for lists of numbers
package Mapping_Files_Htable is new Simple_HTable
(Header_Num => Header_Num,
......@@ -623,6 +639,12 @@ package Prj is
Project : Project_Id := No_Project;
-- Project of the source
Source_Dir_Rank : Natural := 0;
-- The rank of the source directory in list declared with attribute
-- Source_Dirs. Two source files with the same name cannot appears in
-- different directory with the same rank. That can happen when the
-- recursive notation <dir>/** is used in attribute Source_Dirs.
Language : Language_Ptr := No_Language_Index;
-- Index of the language. This is an index into
-- Project_Tree.Languages_Data.
......@@ -717,6 +739,7 @@ package Prj is
No_Source_Data : constant Source_Data :=
(Project => No_Project,
Source_Dir_Rank => 0,
Language => No_Language_Index,
In_Interfaces => True,
Declared_In_Interfaces => False,
......@@ -1155,10 +1178,7 @@ package Prj is
Source_Dirs : String_List_Id := Nil_String;
-- The list of all the source directories
Known_Order_Of_Source_Dirs : Boolean := True;
-- False, if there is any /** in the Source_Dirs, because in this case
-- the ordering of the source subdirs depend on the OS. If True,
-- duplicate file names in the same project file are allowed.
Source_Dir_Ranks : Number_List_Index := No_Number_List;
Ada_Include_Path : String_Access := null;
-- The cached value of source search path for this project file. Set by
......@@ -1273,6 +1293,7 @@ package Prj is
type Project_Tree_Data is
record
Name_Lists : Name_List_Table.Instance;
Number_Lists : Number_List_Table.Instance;
String_Elements : String_Element_Table.Instance;
Variable_Elements : Variable_Element_Table.Instance;
Array_Elements : Array_Element_Table.Instance;
......
gcc/ada/s-oscons-tmplt.c
......@@ -231,13 +231,13 @@ TXT(" Target_Name : constant String := " STR(TARGET) ";")
type Target_OS_Type is (Windows, VMS, Other_OS);
*/
#if defined (__MINGW32__)
# define TARGET_OS Windows
# define TARGET_OS "Windows"
#elif defined (__VMS)
# define TARGET_OS VMS
# define TARGET_OS "VMS"
#else
# define TARGET_OS Other_OS
# define TARGET_OS "Other_OS"
#endif
TXT(" Target_OS : constant Target_OS_Type := " STR(TARGET_OS) ";")
TXT(" Target_OS : constant Target_OS_Type := " TARGET_OS ";")
/*
-------------------
......
gcc/ada/sinfo.adb
......@@ -1583,6 +1583,14 @@ package body Sinfo is
return Uint3 (N);
end Intval;
function Is_Accessibility_Actual
(N : Node_Id) return Boolean is
begin
pragma Assert (False
or else NT (N).Nkind = N_Parameter_Association);
return Flag12 (N);
end Is_Accessibility_Actual;
function Is_Asynchronous_Call_Block
(N : Node_Id) return Boolean is
begin
......@@ -4435,6 +4443,14 @@ package body Sinfo is
Set_Uint3 (N, Val);
end Set_Intval;
procedure Set_Is_Accessibility_Actual
(N : Node_Id; Val : Boolean := True) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Parameter_Association);
Set_Flag12 (N, Val);
end Set_Is_Accessibility_Actual;
procedure Set_Is_Asynchronous_Call_Block
(N : Node_Id; Val : Boolean := True) is
begin
......
gcc/ada/sinfo.ads
......@@ -1179,6 +1179,13 @@ package Sinfo is
-- to the node for the spec of the instance, inserted as part of the
-- semantic processing for instantiations in Sem_Ch12.
-- Is_Accessibility_Actual (Flag12-Sem)
-- Present in N_Parameter_Association nodes. True if the parameter is
-- an extra actual that carries the accessibility level of the actual
-- for an access parameter, in a function that dispatches on result and
-- is called in a dispatching context. Used to prevent a formal/actual
-- mismatch when the call is rewritten as a dispatching call.
-- Is_Asynchronous_Call_Block (Flag7-Sem)
-- A flag set in a Block_Statement node to indicate that it is the
-- expansion of an asynchronous entry call. Such a block needs cleanup
......@@ -4450,6 +4457,7 @@ package Sinfo is
-- Selector_Name (Node2) (always non-Empty)
-- Explicit_Actual_Parameter (Node3)
-- Next_Named_Actual (Node4-Sem)
-- Is_Accessibility_Actual (Flag12-Sem)
---------------------------
-- 6.4 Actual Parameter --
......@@ -8070,6 +8078,9 @@ package Sinfo is
function Intval
(N : Node_Id) return Uint; -- Uint3
function Is_Accessibility_Actual
(N : Node_Id) return Boolean; -- Flag12
function Is_Asynchronous_Call_Block
(N : Node_Id) return Boolean; -- Flag7
......@@ -8979,6 +8990,9 @@ package Sinfo is
procedure Set_Intval
(N : Node_Id; Val : Uint); -- Uint3
procedure Set_Is_Accessibility_Actual
(N : Node_Id; Val : Boolean := True); -- Flag12
procedure Set_Is_Asynchronous_Call_Block
(N : Node_Id; Val : Boolean := True); -- Flag7
......@@ -11246,6 +11260,7 @@ package Sinfo is
pragma Inline (In_Present);
pragma Inline (Instance_Spec);
pragma Inline (Intval);
pragma Inline (Is_Accessibility_Actual);
pragma Inline (Is_Asynchronous_Call_Block);
pragma Inline (Is_Component_Left_Opnd);
pragma Inline (Is_Component_Right_Opnd);
......@@ -11545,6 +11560,7 @@ package Sinfo is
pragma Inline (Set_In_Present);
pragma Inline (Set_Instance_Spec);
pragma Inline (Set_Intval);
pragma Inline (Set_Is_Accessibility_Actual);
pragma Inline (Set_Is_Asynchronous_Call_Block);
pragma Inline (Set_Is_Component_Left_Opnd);
pragma Inline (Set_Is_Component_Right_Opnd);
......
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