Skip to content

R
riscv-gcc-1
Commit 3c1ecd7e by Arnaud Charlet
Options

[multiple changes] 

2010-09-10  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_disp.adb: Minor reformatting.

2010-09-10  Arnaud Charlet  <charlet@adacore.com>

	* sem_prag.adb (Analyze_Pragma): Ignore Inline_Always pragma in
	CodePeer mode.

2010-09-10  Thomas Quinot  <quinot@adacore.com>

	* sem_res.adb: Minor reformatting.
	* exp_ch9.adb, rtsfind.ads, exp_ch4.adb, exp_ch3.adb: Do not hardcode
	magic constants for task master levels (instead, reference
	named numbers from System.Tasking).

2010-09-10  Eric Botcazou  <ebotcazou@adacore.com>

	* gnatvsn.ads (Ver_Prefix): New constant string.
	* bindgen.adb (Gen_Output_File_Ada): Use it in lieu of hardcoded value.
	(Gen_Output_File_C): Likewise.
	* g-comver.adb (Ver_Prefix): Add cross-reference to Gnatvsn.Ver_Prefix
	in comment.
	
2010-09-10  Ed Schonberg  <schonberg@adacore.com>

	* sem.adb (Walk_Library_Items): Do not traverse children of the main
	unit, to prevent spurious circularities in the walk order.
	(Depends_On_Main): Use elsewhere to prevent circularities when the body
	of an ancestor of the main unit depends on a child of the main unit.

