Skip to content

R
riscv-gcc-1
Commit 76b4158b by Hristian Kirtchev Committed by Pierre-Marie de Rodat
Options

[Ada] Forced elaboration order in Elaboration order v4.0 

This patch refactors the forced elaboration order functionality,
reintegrates it in Binde, and impelements it in Bindo.

------------
-- Source --
------------

--  server.ads

package Server is
end Server;

--  client.ads

with Server;

package Client is
end Client;

--  main.adb

with Client;

procedure Main is begin null; end Main;

--  duplicate_1.txt

server (spec)
client (spec)
server (spec)

--  error_unit_1.txt

no such unit
client (spec)

--  error_unit_2.txt

no such unit
client (spec)

--  error_unit_3.txt

no such unit     --  comment
client (spec)

--  error_unit_4.txt

         no such unit     --  comment

client (spec)

--  error_unit_5.txt

no such unit (body)
client (spec)

--  error_unit_6.txt

    no such unit (body)
client (spec)

--  error_unit_7.txt

    no such unit (body)    --  comment
client (spec)

--  error_unit_8.txt

    no such unit (body)--  comment
client (spec)

--  error_unit_9.txt

    no such unit--  comment
client (spec)

--  no_unit_1.txt

--  no_unit_2.txt

--  no_unit_3.txt

      --  comment

--  no_unit_4.txt

--  no_unit_5.txt

--  no_unit_6.txt

       --  comment

--  no_unit_7.txt

--  no_unit_8.txt

    --  comment
--  comment

--  ok_unit_1.txt

server (spec)
client (spec)

--  ok_unit_2.txt

    server (spec)
client (spec)

--  ok_unit_3.txt

    server (spec)
client (spec)

--  ok_unit_4.txt

    server (spec)      --  comment
client (spec)

--  ok_unit_5.txt

server (spec)
client (spec)

--  ok_unit_6.txt

server (spec)
client (spec)    --  comment

--  ok_unit_7.txt

server (spec)
client (spec)    --  comment

--  ok_unit_8.txt

    --  comment
--  comment
    server (spec)

   --  comment
--  comment

client (spec)    --  comment

--  ok_unit_9.txt

server (spec)--  comment
client (spec)

----------------------------
-- Compilation and output --
----------------------------
$ gnatmake -q main.adb
$ gnatbind -fno_unit_1.txt main.ali
$ gnatbind -fno_unit_2.txt main.ali
$ gnatbind -fno_unit_3.txt main.ali
$ gnatbind -fno_unit_4.txt main.ali
$ gnatbind -fno_unit_5.txt main.ali
$ gnatbind -fno_unit_6.txt main.ali
$ gnatbind -fno_unit_7.txt main.ali
$ gnatbind -fno_unit_8.txt main.ali
$ gnatbind -ferror_unit_1.txt main.ali
$ gnatbind -ferror_unit_2.txt main.ali
$ gnatbind -ferror_unit_3.txt main.ali
$ gnatbind -ferror_unit_4.txt main.ali
$ gnatbind -ferror_unit_5.txt main.ali
$ gnatbind -ferror_unit_6.txt main.ali
$ gnatbind -ferror_unit_7.txt main.ali
$ gnatbind -ferror_unit_8.txt main.ali
$ gnatbind -ferror_unit_9.txt main.ali
$ gnatbind -fduplicate_1.txt main.ali
$ gnatbind -fok_unit_1.txt main.ali
$ gnatbind -fok_unit_2.txt main.ali
$ gnatbind -fok_unit_3.txt main.ali
$ gnatbind -fok_unit_4.txt main.ali
$ gnatbind -fok_unit_5.txt main.ali
$ gnatbind -fok_unit_6.txt main.ali
$ gnatbind -fok_unit_7.txt main.ali
$ gnatbind -fok_unit_8.txt main.ali
$ gnatbind -fok_unit_9.txt main.ali
"no such unit": not present; ignored
"no such unit": not present; ignored
"no such unit": not present; ignored
"no such unit": not present; ignored
"no such unit%b": not present; ignored
"no such unit%b": not present; ignored
"no such unit%b": not present; ignored
"no such unit%b": not present; ignored
"no such unit": not present; ignored
server (spec) <-- client (spec)
error: duplicate_1.txt:3: duplicate unit name "server (spec)" from line 1
server (spec) <-- client (spec)
server (spec) <-- client (spec)
server (spec) <-- client (spec)
server (spec) <-- client (spec)
server (spec) <-- client (spec)
server (spec) <-- client (spec)
server (spec) <-- client (spec)
server (spec) <-- client (spec)
server (spec) <-- client (spec)

