Skip to content

R
riscv-gcc-1
Commit e379beb5 by Arnaud Charlet
Options

[multiple changes] 

2016-04-21  Javier Miranda  <miranda@adacore.com>

	* frontend.adb: Remove call to initialize Exp_Ch6.
	* exp_ch6.ads, exp_ch6.adb (Initialize): removed.
	(Unest_Entry/Unest_Bodies): Removed.
	(Unnest_Subprograms): Code cleanup.

2016-04-21  Arnaud Charlet  <charlet@adacore.com>

	* set_targ.adb (Read_Target_Dependent_Values):
	close target description file once its contents is read.
	* s-os_lib.adb (Non_Blocking_Spawn, version with Stdout_File
	and Stderr_File): Close local file descriptors before spawning
	child process.
	* exp_util.adb (Containing_Package_With_Ext_Axioms): Limit scope of
	local variables to make the code easier to understand and avoid
	duplicated calls to Parent and Generic_Parent.

From-SVN: r235302
parent 2e9bd657
Showing with 86 additions and 126 deletions
gcc/ada/ChangeLog
2016-04-21 Javier Miranda <miranda@adacore.com>
* frontend.adb: Remove call to initialize Exp_Ch6.
* exp_ch6.ads, exp_ch6.adb (Initialize): removed.
(Unest_Entry/Unest_Bodies): Removed.
(Unnest_Subprograms): Code cleanup.
2016-04-21 Arnaud Charlet <charlet@adacore.com>
* set_targ.adb (Read_Target_Dependent_Values):
close target description file once its contents is read.
* s-os_lib.adb (Non_Blocking_Spawn, version with Stdout_File
and Stderr_File): Close local file descriptors before spawning
child process.
* exp_util.adb (Containing_Package_With_Ext_Axioms): Limit scope of
local variables to make the code easier to understand and avoid
duplicated calls to Parent and Generic_Parent.
2016-04-20 Bob Duff <duff@adacore.com>
* s-os_lib.ads: Minor comment fix.
......
gcc/ada/exp_ch6.adb
......@@ -72,7 +72,6 @@ with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
with Snames; use Snames;
with Stand; use Stand;
with Table;
with Targparm; use Targparm;
with Tbuild; use Tbuild;
with Uintp; use Uintp;
......@@ -80,33 +79,6 @@ with Validsw; use Validsw;
package body Exp_Ch6 is
-------------------------------------
-- Table for Unnesting Subprograms --
-------------------------------------
-- When we expand a subprogram body, if it has nested subprograms and if
-- we are in Unnest_Subprogram_Mode, then we record the subprogram entity
-- and the body in this table, to later be passed to Unnest_Subprogram.
-- We need this delaying mechanism, because we have to wait until all
-- instantiated bodies have been inserted before doing the unnesting.
type Unest_Entry is record
Ent : Entity_Id;
-- Entity for subprogram to be unnested
Bod : Node_Id;
-- Subprogram body to be unnested
end record;
package Unest_Bodies is new Table.Table (
Table_Component_Type => Unest_Entry,
Table_Index_Type => Nat,
Table_Low_Bound => 1,
Table_Initial => 100,
Table_Increment => 200,
Table_Name => "Unest_Bodies");
-----------------------
-- Local Subprograms --
-----------------------
......@@ -6803,15 +6775,6 @@ package body Exp_Ch6 is
return False;
end Has_Unconstrained_Access_Discriminants;
----------------
-- Initialize --
----------------
procedure Initialize is
begin
Unest_Bodies.Init;
end Initialize;
--------------------------------
-- Is_Build_In_Place_Function --
--------------------------------
......@@ -8477,62 +8440,44 @@ package body Exp_Ch6 is
procedure Unnest_Subprograms (N : Node_Id) is
procedure Search_Unnesting_Subprograms (N : Node_Id);
-- Search for outer level procedures with nested subprograms and append
-- them to the Unnest table.
function Search_Subprograms (N : Node_Id) return Traverse_Result;
-- Tree visitor that search for outer level procedures with nested
-- subprograms and invokes Unnest_Subprogram()
----------------------------------
-- Search_Unnesting_Subprograms --
----------------------------------
procedure Search_Unnesting_Subprograms (N : Node_Id) is
function Search_Subprograms (N : Node_Id) return Traverse_Result;
-- Tree visitor that search for outer level procedures with nested
-- subprograms and adds them to the Unnest table.
------------------------
-- Search_Subprograms --
------------------------
function Search_Subprograms (N : Node_Id) return Traverse_Result is
begin
if Nkind_In (N, N_Subprogram_Body,
N_Subprogram_Body_Stub)
then
declare
Spec_Id : constant Entity_Id := Unique_Defining_Entity (N);
begin
-- We are only interested in subprograms (not generic
-- subprograms), that have nested subprograms.
------------------------
-- Search_Subprograms --
------------------------
if Is_Subprogram (Spec_Id)
and then Has_Nested_Subprogram (Spec_Id)
and then Is_Library_Level_Entity (Spec_Id)
then
Unest_Bodies.Append ((Spec_Id, N));
end if;
end;
end if;
function Search_Subprograms (N : Node_Id) return Traverse_Result is
begin
if Nkind_In (N, N_Subprogram_Body,
N_Subprogram_Body_Stub)
then
declare
Spec_Id : constant Entity_Id := Unique_Defining_Entity (N);
return OK;
end Search_Subprograms;
begin
-- We are only interested in subprograms (not generic
-- subprograms), that have nested subprograms.
---------------
-- Do_Search --
---------------
if Is_Subprogram (Spec_Id)
and then Has_Nested_Subprogram (Spec_Id)
and then Is_Library_Level_Entity (Spec_Id)
then
Unnest_Subprogram (Spec_Id, N);
end if;
end;
end if;
procedure Do_Search is new Traverse_Proc (Search_Subprograms);
-- Subtree visitor instantiation
return OK;
end Search_Subprograms;
-- Start of processing for Search_Unnesting_Subprograms
---------------
-- Do_Search --
---------------
begin
if Opt.Unnest_Subprogram_Mode then
Do_Search (N);
end if;
end Search_Unnesting_Subprograms;
procedure Do_Search is new Traverse_Proc (Search_Subprograms);
-- Subtree visitor instantiation
-- Start of processing for Unnest_Subprograms
......@@ -8541,15 +8486,7 @@ package body Exp_Ch6 is
return;
end if;
Search_Unnesting_Subprograms (N);
for J in Unest_Bodies.First .. Unest_Bodies.Last loop
declare
UBJ : Unest_Entry renames Unest_Bodies.Table (J);
begin
Unnest_Subprogram (UBJ.Ent, UBJ.Bod);
end;
end loop;
Do_Search (N);
end Unnest_Subprograms;
end Exp_Ch6;
gcc/ada/exp_ch6.ads
......@@ -117,9 +117,6 @@ package Exp_Ch6 is
-- The returned node is the root of the procedure body which will replace
-- the original function body, which is not needed for the C program.
procedure Initialize;
-- Initialize internal tables
function Is_Build_In_Place_Function (E : Entity_Id) return Boolean;
-- Ada 2005 (AI-318-02): Returns True if E denotes a function, generic
-- function, or access-to-function type whose result must be built in
......
gcc/ada/exp_util.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2016, 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- --
......@@ -1728,11 +1728,7 @@ package body Exp_Util is
----------------------------------------
function Containing_Package_With_Ext_Axioms
(E : Entity_Id) return Entity_Id
is
Decl : Node_Id;
First_Ax_Parent_Scope : Entity_Id;
(E : Entity_Id) return Entity_Id is
begin
-- E is the package or generic package which is externally axiomatized
......@@ -1745,29 +1741,35 @@ package body Exp_Util is
-- If E's scope is axiomatized, E is axiomatized
if Present (Scope (E)) then
First_Ax_Parent_Scope :=
Containing_Package_With_Ext_Axioms (Scope (E));
if Present (First_Ax_Parent_Scope) then
return First_Ax_Parent_Scope;
end if;
declare
First_Ax_Parent_Scope : constant Entity_Id :=
Containing_Package_With_Ext_Axioms (Scope (E));
begin
if Present (First_Ax_Parent_Scope) then
return First_Ax_Parent_Scope;
end if;
end;
end if;
-- Otherwise, if E is a package instance, it is axiomatized if the
-- corresponding generic package is axiomatized.
if Ekind (E) = E_Package then
if Nkind (Parent (E)) = N_Defining_Program_Unit_Name then
Decl := Parent (Parent (E));
else
Decl := Parent (E);
end if;
declare
Par : constant Node_Id := Parent (E);
Decl : Node_Id;
begin
if Nkind (Par) = N_Defining_Program_Unit_Name then
Decl := Parent (Par);
else
Decl := Par;
end if;
if Present (Generic_Parent (Decl)) then
return
Containing_Package_With_Ext_Axioms (Generic_Parent (Decl));
end if;
if Present (Generic_Parent (Decl)) then
return
Containing_Package_With_Ext_Axioms (Generic_Parent (Decl));
end if;
end;
end if;
return Empty;
......
gcc/ada/frontend.adb
......@@ -90,7 +90,6 @@ begin
Checks.Initialize;
Sem_Warn.Initialize;
Prep.Initialize;
Exp_Ch6.Initialize;
if Generate_SCIL then
SCIL_LL.Initialize;
......
gcc/ada/s-os_lib.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1995-2015, AdaCore --
-- Copyright (C) 1995-2016, 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- --
......@@ -1848,6 +1848,8 @@ package body System.OS_Lib is
Saved_Error : File_Descriptor;
Saved_Output : File_Descriptor;
Dummy_Status : Boolean;
begin
-- Do not attempt to spawn if the output files could not be created
......@@ -1863,9 +1865,8 @@ package body System.OS_Lib is
Saved_Error := Dup (Standerr);
Dup2 (Stderr_FD, Standerr);
-- Spawn the program
Result := Non_Blocking_Spawn (Program_Name, Args);
Set_Close_On_Exec (Saved_Output, True, Dummy_Status);
Set_Close_On_Exec (Saved_Error, True, Dummy_Status);
-- Close the files just created for the output, as the file descriptors
-- cannot be used anywhere, being local values. It is safe to do that,
......@@ -1875,6 +1876,10 @@ package body System.OS_Lib is
Close (Stdout_FD);
Close (Stderr_FD);
-- Spawn the program
Result := Non_Blocking_Spawn (Program_Name, Args);
-- Restore the standard output and error
Dup2 (Saved_Output, Standout);
......
gcc/ada/set_targ.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2013-2015, Free Software Foundation, Inc. --
-- Copyright (C) 2013-2016, 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- --
......@@ -698,6 +698,8 @@ package body Set_Targ is
Buflen := Read (File_Desc, Buffer'Address, Buffer'Length);
Close (File_Desc);
if Buflen = Buffer'Length then
Fail ("file is too long: " & File_Name);
end if;
......
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