From-SVN: r164157
parent 4120ada7
Showing with 145 additions and 69 deletions
gcc/ada/ChangeLog
2010-09-10 Eric Botcazou <ebotcazou@adacore.com>
* exp_disp.adb: Minor reformatting.
2010-09-10 Arnaud Charlet <charlet@adacore.com>
* sem_prag.adb (Analyze_Pragma): Ignore Inline_Always pragma in
CodePeer mode.
2010-09-10 Thomas Quinot <quinot@adacore.com>
* sem_res.adb: Minor reformatting.
* exp_ch9.adb, rtsfind.ads, exp_ch4.adb, exp_ch3.adb: Do not hardcode
magic constants for task master levels (instead, reference
named numbers from System.Tasking).
2010-09-10 Eric Botcazou <ebotcazou@adacore.com>
* gnatvsn.ads (Ver_Prefix): New constant string.
* bindgen.adb (Gen_Output_File_Ada): Use it in lieu of hardcoded value.
(Gen_Output_File_C): Likewise.
* g-comver.adb (Ver_Prefix): Add cross-reference to Gnatvsn.Ver_Prefix
in comment.
2010-09-10 Ed Schonberg <schonberg@adacore.com>
* sem.adb (Walk_Library_Items): Do not traverse children of the main
unit, to prevent spurious circularities in the walk order.
(Depends_On_Main): Use elsewhere to prevent circularities when the body
of an ancestor of the main unit depends on a child of the main unit.
2010-09-10 Robert Dewar <dewar@adacore.com>
* gnatlink.adb, prj-ext.adb, prj-util.adb, s-tporft.adb,
......
gcc/ada/bindgen.adb
......@@ -2341,7 +2341,7 @@ package body Bindgen is
WBI ("");
WBI (" GNAT_Version : constant String :=");
WBI (" ""GNAT Version: " &
WBI (" """ & Ver_Prefix &
Gnat_Version_String &
""" & ASCII.NUL;");
WBI (" pragma Export (C, GNAT_Version, ""__gnat_version"");");
......@@ -2750,7 +2750,7 @@ package body Bindgen is
if Bind_Main_Program then
WBI ("");
WBI ("char __gnat_version[] = ""GNAT Version: " &
WBI ("char __gnat_version[] = """ & Ver_Prefix &
Gnat_Version_String & """;");
Set_String ("char __gnat_ada_main_program_name[] = """);
......
gcc/ada/exp_ch3.adb
......@@ -1481,12 +1481,8 @@ package body Exp_Ch3 is
if Has_Task (Full_Type) then
if Restriction_Active (No_Task_Hierarchy) then
-- 3 is System.Tasking.Library_Task_Level
-- (should be rtsfindable constant ???)
Append_To (Args, Make_Integer_Literal (Loc, 3));
Append_To (Args,
New_Occurrence_Of (RTE (RE_Library_Task_Level), Loc));
else
Append_To (Args, Make_Identifier (Loc, Name_uMaster));
end if;
......@@ -2042,10 +2038,8 @@ package body Exp_Ch3 is
if Has_Task (Rec_Type) then
if Restriction_Active (No_Task_Hierarchy) then
-- 3 is System.Tasking.Library_Task_Level
Append_To (Args, Make_Integer_Literal (Loc, 3));
Append_To (Args,
New_Occurrence_Of (RTE (RE_Library_Task_Level), Loc));
else
Append_To (Args, Make_Identifier (Loc, Name_uMaster));
end if;
......
gcc/ada/exp_ch4.adb
......@@ -3724,8 +3724,8 @@ package body Exp_Ch4 is
end if;
if Restriction_Active (No_Task_Hierarchy) then
-- 3 is System.Tasking.Library_Task_Level
Append_To (Args, Make_Integer_Literal (Loc, 3));
Append_To (Args,
New_Occurrence_Of (RTE (RE_Library_Task_Level), Loc));
else
Append_To (Args,
New_Reference_To
......
gcc/ada/exp_ch9.adb
......@@ -12133,13 +12133,14 @@ package body Exp_Ch9 is
-- Master parameter. This is a reference to the _Master parameter of
-- the initialization procedure, except in the case of the pragma
-- Restrictions (No_Task_Hierarchy) where the value is fixed to 3
-- (3 is System.Tasking.Library_Task_Level).
-- Restrictions (No_Task_Hierarchy) where the value is fixed to
-- System.Tasking.Library_Task_Level.
if Restriction_Active (No_Task_Hierarchy) = False then
Append_To (Args, Make_Identifier (Loc, Name_uMaster));
else
Append_To (Args, Make_Integer_Literal (Loc, 3));
Append_To (Args,
New_Occurrence_Of (RTE (RE_Library_Task_Level), Loc));
end if;
end if;
......
gcc/ada/exp_disp.adb
......@@ -6667,8 +6667,8 @@ package body Exp_Disp is
end;
end if;
-- Mark entities of dispatch table. Required by the back end to
-- handle them properly.
-- Mark entities of dispatch table. Required by the back end to handle
-- them properly.
if Present (DT) then
Set_Is_Dispatch_Table_Entity (DT);
......
gcc/ada/g-comver.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2008, AdaCore --
-- Copyright (C) 2002-2010, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -42,7 +42,8 @@ package body GNAT.Compiler_Version is
-- import this directly since run-time units cannot WITH compiler units.
Ver_Prefix : constant String := "GNAT Version: ";
-- Prefix generated by binder
-- This is logically a reference to Gnatvsn.Ver_Prefix but we cannot
-- import this directly since run-time units cannot WITH compiler units.
GNAT_Version : constant String (1 .. Ver_Len_Max + Ver_Prefix'Length);
pragma Import (C, GNAT_Version, "__gnat_version");
......
gcc/ada/gnatvsn.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2010 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -77,6 +77,10 @@ package Gnatvsn is
-- value should never be decreased in the future, but it would be
-- OK to increase it if absolutely necessary.
Ver_Prefix : constant String := "GNAT Version: ";
-- Prefix generated by binder. If it is changed, be sure to change
-- GNAT.Compiler_Version.Ver_Prefix as well.
Library_Version : constant String := "4.6";
-- Library version. This value must be updated whenever any change to the
-- compiler affects the library formats in such a way as to obsolete
......
gcc/ada/rtsfind.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -1396,6 +1396,11 @@ package Rtsfind is
RE_Conditional_Call, -- System.Tasking
RE_Asynchronous_Call, -- System.Tasking
RE_Foreign_Task_Level, -- System.Tasking
RE_Environment_Task_Level, -- System.Tasking
RE_Independent_Task_Level, -- System.Tasking
RE_Library_Task_Level, -- System.Tasking
RE_Ada_Task_Control_Block, -- System.Tasking
RE_Task_List, -- System.Tasking
......@@ -2561,6 +2566,11 @@ package Rtsfind is
RE_Conditional_Call => System_Tasking,
RE_Asynchronous_Call => System_Tasking,
RE_Foreign_Task_Level => System_Tasking,
RE_Environment_Task_Level => System_Tasking,
RE_Independent_Task_Level => System_Tasking,
RE_Library_Task_Level => System_Tasking,
RE_Ada_Task_Control_Block => System_Tasking,
RE_Task_List => System_Tasking,
......
gcc/ada/sem.adb
......@@ -1539,6 +1539,23 @@ package body Sem is
-- context of some other unit. We do not want this to force processing
-- of the main body before all other units have been processed.
function Depends_On_Main (CU : Node_Id) return Boolean;
-- The body of a unit that is withed by the spec of the main unit
-- may in turn have a with_clause on that spec. In that case do not
-- traverse the body, to prevent loops. It can also happen that the
-- main body has a with_clause on a child, which of course has an
-- implicit with on its parent. It's OK to traverse the child body
-- if the main spec has been processed, otherwise we also have a
-- circularity to avoid.
-- Another circularity pattern occurs when the main unit is a child unit
-- and the body of an ancestor has a with-clause of the main unit or on
-- one of its children. In both cases the body in question has a with-
-- clause on the main unit, and must be excluded from the traversal. In
-- some convoluted cases this may lead to a CodePeer error because the
-- spec of a subprogram declared in an instance within the parent will
-- not be seen in the main unit.
procedure Do_Action (CU : Node_Id; Item : Node_Id);
-- Calls Action, with some validity checks
......@@ -1558,6 +1575,39 @@ package body Sem is
-- is processed wherever it appears in the list of units, while the body
-- is processed as the last unit in the list.
---------------------
-- Depends_On_Main --
---------------------
function Depends_On_Main (CU : Node_Id) return Boolean is
CL : Node_Id;
MCU : constant Node_Id := Unit (Main_CU);
begin
CL := First (Context_Items (CU));
-- Problem does not arise with main subprograms
if
not Nkind_In (MCU, N_Package_Body, N_Package_Declaration)
then
return False;
end if;
while Present (CL) loop
if Nkind (CL) = N_With_Clause
and then Library_Unit (CL) = Main_CU
and then not Done (Get_Cunit_Unit_Number (Library_Unit (CL)))
then
return True;
end if;
Next (CL);
end loop;
return False;
end Depends_On_Main;
---------------
-- Do_Action --
---------------
......@@ -1812,45 +1862,6 @@ package body Sem is
procedure Do_Withed_Units is new Walk_Withs (Do_Withed_Unit);
function Depends_On_Main (CU : Node_Id) return Boolean;
-- The body of a unit that is withed by the spec of the main unit
-- may in turn have a with_clause on that spec. In that case do not
-- traverse the body, to prevent loops. It can also happen that the
-- main body has a with_clause on a child, which of course has an
-- implicit with on its parent. It's OK to traverse the child body
-- if the main spec has been processed, otherwise we also have a
-- circularity to avoid.
---------------------
-- Depends_On_Main --
---------------------
function Depends_On_Main (CU : Node_Id) return Boolean is
CL : Node_Id;
begin
CL := First (Context_Items (CU));
-- Problem does not arise with main subprograms
if Nkind (Unit (Main_CU)) /= N_Package_Body then
return False;
end if;
while Present (CL) loop
if Nkind (CL) = N_With_Clause
and then Library_Unit (CL) = Library_Unit (Main_CU)
and then not Done (Get_Cunit_Unit_Number (Library_Unit (CL)))
then
return True;
end if;
Next (CL);
end loop;
return False;
end Depends_On_Main;
-- Start of processing for Process_Bodies_In_Context
begin
......@@ -1931,8 +1942,9 @@ package body Sem is
Cur := First_Elmt (Comp_Unit_List);
while Present (Cur) loop
declare
CU : constant Node_Id := Node (Cur);
N : constant Node_Id := Unit (CU);
CU : constant Node_Id := Node (Cur);
N : constant Node_Id := Unit (CU);
Par : Entity_Id;
begin
pragma Assert (Nkind (CU) = N_Compilation_Unit);
......@@ -1969,10 +1981,26 @@ package body Sem is
Unit (Library_Unit (Main_CU)));
end if;
-- It's a spec, process it, and the units it depends on
-- It's a spec, process it, and the units it depends on,
-- unless it is a descendent of the main unit. This can
-- happen when the body of a parent depends on some other
-- descendent.
when others =>
Do_Unit_And_Dependents (CU, N);
Par := Scope (Defining_Entity (Unit (CU)));
if Is_Child_Unit (Defining_Entity (Unit (CU))) then
while Present (Par)
and then Par /= Standard_Standard
and then Par /= Cunit_Entity (Main_Unit)
loop
Par := Scope (Par);
end loop;
end if;
if Par /= Cunit_Entity (Main_Unit) then
Do_Unit_And_Dependents (CU, N);
end if;
end case;
end;
......@@ -2042,6 +2070,7 @@ package body Sem is
if Present (Body_CU)
and then not Seen (Get_Cunit_Unit_Number (Body_CU))
and then not Depends_On_Main (Body_CU)
then
Body_U := Get_Cunit_Unit_Number (Body_CU);
Seen (Body_U) := True;
......
gcc/ada/sem_prag.adb
......@@ -8287,7 +8287,13 @@ package body Sem_Prag is
when Pragma_Inline_Always =>
GNAT_Pragma;
Process_Inline (True);
-- Pragma always active unless in CodePeer mode, since this causes
-- walk order issues.
if not CodePeer_Mode then
Process_Inline (True);
end if;
--------------------
-- Inline_Generic --
......
gcc/ada/sem_res.adb
......@@ -9302,8 +9302,8 @@ package body Sem_Res is
Index_Subtype := Create_Itype (Subtype_Kind (Ekind (Index_Type)), N);
-- Take a new copy of Drange (where bounds have been rewritten to
-- reference side-effect-vree names). Using a separate tree ensures
-- that further expansion (e.g while rewriting a slice assignment
-- reference side-effect-free names). Using a separate tree ensures
-- that further expansion (e.g. while rewriting a slice assignment
-- into a FOR loop) does not attempt to remove side effects on the
-- bounds again (which would cause the bounds in the index subtype
-- definition to refer to temporaries before they are defined) (the
......
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