2019-07-03  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* binde.adb: Remove with clause for System.OS_Lib.
	(Force_Elab_Order): Refactor the majority of the code in Butil.
	Use the new forced units iterator to obtain unit names.
	* bindo-builders.adb: Add with and use clauses for Binderr,
	Butil, Opt, Output, Types, GNAT, and GNAT.Dynamic_HTables.  Add
	a hash table which maps units to line number in the forced
	elaboration order file.
	(Add_Unit): New routine.
	(Build_Library_Graph): Create forced edges between pairs of
	units listed in the forced elaboration order file.
	(Create_Forced_Edge, Create_Forced_Edges, Destroy_Line_Number,
	Duplicate_Unit_Error, Hash_Unit, Internal_Unit_Info,
	Is_Duplicate_Unit, Missing_Unit_Info): New routines.
	* bindo-graphs.adb (Is_Internal_Unit, Is_Predefined_Unit):
	Refactor some of the behavior to Bindo-Units.
	* bindo-graphs.ads: Enable the enumeration literal for forced
	edges.
	* bindo-units.adb, bindo-units.ads (Is_Internal_Unit,
	Is_Predefined_Unit): New routines.
	* butil.adb: Add with and use clauses for Opt, GNAT, and
	System.OS_Lib.  Add with clause for Unchecked_Deallocation.
	(Has_Next, Iterate_Forced_Units, Next, Parse_Next_Unit_Name,
	Read_Forced_Elab_Order_File): New routines.
	* butil.ads: Add with and use clauses for Types.  Add new
	iterator over the units listed in the forced elaboration order
	file.
	(Has_Next, Iterate_Forced_Units, Next): New routine.
	* namet.adb, namet.ads (Present): New routine.

From-SVN: r272987
parent 336878fc
Showing with 408 additions and 191 deletions
gcc/ada/ChangeLog
2019-07-03 Hristian Kirtchev <kirtchev@adacore.com>
* binde.adb: Remove with clause for System.OS_Lib.
(Force_Elab_Order): Refactor the majority of the code in Butil.
Use the new forced units iterator to obtain unit names.
* bindo-builders.adb: Add with and use clauses for Binderr,
Butil, Opt, Output, Types, GNAT, and GNAT.Dynamic_HTables. Add
a hash table which maps units to line number in the forced
elaboration order file.
(Add_Unit): New routine.
(Build_Library_Graph): Create forced edges between pairs of
units listed in the forced elaboration order file.
(Create_Forced_Edge, Create_Forced_Edges, Destroy_Line_Number,
Duplicate_Unit_Error, Hash_Unit, Internal_Unit_Info,
Is_Duplicate_Unit, Missing_Unit_Info): New routines.
* bindo-graphs.adb (Is_Internal_Unit, Is_Predefined_Unit):
Refactor some of the behavior to Bindo-Units.
* bindo-graphs.ads: Enable the enumeration literal for forced
edges.
* bindo-units.adb, bindo-units.ads (Is_Internal_Unit,
Is_Predefined_Unit): New routines.
* butil.adb: Add with and use clauses for Opt, GNAT, and
System.OS_Lib. Add with clause for Unchecked_Deallocation.
(Has_Next, Iterate_Forced_Units, Next, Parse_Next_Unit_Name,
Read_Forced_Elab_Order_File): New routines.
* butil.ads: Add with and use clauses for Types. Add new
iterator over the units listed in the forced elaboration order
file.
(Has_Next, Iterate_Forced_Units, Next): New routine.
* namet.adb, namet.ads (Present): New routine.
2019-07-03 Bob Duff <duff@adacore.com>
* sem_ch3.adb (Access_Definition): The code was creating a
......
gcc/ada/binde.adb
......@@ -35,7 +35,6 @@ with Types; use Types;
with System.Case_Util; use System.Case_Util;
with System.HTable;
with System.OS_Lib;
package body Binde is
use Unit_Id_Tables;
......@@ -115,7 +114,7 @@ package body Binde is
-- elaborated before After is elaborated.
Forced,
-- Before and After come from a pair of lines in the forced elaboration
-- Before and After come from a pair of lines in the forced-elaboration-
-- order file.
Elab,
......@@ -382,7 +381,7 @@ package body Binde is
-- "$ must be elaborated before $ ..." where ... is the reason.
procedure Force_Elab_Order;
-- Gather dependencies from the forced elaboration order file (-f switch)
-- Gather dependencies from the forced-elaboration-order file (-f switch)
procedure Gather_Dependencies;
-- Compute dependencies, building the Succ and UNR tables
......@@ -1795,30 +1794,13 @@ package body Binde is
----------------------
procedure Force_Elab_Order is
use System.OS_Lib;
-- There is a lot of fiddly string manipulation below, because we don't
-- want to depend on misc utility packages like Ada.Characters.Handling.
function Get_Line return String;
-- Read the next line from the file content read by Read_File. Strip
-- all leading and trailing blanks. Convert "(spec)" or "(body)" to
-- "%s"/"%b". Remove comments (Ada style; "--" to end of line).
function Read_File (Name : String) return String_Ptr;
-- Read the entire contents of the named file
subtype Header_Num is Unit_Name_Type'Base range 0 .. 2**16 - 1;
type Line_Number is new Nat;
No_Line_Number : constant Line_Number := 0;
Cur_Line_Number : Line_Number := 0;
-- Current line number in the Force_Elab_Order_File.
-- Incremented by Get_Line. Used in error messages.
function Hash (N : Unit_Name_Type) return Header_Num;
package Name_Map is new System.HTable.Simple_HTable
(Header_Num => Header_Num,
Element => Line_Number,
Element => Logical_Line_Number,
No_Element => No_Line_Number,
Key => Unit_Name_Type,
Hash => Hash,
......@@ -1839,175 +1821,33 @@ package body Binde is
return (N - Unit_Name_Type'First) mod (Header_Num'Last + 1);
end Hash;
---------------
-- Read_File --
---------------
function Read_File (Name : String) return String_Ptr is
-- All of the following calls should succeed, because we checked the
-- file in Switch.B, but we double check and raise Program_Error on
-- failure, just in case.
F : constant File_Descriptor := Open_Read (Name, Binary);
begin
if F = Invalid_FD then
raise Program_Error;
end if;
declare
Len : constant Natural := Natural (File_Length (F));
Result : constant String_Ptr := new String (1 .. Len);
Len_Read : constant Natural :=
Read (F, Result (1)'Address, Len);
Status : Boolean;
begin
if Len_Read /= Len then
raise Program_Error;
end if;
Close (F, Status);
if not Status then
raise Program_Error;
end if;
return Result;
end;
end Read_File;
Cur : Positive := 1;
S : String_Ptr := Read_File (Force_Elab_Order_File.all);
--------------
-- Get_Line --
--------------
function Get_Line return String is
First : Positive := Cur;
Last : Natural;
begin
Cur_Line_Number := Cur_Line_Number + 1;
-- Skip to end of line
while Cur <= S'Last
and then S (Cur) /= ASCII.LF
and then S (Cur) /= ASCII.CR
loop
Cur := Cur + 1;
end loop;
-- Strip leading blanks
while First <= S'Last and then S (First) = ' ' loop
First := First + 1;
end loop;
-- Strip trailing blanks and comment
Last := Cur - 1;
for J in First .. Last - 1 loop
if S (J .. J + 1) = "--" then
Last := J - 1;
exit;
end if;
end loop;
while Last >= First and then S (Last) = ' ' loop
Last := Last - 1;
end loop;
-- Convert "(spec)" or "(body)" to "%s"/"%b", strip trailing blanks
-- again.
declare
Body_String : constant String := "(body)";
BL : constant Positive := Body_String'Length;
Spec_String : constant String := "(spec)";
SL : constant Positive := Spec_String'Length;
Line : String renames S (First .. Last);
Is_Body : Boolean := False;
Is_Spec : Boolean := False;
begin
if Line'Length >= SL
and then Line (Last - SL + 1 .. Last) = Spec_String
then
Is_Spec := True;
Last := Last - SL;
elsif Line'Length >= BL
and then Line (Last - BL + 1 .. Last) = Body_String
then
Is_Body := True;
Last := Last - BL;
end if;
while Last >= First and then S (Last) = ' ' loop
Last := Last - 1;
end loop;
-- Skip past LF or CR/LF
if Cur <= S'Last and then S (Cur) = ASCII.CR then
Cur := Cur + 1;
end if;
if Cur <= S'Last and then S (Cur) = ASCII.LF then
Cur := Cur + 1;
end if;
if Is_Spec then
return Line (First .. Last) & "%s";
elsif Is_Body then
return Line (First .. Last) & "%b";
else
return Line;
end if;
end;
end Get_Line;
-- Local variables
Empty_Name : constant Unit_Name_Type := Name_Find ("");
Cur_Line_Number : Logical_Line_Number;
Error : Boolean := False;
Iter : Forced_Units_Iterator;
Prev_Unit : Unit_Id := No_Unit_Id;
Uname : Unit_Name_Type;
-- Start of processing for Force_Elab_Order
begin
-- Loop through the file content, and build a dependency link for each
-- pair of lines. Ignore lines that should be ignored.
Iter := Iterate_Forced_Units;
while Has_Next (Iter) loop
Next (Iter, Uname, Cur_Line_Number);
while Cur <= S'Last loop
declare
Uname : constant Unit_Name_Type := Name_Find (Get_Line);
Error : Boolean := False;
begin
if Uname = Empty_Name then
null; -- silently skip blank lines
else
declare
Dup : constant Line_Number := Name_Map.Get (Uname);
Dup : constant Logical_Line_Number := Name_Map.Get (Uname);
begin
if Dup = No_Line_Number then
Name_Map.Set (Uname, Cur_Line_Number);
-- We don't need to give the "not present" message in
-- the case of "duplicate unit", because we would have
-- already given the "not present" message on the
-- first occurrence.
-- We don't need to give the "not present" message in the case
-- of "duplicate unit", because we would have already given the
-- "not present" message on the first occurrence.
if Get_Name_Table_Int (Uname) = 0
or else Unit_Id (Get_Name_Table_Int (Uname)) =
No_Unit_Id
or else Unit_Id (Get_Name_Table_Int (Uname)) = No_Unit_Id
then
Error := True;
if Doing_New then
......@@ -2034,9 +1874,7 @@ package body Binde is
declare
Cur_Unit : constant Unit_Id := Unit_Id_Of (Uname);
begin
if Is_Internal_File_Name
(Units.Table (Cur_Unit).Sfile)
then
if Is_Internal_File_Name (Units.Table (Cur_Unit).Sfile) then
if Doing_New then
Write_Line
("""" & Get_Name_String (Uname)
......@@ -2062,11 +1900,7 @@ package body Binde is
end if;
end;
end if;
end if;
end;
end loop;
Free (S);
end Force_Elab_Order;
-------------------------
......
gcc/ada/bindo-graphs.adb
......@@ -2069,10 +2069,8 @@ package body Bindo.Graphs is
pragma Assert (Present (U_Id));
U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
begin
return U_Rec.Internal;
return Is_Internal_Unit (U_Id);
end Is_Internal_Unit;
------------------------
......@@ -2090,10 +2088,8 @@ package body Bindo.Graphs is
pragma Assert (Present (U_Id));
U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
begin
return U_Rec.Predefined;
return Is_Predefined_Unit (U_Id);
end Is_Predefined_Unit;
---------------------------
......
gcc/ada/bindo-graphs.ads
......@@ -573,7 +573,7 @@ package Bindo.Graphs is
Elaborate_All_Edge,
-- Successor withs Predecessor, and has pragma Elaborate_All for it
-- Forced_Edge,
Forced_Edge,
-- Successor is forced to with Predecessor by virtue of an existing
-- elaboration order provided in a file.
......
gcc/ada/bindo-units.adb
......@@ -233,6 +233,32 @@ package body Bindo.Units is
return U_Rec.Dynamic_Elab;
end Is_Dynamically_Elaborated;
----------------------
-- Is_Internal_Unit --
----------------------
function Is_Internal_Unit (U_Id : Unit_Id) return Boolean is
pragma Assert (Present (U_Id));
U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
begin
return U_Rec.Internal;
end Is_Internal_Unit;
------------------------
-- Is_Predefined_Unit --
------------------------
function Is_Predefined_Unit (U_Id : Unit_Id) return Boolean is
pragma Assert (Present (U_Id));
U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
begin
return U_Rec.Predefined;
end Is_Predefined_Unit;
---------------------------------
-- Is_Stand_Alone_Library_Unit --
---------------------------------
......
gcc/ada/bindo-units.ads
......@@ -78,6 +78,14 @@ package Bindo.Units is
-- Determine whether unit U_Id was compiled using the dynamic elaboration
-- model.
function Is_Internal_Unit (U_Id : Unit_Id) return Boolean;
pragma Inline (Is_Internal_Unit);
-- Determine whether unit U_Id is internal
function Is_Predefined_Unit (U_Id : Unit_Id) return Boolean;
pragma Inline (Is_Predefined_Unit);
-- Determine whether unit U_Id is predefined
function Name (U_Id : Unit_Id) return Unit_Name_Type;
pragma Inline (Name);
-- Obtain the name of unit U_Id
......
gcc/ada/butil.ads
......@@ -23,12 +23,13 @@
-- --
------------------------------------------------------------------------------
-- This package contains utility routines for the binder
with Namet; use Namet;
with Types; use Types;
package Butil is
-- This package contains utility routines for the binder
function Is_Predefined_Unit return Boolean;
-- Given a unit name stored in Name_Buffer with length in Name_Len,
-- returns True if this is the name of a predefined unit or a child of
......@@ -51,4 +52,52 @@ package Butil is
-- Output unit name with (body) or (spec) after as required. On return
-- Name_Len is set to the number of characters which were output.
---------------
-- Iterators --
---------------
-- The following type represents an iterator over all units that are
-- specified in the forced-elaboration-order file supplied by the binder
-- via switch -f.
type Forced_Units_Iterator is private;
function Has_Next (Iter : Forced_Units_Iterator) return Boolean;
pragma Inline (Has_Next);
-- Determine whether iterator Iter has more units to examine
function Iterate_Forced_Units return Forced_Units_Iterator;
pragma Inline (Iterate_Forced_Units);
-- Obtain an iterator over all units in the forced-elaboration-order file
procedure Next
(Iter : in out Forced_Units_Iterator;
Unit_Name : out Unit_Name_Type;
Unit_Line : out Logical_Line_Number);
pragma Inline (Next);
-- Return the current unit referenced by iterator Iter along with the
-- line number it appears on, and advance to the next available unit.
private
First_Line_Number : constant Logical_Line_Number := No_Line_Number + 1;
type Forced_Units_Iterator is record
Order : String_Ptr := null;
-- A reference to the contents of the forced-elaboration-order file,
-- read in as a string.
Order_Index : Positive := 1;
-- Index into the order string
Order_Line : Logical_Line_Number := First_Line_Number;
-- Logical line number within the order string
Unit_Line : Logical_Line_Number := No_Line_Number;
-- The logical line number of the current unit name within the order
-- string.
Unit_Name : Unit_Name_Type := No_Unit_Name;
-- The current unit name parsed from the order string
end record;
end Butil;
gcc/ada/namet.adb
......@@ -1515,6 +1515,15 @@ package body Namet is
return Nam /= No_Name;
end Present;
-------------
-- Present --
-------------
function Present (Nam : Unit_Name_Type) return Boolean is
begin
return Nam /= No_Unit_Name;
end Present;
------------------
-- Reinitialize --
------------------
......
gcc/ada/namet.ads
......@@ -658,6 +658,10 @@ package Namet is
No_Unit_Name : constant Unit_Name_Type := Unit_Name_Type (No_Name);
-- Constant used to indicate no file name present
function Present (Nam : Unit_Name_Type) return Boolean;
pragma Inline (Present);
-- Determine whether unit name Nam exists
Error_Unit_Name : constant Unit_Name_Type := Unit_Name_Type (Error_Name);
-- The special Unit_Name_Type value Error_Unit_Name is used to indicate
-- a unit name where some previous processing has found an error.
......
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