mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-17 05:10:28 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2017-01-13  Javier Miranda  <miranda@adacore.com>

	* einfo.ads (Component_Bit_Offset): Fix documentation.
	* sem_ch13.adb (Check_Record_Representation_Clause): Skip check
	on record holes for components with unknown compile-time offsets.

2017-01-13  Bob Duff  <duff@adacore.com>

	* ali.ads, ali.adb (Static_Elaboration_Model_Used): Remove unused flag.
	* g-locfil.ads: Minor comment fix.

2017-01-13  Bob Duff  <duff@adacore.com>

	* binde.adb (Elab_New): New elaboration order algorithm
	that is expected to cause fewer ABE issues. This is a work in
	progress. The new algorithm is currently disabled, and can be
	enable by the -dp switch, or by modifying the Do_Old and Do_New
	etc. flags and rebuilding. Experimental code is included to
	compare the results of the old and new algorithms.
	* binde.ads: Use GNAT.Dynamic_Tables instead of Table, so we
	can have multiple of these tables, so the old and new algorithms
	can coexist.
	* bindgen.ads (Gen_Output_File): Pass Elab_Order as an 'in'
	parameter of type array. This avoids the global variable, and
	allows bounds checking (which is normally defeated by the tables
	packages). It also ensures that the Elab_Order is read-only
	to Bindgen.
	* bindgen.adb: Pass Elab_Order as an 'in' parameter to all
	subprograms that need it, as above.
	* debug.adb: Document new -dp switch. Modify doc of old -do
	switch.
	* gnatbind.adb (Gnatbind): Make use of new interfaces to Binde
	and Bindgen.  Move writing of closure (-R and -Ra switches)
	to Binde; that's more convenient.

2017-01-13  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Analyze_Expression_Function): If the expression
	function is a completion, all entities referenced in the
	expression are frozen. As a consequence, a reference to an
	uncompleted private type from an enclosing scope is illegal.

From-SVN: r244419
This commit is contained in:
Arnaud Charlet 2017-01-13 11:54:43 +01:00
parent 448a1eb3eb
commit 354ae44943
13 changed files with 2058 additions and 828 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
gcc/ada/ChangeLog
View File

@ -1,3 +1,45 @@
2017-01-13 Javier Miranda <miranda@adacore.com>
* einfo.ads (Component_Bit_Offset): Fix documentation.
* sem_ch13.adb (Check_Record_Representation_Clause): Skip check
on record holes for components with unknown compile-time offsets.
2017-01-13 Bob Duff <duff@adacore.com>
* ali.ads, ali.adb (Static_Elaboration_Model_Used): Remove unused flag.
* g-locfil.ads: Minor comment fix.
2017-01-13 Bob Duff <duff@adacore.com>
* binde.adb (Elab_New): New elaboration order algorithm
that is expected to cause fewer ABE issues. This is a work in
progress. The new algorithm is currently disabled, and can be
enable by the -dp switch, or by modifying the Do_Old and Do_New
etc. flags and rebuilding. Experimental code is included to
compare the results of the old and new algorithms.
* binde.ads: Use GNAT.Dynamic_Tables instead of Table, so we
can have multiple of these tables, so the old and new algorithms
can coexist.
* bindgen.ads (Gen_Output_File): Pass Elab_Order as an 'in'
parameter of type array. This avoids the global variable, and
allows bounds checking (which is normally defeated by the tables
packages). It also ensures that the Elab_Order is read-only
to Bindgen.
* bindgen.adb: Pass Elab_Order as an 'in' parameter to all
subprograms that need it, as above.
* debug.adb: Document new -dp switch. Modify doc of old -do
switch.
* gnatbind.adb (Gnatbind): Make use of new interfaces to Binde
and Bindgen. Move writing of closure (-R and -Ra switches)
to Binde; that's more convenient.
2017-01-13 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Expression_Function): If the expression
function is a completion, all entities referenced in the
expression are frozen. As a consequence, a reference to an
uncompleted private type from an enclosing scope is illegal.
2017-01-13 Javier Miranda <miranda@adacore.com>
* sem_ch6.adb (Freeze_Expr_Types): New subprogram.

9
gcc/ada/ali.adb
View File

@ -116,7 +116,6 @@ package body ALI is
Partition_Elaboration_Policy_Specified := ' ';
Queuing_Policy_Specified := ' ';
SSO_Default_Specified := False;
Static_Elaboration_Model_Used := False;
Task_Dispatching_Policy_Specified := ' ';
Unreserve_All_Interrupts_Specified := False;
Frontend_Exceptions_Specified := False;
@ -1996,14 +1995,6 @@ package body ALI is
Skip_Eol;
-- Check if static elaboration model used
if not Units.Table (Units.Last).Dynamic_Elab
and then not Units.Table (Units.Last).Internal
then
Static_Elaboration_Model_Used := True;
end if;
C := Getc;
-- Scan out With lines for this unit

7
gcc/ada/ali.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- 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- --
@ -523,11 +523,6 @@ package ALI is
-- Set to True if at least one ALI file contains '-fstack-check' in its
-- argument list.
Static_Elaboration_Model_Used : Boolean := False;
-- Set to False by Initialize_ALI. Set to True if any ALI file for a
-- non-internal unit compiled with the static elaboration model is
-- encountered.
Task_Dispatching_Policy_Specified : Character := ' ';
-- Set to blank by Initialize_ALI. Set to the appropriate task dispatching
-- policy character if an ali file contains a P line setting the

2233
gcc/ada/binde.adb
View File

File diff suppressed because it is too large Load Diff

40
gcc/ada/binde.ads
View File

@ -23,30 +23,38 @@
-- --
------------------------------------------------------------------------------
-- This package contains the routines to determine elaboration order
-- This package contains the routine that determines library-level elaboration
-- order.
with ALI; use ALI;
with Table;
with Namet; use Namet;
with Types; use Types;
with GNAT.Dynamic_Tables;
package Binde is
-- The following table records the chosen elaboration order. It is used
-- by Gen_Elab_Calls to generate the sequence of elaboration calls. Note
-- that units are included in this table even if they have no elaboration
package Unit_Id_Tables is new GNAT.Dynamic_Tables
(Table_Component_Type => Unit_Id,
Table_Index_Type => Nat,
Table_Low_Bound => 1,
Table_Initial => 500,
Table_Increment => 200);
use Unit_Id_Tables;
subtype Unit_Id_Table is Unit_Id_Tables.Instance;
subtype Unit_Id_Array is Unit_Id_Tables.Table_Type;
procedure Find_Elab_Order
(Elab_Order : out Unit_Id_Table;
First_Main_Lib_File : File_Name_Type);
-- Determine elaboration order.
--
-- The Elab_Order table records the chosen elaboration order. It is used by
-- Gen_Elab_Calls to generate the sequence of elaboration calls. Note that
-- units are included in this table even if they have no elaboration
-- routine, since the table is also used to drive the generation of object
-- files in the binder output. Gen_Elab_Calls skips any units that have no
-- elaboration routine.
package Elab_Order is new Table.Table (
Table_Component_Type => Unit_Id,
Table_Index_Type => Nat,
Table_Low_Bound => 1,
Table_Initial => 500,
Table_Increment => 200,
Table_Name => "Elab_Order");
procedure Find_Elab_Order;
-- Determine elaboration order
end Binde;

273
gcc/ada/bindgen.adb
View File

@ -24,7 +24,6 @@
------------------------------------------------------------------------------
with ALI; use ALI;
with Binde; use Binde;
with Casing; use Casing;
with Fname; use Fname;
with Gnatvsn; use Gnatvsn;
@ -47,12 +46,13 @@ with GNAT.Heap_Sort_A; use GNAT.Heap_Sort_A;
with GNAT.HTable;
package body Bindgen is
use Binde.Unit_Id_Tables;
Statement_Buffer : String (1 .. 1000);
-- Buffer used for constructing output statements
Last : Natural := 0;
-- Last location in Statement_Buffer currently set
Stm_Last : Natural := 0;
-- Stm_Last location in Statement_Buffer currently set
With_GNARL : Boolean := False;
-- Flag which indicates whether the program uses the GNARL library
@ -113,13 +113,13 @@ package body Bindgen is
-- that the information is consistent across units. The entries
-- in this table are n/u/r/s for not set/user/runtime/system.
package IS_Pragma_Settings is new Table.Table (
Table_Component_Type => Character,
Table_Index_Type => Int,
Table_Low_Bound => 0,
Table_Initial => 100,
Table_Increment => 200,
Table_Name => "IS_Pragma_Settings");
package IS_Pragma_Settings is new Table.Table
(Table_Component_Type => Character,
Table_Index_Type => Int,
Table_Low_Bound => 0,
Table_Initial => 100,
Table_Increment => 200,
Table_Name => "IS_Pragma_Settings");
-- This table assembles the Priority_Specific_Dispatching pragma
-- information from all the units in the partition. Note that Bcheck has
@ -127,13 +127,13 @@ package body Bindgen is
-- The entries in this table are the upper case first character of the
-- policy name, e.g. 'F' for FIFO_Within_Priorities.
package PSD_Pragma_Settings is new Table.Table (
Table_Component_Type => Character,
Table_Index_Type => Int,
Table_Low_Bound => 0,
Table_Initial => 100,
Table_Increment => 200,
Table_Name => "PSD_Pragma_Settings");
package PSD_Pragma_Settings is new Table.Table
(Table_Component_Type => Character,
Table_Index_Type => Int,
Table_Low_Bound => 0,
Table_Initial => 100,
Table_Increment => 200,
Table_Name => "PSD_Pragma_Settings");
----------------------------
-- Bind_Environment Table --
@ -271,7 +271,7 @@ package body Bindgen is
-- Local Subprograms --
-----------------------
procedure Gen_Adainit;
procedure Gen_Adainit (Elab_Order : Unit_Id_Array);
-- Generates the Adainit procedure
procedure Gen_Adafinal;
@ -283,27 +283,29 @@ package body Bindgen is
procedure Gen_CodePeer_Wrapper;
-- For CodePeer, generate wrapper which calls user-defined main subprogram
procedure Gen_Elab_Calls;
procedure Gen_Elab_Calls (Elab_Order : Unit_Id_Array);
-- Generate sequence of elaboration calls
procedure Gen_Elab_Externals;
procedure Gen_Elab_Externals (Elab_Order : Unit_Id_Array);
-- Generate sequence of external declarations for elaboration
procedure Gen_Elab_Order;
procedure Gen_Elab_Order (Elab_Order : Unit_Id_Array);
-- Generate comments showing elaboration order chosen
procedure Gen_Finalize_Library;
procedure Gen_Finalize_Library (Elab_Order : Unit_Id_Array);
-- Generate a sequence of finalization calls to elaborated packages
procedure Gen_Main;
-- Generate procedure main
procedure Gen_Object_Files_Options;
procedure Gen_Object_Files_Options (Elab_Order : Unit_Id_Array);
-- Output comments containing a list of the full names of the object
-- files to be linked and the list of linker options supplied by
-- Linker_Options pragmas in the source.
procedure Gen_Output_File_Ada (Filename : String);
procedure Gen_Output_File_Ada
(Filename : String;
Elab_Order : Unit_Id_Array);
-- Generate Ada output file
procedure Gen_Restrictions;
@ -335,11 +337,11 @@ package body Bindgen is
-- the encoding method used for the main program source. If there is no
-- main program source (-z switch used), returns brackets ('b').
function Has_Finalizer return Boolean;
function Has_Finalizer (Elab_Order : Unit_Id_Array) return Boolean;
-- Determine whether the current unit has at least one library-level
-- finalizer.
function Lt_Linker_Option (Op1, Op2 : Natural) return Boolean;
function Lt_Linker_Option (Op1 : Natural; Op2 : Natural) return Boolean;
-- Compare linker options, when sorting, first according to
-- Is_Internal_File (internal files come later) and then by
-- elaboration order position (latest to earliest).
@ -347,21 +349,21 @@ package body Bindgen is
procedure Move_Linker_Option (From : Natural; To : Natural);
-- Move routine for sorting linker options
procedure Resolve_Binder_Options;
procedure Resolve_Binder_Options (Elab_Order : Unit_Id_Array);
-- Set the value of With_GNARL
procedure Set_Char (C : Character);
-- Set given character in Statement_Buffer at the Last + 1 position
-- and increment Last by one to reflect the stored character.
-- Set given character in Statement_Buffer at the Stm_Last + 1 position
-- and increment Stm_Last by one to reflect the stored character.
procedure Set_Int (N : Int);
-- Set given value in decimal in Statement_Buffer with no spaces starting
-- at the Last + 1 position, and updating Last past the value. A minus sign
-- is output for a negative value.
-- at the Stm_Last + 1 position, and updating Stm_Last past the value. A
-- minus sign is output for a negative value.
procedure Set_Boolean (B : Boolean);
-- Set given boolean value in Statement_Buffer at the Last + 1 position
-- and update Last past the value.
-- Set given boolean value in Statement_Buffer at the Stm_Last + 1 position
-- and update Stm_Last past the value.
procedure Set_IS_Pragma_Table;
-- Initializes contents of IS_Pragma_Settings table from ALI table
@ -369,7 +371,7 @@ package body Bindgen is
procedure Set_Main_Program_Name;
-- Given the main program name in Name_Buffer (length in Name_Len) generate
-- the name of the routine to be used in the call. The name is generated
-- starting at Last + 1, and Last is updated past it.
-- starting at Stm_Last + 1, and Stm_Last is updated past it.
procedure Set_Name_Buffer;
-- Set the value stored in positions 1 .. Name_Len of the Name_Buffer
@ -379,7 +381,7 @@ package body Bindgen is
procedure Set_String (S : String);
-- Sets characters of given string in Statement_Buffer, starting at the
-- Last + 1 position, and updating last past the string value.
-- Stm_Last + 1 position, and updating last past the string value.
procedure Set_String_Replace (S : String);
-- Replaces the last S'Length characters in the Statement_Buffer with the
@ -388,8 +390,8 @@ package body Bindgen is
procedure Set_Unit_Name;
-- Given a unit name in the Name_Buffer, copy it into Statement_Buffer,
-- starting at the Last + 1 position and update Last past the value.
-- Each dot (.) will be qualified into double underscores (__).
-- starting at the Stm_Last + 1 position and update Stm_Last past the
-- value. Each dot (.) will be qualified into double underscores (__).
procedure Set_Unit_Number (U : Unit_Id);
-- Sets unit number (first unit is 1, leading zeroes output to line up all
@ -397,11 +399,12 @@ package body Bindgen is
-- number of units.
procedure Write_Statement_Buffer;
-- Write out contents of statement buffer up to Last, and reset Last to 0
-- Write out contents of statement buffer up to Stm_Last, and reset
-- Stm_Last to 0.
procedure Write_Statement_Buffer (S : String);
-- First writes its argument (using Set_String (S)), then writes out the
-- contents of statement buffer up to Last, and reset Last to 0
-- contents of statement buffer up to Stm_Last, and reset Stm_Last to 0
procedure Write_Bind_Line (S : String);
-- Write S (an LF-terminated string) to the binder file (for use with
@ -472,7 +475,7 @@ package body Bindgen is
-- Gen_Adainit --
-----------------
procedure Gen_Adainit is
procedure Gen_Adainit (Elab_Order : Unit_Id_Array) is
Main_Priority : Int renames ALIs.Table (ALIs.First).Main_Priority;
Main_CPU : Int renames ALIs.Table (ALIs.First).Main_CPU;
@ -892,8 +895,8 @@ package body Bindgen is
Write_Statement_Buffer;
end if;
-- Initialize stack limit variable of the environment task if the
-- stack check method is stack limit and stack check is enabled.
-- Initialize stack limit variable of the environment task if the stack
-- check method is stack limit and stack check is enabled.
if Stack_Check_Limits_On_Target
and then (Stack_Check_Default_On_Target or Stack_Check_Switch_Set)
@ -934,7 +937,7 @@ package body Bindgen is
WBI ("");
end if;
Gen_Elab_Calls;
Gen_Elab_Calls (Elab_Order);
if not CodePeer_Mode then
@ -980,9 +983,6 @@ package body Bindgen is
-------------------------
procedure Gen_Bind_Env_String is
KN, VN : Name_Id := No_Name;
Amp : Character;
procedure Write_Name_With_Len (Nam : Name_Id);
-- Write Nam as a string literal, prefixed with one
-- character encoding Nam's length.
@ -1002,10 +1002,17 @@ package body Bindgen is
Write_String_Table_Entry (End_String);
end Write_Name_With_Len;
-- Local variables
Amp : Character;
KN : Name_Id := No_Name;
VN : Name_Id := No_Name;
-- Start of processing for Gen_Bind_Env_String
begin
Bind_Environment.Get_First (KN, VN);
if VN = No_Name then
return;
end if;
@ -1058,15 +1065,15 @@ package body Bindgen is
-- Gen_Elab_Calls --
--------------------
procedure Gen_Elab_Calls is
procedure Gen_Elab_Calls (Elab_Order : Unit_Id_Array) is
Check_Elab_Flag : Boolean;
begin
-- Loop through elaboration order entries
for E in Elab_Order.First .. Elab_Order.Last loop
for E in Elab_Order'Range loop
declare
Unum : constant Unit_Id := Elab_Order.Table (E);
Unum : constant Unit_Id := Elab_Order (E);
U : Unit_Record renames Units.Table (Unum);
Unum_Spec : Unit_Id;
@ -1241,15 +1248,15 @@ package body Bindgen is
-- Gen_Elab_Externals --
------------------------
procedure Gen_Elab_Externals is
procedure Gen_Elab_Externals (Elab_Order : Unit_Id_Array) is
begin
if CodePeer_Mode then
return;
end if;
for E in Elab_Order.First .. Elab_Order.Last loop
for E in Elab_Order'Range loop
declare
Unum : constant Unit_Id := Elab_Order.Table (E);
Unum : constant Unit_Id := Elab_Order (E);
U : Unit_Record renames Units.Table (Unum);
begin
@ -1289,13 +1296,13 @@ package body Bindgen is
-- Gen_Elab_Order --
--------------------
procedure Gen_Elab_Order is
procedure Gen_Elab_Order (Elab_Order : Unit_Id_Array) is
begin
WBI (" -- BEGIN ELABORATION ORDER");
for J in Elab_Order.First .. Elab_Order.Last loop
for J in Elab_Order'Range loop
Set_String (" -- ");
Get_Name_String (Units.Table (Elab_Order.Table (J)).Uname);
Get_Name_String (Units.Table (Elab_Order (J)).Uname);
Set_Name_Buffer;
Write_Statement_Buffer;
end loop;
@ -1308,12 +1315,7 @@ package body Bindgen is
-- Gen_Finalize_Library --
--------------------------
procedure Gen_Finalize_Library is
Count : Int := 1;
U : Unit_Record;
Uspec : Unit_Record;
Unum : Unit_Id;
procedure Gen_Finalize_Library (Elab_Order : Unit_Id_Array) is
procedure Gen_Header;
-- Generate the header of the finalization routine
@ -1327,6 +1329,13 @@ package body Bindgen is
WBI (" begin");
end Gen_Header;
-- Local variables
Count : Int := 1;
U : Unit_Record;
Uspec : Unit_Record;
Unum : Unit_Id;
-- Start of processing for Gen_Finalize_Library
begin
@ -1334,8 +1343,8 @@ package body Bindgen is
return;
end if;
for E in reverse Elab_Order.First .. Elab_Order.Last loop
Unum := Elab_Order.Table (E);
for E in reverse Elab_Order'Range loop
Unum := Elab_Order (E);
U := Units.Table (Unum);
-- Dealing with package bodies is a little complicated. In such
@ -1634,11 +1643,11 @@ package body Bindgen is
end if;
end if;
-- Generate a reference to Ada_Main_Program_Name. This symbol is
-- not referenced elsewhere in the generated program, but is needed
-- by the debugger (that's why it is generated in the first place).
-- The reference stops Ada_Main_Program_Name from being optimized
-- away by smart linkers, such as the AiX linker.
-- Generate a reference to Ada_Main_Program_Name. This symbol is not
-- referenced elsewhere in the generated program, but is needed by
-- the debugger (that's why it is generated in the first place). The
-- reference stops Ada_Main_Program_Name from being optimized away by
-- smart linkers, such as the AiX linker.
-- Because this variable is unused, we make this variable "aliased"
-- with a pragma Volatile in order to tell the compiler to preserve
@ -1664,9 +1673,9 @@ package body Bindgen is
WBI (" gnat_envp := envp;");
WBI ("");
-- If configurable run time and no command line args, then nothing
-- needs to be done since the gnat_argc/argv/envp variables are
-- suppressed in this case.
-- If configurable run time and no command line args, then nothing needs
-- to be done since the gnat_argc/argv/envp variables are suppressed in
-- this case.
elsif Configurable_Run_Time_On_Target then
null;
@ -1767,11 +1776,11 @@ package body Bindgen is
-- Gen_Object_Files_Options --
------------------------------
procedure Gen_Object_Files_Options is
procedure Gen_Object_Files_Options (Elab_Order : Unit_Id_Array) is
Lgnat : Natural;
-- This keeps track of the position in the sorted set of entries
-- in the Linker_Options table of where the first entry from an
-- internal file appears.
-- This keeps track of the position in the sorted set of entries in the
-- Linker_Options table of where the first entry from an internal file
-- appears.
Linker_Option_List_Started : Boolean := False;
-- Set to True when "LINKER OPTION LIST" is displayed
@ -1836,17 +1845,17 @@ package body Bindgen is
Set_List_File (Object_List_Filename.all);
end if;
for E in Elab_Order.First .. Elab_Order.Last loop
for E in Elab_Order'Range loop
-- If not spec that has an associated body, then generate a comment
-- giving the name of the corresponding object file.
if not Units.Table (Elab_Order.Table (E)).SAL_Interface
and then Units.Table (Elab_Order.Table (E)).Utype /= Is_Spec
if not Units.Table (Elab_Order (E)).SAL_Interface
and then Units.Table (Elab_Order (E)).Utype /= Is_Spec
then
Get_Name_String
(ALIs.Table
(Units.Table (Elab_Order.Table (E)).My_ALI).Ofile_Full_Name);
(Units.Table (Elab_Order (E)).My_ALI).Ofile_Full_Name);
-- If the presence of an object file is necessary or if it exists,
-- then use it.
@ -1874,6 +1883,7 @@ package body Bindgen is
for J in 1 .. Nb_Dir_In_Obj_Search_Path loop
declare
Dir : constant String_Ptr := Dir_In_Obj_Search_Path (J);
begin
Name_Len := 0;
Add_Str_To_Name_Buffer ("-L");
@ -1996,7 +2006,10 @@ package body Bindgen is
-- Gen_Output_File --
---------------------
procedure Gen_Output_File (Filename : String) is
procedure Gen_Output_File
(Filename : String;
Elab_Order : Unit_Id_Array)
is
begin
-- Acquire settings for Interrupt_State pragmas
@ -2014,8 +2027,8 @@ package body Bindgen is
-- Count number of elaboration calls
for E in Elab_Order.First .. Elab_Order.Last loop
if Units.Table (Elab_Order.Table (E)).No_Elab then
for E in Elab_Order'Range loop
if Units.Table (Elab_Order (E)).No_Elab then
null;
else
Num_Elab_Calls := Num_Elab_Calls + 1;
@ -2024,21 +2037,23 @@ package body Bindgen is
-- Generate output file in appropriate language
Gen_Output_File_Ada (Filename);
Gen_Output_File_Ada (Filename, Elab_Order);
end Gen_Output_File;
-------------------------
-- Gen_Output_File_Ada --
-------------------------
procedure Gen_Output_File_Ada (Filename : String) is
procedure Gen_Output_File_Ada
(Filename : String; Elab_Order : Unit_Id_Array)
is
Ada_Main : constant String := Get_Ada_Main_Name;
-- Name to be used for generated Ada main program. See the body of
-- function Get_Ada_Main_Name for details on the form of the name.
Needs_Library_Finalization : constant Boolean :=
not Configurable_Run_Time_On_Target and then Has_Finalizer;
not Configurable_Run_Time_On_Target
and then Has_Finalizer (Elab_Order);
-- For restricted run-time libraries (ZFP and Ravenscar) tasks are
-- non-terminating, so we do not want finalization.
@ -2096,7 +2111,7 @@ package body Bindgen is
WBI ("with System.Secondary_Stack;");
end if;
Resolve_Binder_Options;
Resolve_Binder_Options (Elab_Order);
-- Generate standard with's
@ -2240,7 +2255,7 @@ package body Bindgen is
end if;
Gen_Versions;
Gen_Elab_Order;
Gen_Elab_Order (Elab_Order);
-- Spec is complete
@ -2323,7 +2338,7 @@ package body Bindgen is
-- Generate externals for elaboration entities
Gen_Elab_Externals;
Gen_Elab_Externals (Elab_Order);
if not CodePeer_Mode then
if not Suppress_Standard_Library_On_Target then
@ -2375,13 +2390,13 @@ package body Bindgen is
if not Cumulative_Restrictions.Set (No_Finalization) then
if Needs_Library_Finalization then
Gen_Finalize_Library;
Gen_Finalize_Library (Elab_Order);
end if;
Gen_Adafinal;
end if;
Gen_Adainit;
Gen_Adainit (Elab_Order);
if Bind_Main_Program then
Gen_Main;
@ -2389,7 +2404,7 @@ package body Bindgen is
-- Output object file list and the Ada body is complete
Gen_Object_Files_Options;
Gen_Object_Files_Options (Elab_Order);
WBI ("");
WBI ("end " & Ada_Main & ";");
@ -2519,8 +2534,8 @@ package body Bindgen is
WBI (" type Version_32 is mod 2 ** 32;");
for U in Units.First .. Units.Last loop
if not Units.Table (U).SAL_Interface
and then
(not Bind_For_Library or else Units.Table (U).Directly_Scanned)
and then (not Bind_For_Library
or else Units.Table (U).Directly_Scanned)
then
Increment_Ubuf;
WBI (" " & Ubuf & " : constant Version_32 := 16#" &
@ -2580,19 +2595,20 @@ package body Bindgen is
function Get_Ada_Main_Name return String is
Suffix : constant String := "_00";
Name : String (1 .. Opt.Ada_Main_Name.all'Length + Suffix'Length) :=
Opt.Ada_Main_Name.all & Suffix;
Opt.Ada_Main_Name.all & Suffix;
Nlen : Natural;
begin
-- For CodePeer, we want reproducible names (independent of other
-- mains that may or may not be present) that don't collide
-- when analyzing multiple mains and which are easily recognizable
-- as "ada_main" names.
-- For CodePeer, we want reproducible names (independent of other mains
-- that may or may not be present) that don't collide when analyzing
-- multiple mains and which are easily recognizable as "ada_main" names.
if CodePeer_Mode then
Get_Name_String (Units.Table (First_Unit_Entry).Uname);
return "ada_main_for_" &
Get_Main_Unit_Name (Name_Buffer (1 .. Name_Len - 2));
return
"ada_main_for_" &
Get_Main_Unit_Name (Name_Buffer (1 .. Name_Len - 2));
end if;
-- This loop tries the following possibilities in order
@ -2713,13 +2729,13 @@ package body Bindgen is
-- Has_Finalizer --
-------------------
function Has_Finalizer return Boolean is
function Has_Finalizer (Elab_Order : Unit_Id_Array) return Boolean is
U : Unit_Record;
Unum : Unit_Id;
begin
for E in reverse Elab_Order.First .. Elab_Order.Last loop
Unum := Elab_Order.Table (E);
for E in reverse Elab_Order'Range loop
Unum := Elab_Order (E);
U := Units.Table (Unum);
-- We are only interested in non-generic packages
@ -2749,7 +2765,7 @@ package body Bindgen is
-- Lt_Linker_Option --
----------------------
function Lt_Linker_Option (Op1, Op2 : Natural) return Boolean is
function Lt_Linker_Option (Op1 : Natural; Op2 : Natural) return Boolean is
begin
-- Sort internal files last
@ -2771,7 +2787,6 @@ package body Bindgen is
return Units.Table (Linker_Options.Table (Op1).Unit).Elab_Position
>
Units.Table (Linker_Options.Table (Op2).Unit).Elab_Position;
end if;
end Lt_Linker_Option;
@ -2788,8 +2803,7 @@ package body Bindgen is
-- Resolve_Binder_Options --
----------------------------
procedure Resolve_Binder_Options is
procedure Resolve_Binder_Options (Elab_Order : Unit_Id_Array) is
procedure Check_Package (Var : in out Boolean; Name : String);
-- Set Var to true iff the current identifier in Namet is Name. Do
-- nothing if it doesn't match. This procedure is just a helper to
@ -2811,8 +2825,8 @@ package body Bindgen is
-- Start of processing for Resolve_Binder_Options
begin
for E in Elab_Order.First .. Elab_Order.Last loop
Get_Name_String (Units.Table (Elab_Order.Table (E)).Uname);
for E in Elab_Order'Range loop
Get_Name_String (Units.Table (Elab_Order (E)).Uname);
-- This is not a perfect approach, but is the current protocol
-- between the run-time and the binder to indicate that tasking is
@ -2873,15 +2887,18 @@ package body Bindgen is
-----------------
procedure Set_Boolean (B : Boolean) is
True_Str : constant String := "True";
False_Str : constant String := "False";
True_Str : constant String := "True";
begin
if B then
Statement_Buffer (Last + 1 .. Last + True_Str'Length) := True_Str;
Last := Last + True_Str'Length;
Statement_Buffer (Stm_Last + 1 .. Stm_Last + True_Str'Length) :=
True_Str;
Stm_Last := Stm_Last + True_Str'Length;
else
Statement_Buffer (Last + 1 .. Last + False_Str'Length) := False_Str;
Last := Last + False_Str'Length;
Statement_Buffer (Stm_Last + 1 .. Stm_Last + False_Str'Length) :=
False_Str;
Stm_Last := Stm_Last + False_Str'Length;
end if;
end Set_Boolean;
@ -2891,8 +2908,8 @@ package body Bindgen is
procedure Set_Char (C : Character) is
begin
Last := Last + 1;
Statement_Buffer (Last) := C;
Stm_Last := Stm_Last + 1;
Statement_Buffer (Stm_Last) := C;
end Set_Char;
-------------
@ -2910,8 +2927,8 @@ package body Bindgen is
Set_Int (N / 10);
end if;
Last := Last + 1;
Statement_Buffer (Last) :=
Stm_Last := Stm_Last + 1;
Statement_Buffer (Stm_Last) :=
Character'Val (N mod 10 + Character'Pos ('0'));
end if;
end Set_Int;
@ -2928,9 +2945,9 @@ package body Bindgen is
loop
declare
Inum : constant Int :=
Interrupt_States.Table (K).Interrupt_Id;
Interrupt_States.Table (K).Interrupt_Id;
Stat : constant Character :=
Interrupt_States.Table (K).Interrupt_State;
Interrupt_States.Table (K).Interrupt_State;
begin
while IS_Pragma_Settings.Last < Inum loop
@ -2951,8 +2968,8 @@ package body Bindgen is
begin
-- Note that name has %b on the end which we ignore
-- First we output the initial _ada_ since we know that the main
-- program is a library level subprogram.
-- First we output the initial _ada_ since we know that the main program
-- is a library level subprogram.
Set_String ("_ada_");
@ -3011,8 +3028,8 @@ package body Bindgen is
procedure Set_String (S : String) is
begin
Statement_Buffer (Last + 1 .. Last + S'Length) := S;
Last := Last + S'Length;
Statement_Buffer (Stm_Last + 1 .. Stm_Last + S'Length) := S;
Stm_Last := Stm_Last + S'Length;
end Set_String;
------------------------
@ -3021,7 +3038,7 @@ package body Bindgen is
procedure Set_String_Replace (S : String) is
begin
Statement_Buffer (Last - S'Length + 1 .. Last) := S;
Statement_Buffer (Stm_Last - S'Length + 1 .. Stm_Last) := S;
end Set_String_Replace;
-------------------
@ -3076,8 +3093,8 @@ package body Bindgen is
procedure Write_Statement_Buffer is
begin
WBI (Statement_Buffer (1 .. Last));
Last := 0;
WBI (Statement_Buffer (1 .. Stm_Last));
Stm_Last := 0;
end Write_Statement_Buffer;
procedure Write_Statement_Buffer (S : String) is

8
gcc/ada/bindgen.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- 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- --
@ -32,9 +32,13 @@
-- See the body for exact details of the file that is generated
with Binde; use Binde;
package Bindgen is
procedure Gen_Output_File (Filename : String);
procedure Gen_Output_File
(Filename : String;
Elab_Order : Unit_Id_Array);
-- Filename is the full path name of the binder output file
procedure Set_Bind_Env (Key, Value : String);

19
gcc/ada/debug.adb
View File

@ -181,14 +181,14 @@ package body Debug is
-- dl
-- dm
-- dn List details of manipulation of Num_Pred values
-- do Use old preference for elaboration order
-- dp
-- do Use older preference for elaboration order
-- dp Use new preference for elaboration order
-- dq
-- dr
-- ds
-- dt
-- du List units as they are acquired
-- dv
-- dv Verbose debugging printouts
-- dw
-- dx Force binder to read xref information from ali files
-- dy
@ -809,14 +809,25 @@ package body Debug is
-- the algorithm used to determine a correct order of elaboration. This
-- is useful in diagnosing any problems in its behavior.
-- do Use old elaboration order preference. The new preference rules
-- do Use older elaboration order preference. The new preference rules
-- prefer specs with no bodies to specs with bodies, and between two
-- specs with bodies, prefers the one whose body is closer to being
-- able to be elaborated. This is a clear improvement, but we provide
-- this debug flag in case of regressions.
-- dp Use new elaboration order preference. The new preference rules
-- elaborate all units within a strongly connected component together,
-- with no other units in between. In particular, if a spec/body pair
-- can be elaborated together, it will be. In the new order, the binder
-- behaves as if every pragma Elaborate_All that would be legal is
-- present, even if it does not appear in the source code. NOTE: We
-- intend to reverse the sense of this switch at some point, so the new
-- preference is the default.
-- du List unit name and file name for each unit as it is read in
-- dv Verbose debugging printouts
-- dx Force the binder to read (and then ignore) the xref information
-- in ali files (used to check that read circuit is working OK).

15
gcc/ada/einfo.ads
View File

@ -670,14 +670,13 @@ package Einfo is
-- stored in a non-standard way, see body for details.
-- Component_Bit_Offset (Uint11)
-- Defined in record components (E_Component, E_Discriminant) if a
-- component clause applies to the component. First bit position of
-- given component, computed from the first bit and position values
-- given in the component clause. A value of No_Uint means that the
-- value is not yet known. The value can be set by the appearance of
-- an explicit component clause in a record representation clause,
-- or it can be set by the front-end in package Layout, or it can be
-- set by the backend. By the time backend processing is completed,
-- Defined in record components (E_Component, E_Discriminant). First
-- bit position of given component, computed from the first bit and
-- position values given in the component clause. A value of No_Uint
-- means that the value is not yet known. The value can be set by the
-- appearance of an explicit component clause in a record representation
-- clause, or it can be set by the front-end in package Layout, or it can
-- be set by the backend. By the time backend processing is completed,
-- this field is always set. A negative value is used to represent
-- a value which is not known at compile time, and must be computed
-- at run-time (this happens if fields of a record have variable

4
gcc/ada/g-locfil.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1995-2010, 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- --
@ -39,7 +39,7 @@ package GNAT.Lock_Files is
-- Exception raised if file cannot be locked
subtype Path_Name is String;
-- Pathname is used by all services provided in this unit to specified
-- Pathname is used by all services provided in this unit to specify
-- directory name and file name. On DOS based systems both directory
-- separators are handled (i.e. slash and backslash).

186
gcc/ada/gnatbind.adb
View File

@ -30,12 +30,10 @@ with Binde; use Binde;
with Binderr; use Binderr;
with Bindgen; use Bindgen;
with Bindusg;
with Butil; use Butil;
with Casing; use Casing;
with Csets;
with Debug; use Debug;
with Fmap;
with Fname; use Fname;
with Namet; use Namet;
with Opt; use Opt;
with Osint; use Osint;
@ -45,7 +43,6 @@ with Rident; use Rident;
with Snames;
with Switch; use Switch;
with Switch.B; use Switch.B;
with Table;
with Targparm; use Targparm;
with Types; use Types;
@ -76,22 +73,15 @@ procedure Gnatbind is
Mapping_File : String_Ptr := null;
package Closure_Sources is new Table.Table
(Table_Component_Type => File_Name_Type,
Table_Index_Type => Natural,
Table_Low_Bound => 1,
Table_Initial => 10,
Table_Increment => 100,
Table_Name => "Gnatbind.Closure_Sources");
-- Table to record the sources in the closure, to avoid duplications. Used
-- only with switch -R.
procedure Add_Artificial_ALI_File (Name : String);
-- Artificially add ALI file Name in the closure
function Gnatbind_Supports_Auto_Init return Boolean;
-- Indicates if automatic initialization of elaboration procedure
-- through the constructor mechanism is possible on the platform.
-- Indicates if automatic initialization of elaboration procedure through
-- the constructor mechanism is possible on the platform.
function Is_Cross_Compiler return Boolean;
-- Returns True iff this is a cross-compiler
procedure List_Applicable_Restrictions;
-- List restrictions that apply to this partition if option taken
@ -110,9 +100,6 @@ procedure Gnatbind is
procedure Write_Arg (S : String);
-- Passed to Generic_Scan_Bind_Args to print args
function Is_Cross_Compiler return Boolean;
-- Returns True iff this is a cross-compiler
-----------------------------
-- Add_Artificial_ALI_File --
-----------------------------
@ -149,6 +136,7 @@ procedure Gnatbind is
function gnat_binder_supports_auto_init return Integer;
pragma Import (C, gnat_binder_supports_auto_init,
"__gnat_binder_supports_auto_init");
begin
return gnat_binder_supports_auto_init /= 0;
end Gnatbind_Supports_Auto_Init;
@ -160,6 +148,7 @@ procedure Gnatbind is
function Is_Cross_Compiler return Boolean is
Cross_Compiler : Integer;
pragma Import (C, Cross_Compiler, "__gnat_is_cross_compiler");
begin
return Cross_Compiler = 1;
end Is_Cross_Compiler;
@ -287,13 +276,13 @@ procedure Gnatbind is
for R in All_Restrictions loop
if not No_Restriction_List (R)
and then Restriction_Could_Be_Set (R)
and then Restriction_Could_Be_Set (R)
then
if not Additional_Restrictions_Listed then
Write_Eol;
Write_Line
("The following additional restrictions may be" &
" applied to this partition:");
("The following additional restrictions may be applied to "
& "this partition:");
Additional_Restrictions_Listed := True;
end if;
@ -301,6 +290,7 @@ procedure Gnatbind is
declare
S : constant String := Restriction_Id'Image (R);
begin
Name_Len := S'Length;
Name_Buffer (1 .. Name_Len) := S;
@ -377,8 +367,8 @@ procedure Gnatbind is
else
Fail
("Prefix of initialization and finalization " &
"procedure names missing in -L");
("Prefix of initialization and finalization procedure names "
& "missing in -L");
end if;
-- -Sin -Slo -Shi -Sxx -Sev
@ -560,12 +550,12 @@ procedure Gnatbind is
Write_Str (" " & S);
end Write_Arg;
procedure Scan_Bind_Args is new Generic_Scan_Bind_Args (Scan_Bind_Arg);
procedure Put_Bind_Args is new Generic_Scan_Bind_Args (Write_Arg);
procedure Check_Version_And_Help is
new Check_Version_And_Help_G (Bindusg.Display);
procedure Put_Bind_Args is new Generic_Scan_Bind_Args (Write_Arg);
procedure Scan_Bind_Args is new Generic_Scan_Bind_Args (Scan_Bind_Arg);
-- Start of processing for Gnatbind
begin
@ -582,8 +572,8 @@ begin
begin
pragma Assert
(Shared_Libgnat_Default = SHARED
or else
Shared_Libgnat_Default = STATIC);
or else
Shared_Libgnat_Default = STATIC);
Shared_Libgnat := (Shared_Libgnat_Default = SHARED);
end;
@ -618,8 +608,8 @@ begin
Fail ("switch -a must be used in conjunction with -n or -Lxxx");
elsif not Gnatbind_Supports_Auto_Init then
Fail ("automatic initialisation of elaboration " &
"not supported on this platform");
Fail ("automatic initialisation of elaboration not supported on this "
& "platform");
end if;
end if;
@ -641,6 +631,7 @@ begin
Check_Extensions : declare
Length : constant Natural := Output_File_Name'Length;
Last : constant Natural := Output_File_Name'Last;
begin
if Length <= 4
or else Output_File_Name (Last - 3 .. Last) /= ".adb"
@ -873,132 +864,19 @@ begin
-- Complete bind if no errors
if Errors_Detected = 0 then
Find_Elab_Order;
declare
Elab_Order : Unit_Id_Table;
use Unit_Id_Tables;
if Errors_Detected = 0 then
-- Display elaboration order if -l was specified
begin
Find_Elab_Order (Elab_Order, First_Main_Lib_File);
if Elab_Order_Output then
if not Zero_Formatting then
Write_Eol;
Write_Str ("ELABORATION ORDER");
Write_Eol;
end if;
for J in Elab_Order.First .. Elab_Order.Last loop
if not Units.Table (Elab_Order.Table (J)).SAL_Interface then
if not Zero_Formatting then
Write_Str (" ");
end if;
Write_Unit_Name
(Units.Table (Elab_Order.Table (J)).Uname);
Write_Eol;
end if;
end loop;
if not Zero_Formatting then
Write_Eol;
end if;
if Errors_Detected = 0 and then not Check_Only then
Gen_Output_File
(Output_File_Name.all,
Elab_Order => Elab_Order.Table (First .. Last (Elab_Order)));
end if;
if not Check_Only then
Gen_Output_File (Output_File_Name.all);
end if;
-- Display list of sources in the closure (except predefined
-- sources) if -R was used.
if List_Closure then
List_Closure_Display : declare
Source : File_Name_Type;
function Put_In_Sources (S : File_Name_Type) return Boolean;
-- Check if S is already in table Sources and put in Sources
-- if it is not. Return False if the source is already in
-- Sources, and True if it is added.
--------------------
-- Put_In_Sources --
--------------------
function Put_In_Sources
(S : File_Name_Type) return Boolean
is
begin
for J in 1 .. Closure_Sources.Last loop
if Closure_Sources.Table (J) = S then
return False;
end if;
end loop;
Closure_Sources.Append (S);
return True;
end Put_In_Sources;
-- Start of processing for List_Closure_Display
begin
Closure_Sources.Init;
if not Zero_Formatting then
Write_Eol;
Write_Str ("REFERENCED SOURCES");
Write_Eol;
end if;
for J in reverse Elab_Order.First .. Elab_Order.Last loop
Source := Units.Table (Elab_Order.Table (J)).Sfile;
-- Do not include same source more than once
if Put_In_Sources (Source)
-- Do not include run-time units unless -Ra switch set
and then (List_Closure_All
or else not Is_Internal_File_Name (Source))
then
if not Zero_Formatting then
Write_Str (" ");
end if;
Write_Str (Get_Name_String (Source));
Write_Eol;
end if;
end loop;
-- Subunits do not appear in the elaboration table because
-- they are subsumed by their parent units, but we need to
-- list them for other tools. For now they are listed after
-- other files, rather than right after their parent, since
-- there is no easy link between the elaboration table and
-- the ALIs table ??? As subunits may appear repeatedly in
-- the list, if the parent unit appears in the context of
-- several units in the closure, duplicates are suppressed.
for J in Sdep.First .. Sdep.Last loop
Source := Sdep.Table (J).Sfile;
if Sdep.Table (J).Subunit_Name /= No_Name
and then Put_In_Sources (Source)
and then not Is_Internal_File_Name (Source)
then
if not Zero_Formatting then
Write_Str (" ");
end if;
Write_Str (Get_Name_String (Source));
Write_Eol;
end if;
end loop;
if not Zero_Formatting then
Write_Eol;
end if;
end List_Closure_Display;
end if;
end if;
end;
end if;
Total_Errors := Total_Errors + Errors_Detected;
@ -1010,7 +888,7 @@ begin
Total_Warnings := Total_Warnings + Warnings_Detected;
end;
-- All done. Set proper exit status
-- All done. Set the proper exit status.
Finalize_Binderr;
Namet.Finalize;

25
gcc/ada/sem_ch13.adb
View File

@ -10374,15 +10374,26 @@ package body Sem_Ch13 is
Nbit := Sbit;
for J in 1 .. Ncomps loop
CEnt := Comps (J);
Error_Msg_Uint_1 := Component_Bit_Offset (CEnt) - Nbit;
if Error_Msg_Uint_1 > 0 then
Error_Msg_NE
("?H?^-bit gap before component&",
Component_Name (Component_Clause (CEnt)), CEnt);
end if;
declare
CBO : constant Uint := Component_Bit_Offset (CEnt);
Nbit := Component_Bit_Offset (CEnt) + Esize (CEnt);
begin
-- Skip components with unknown offsets
if CBO /= No_Uint and then CBO >= 0 then
Error_Msg_Uint_1 := CBO - Nbit;
if Error_Msg_Uint_1 > 0 then
Error_Msg_NE
("?H?^-bit gap before component&",
Component_Name (Component_Clause (CEnt)),
CEnt);
end if;
Nbit := CBO + Esize (CEnt);
end if;
end;
end loop;
-- Process variant parts recursively if present

25
gcc/ada/sem_ch6.adb
View File

@ -274,6 +274,7 @@ package body Sem_Ch6 is
New_Spec : Node_Id;
Orig_N : Node_Id;
Ret : Node_Id;
Ret_Type : Entity_Id;
Prev : Entity_Id;
-- If the expression is a completion, Prev is the entity whose
@ -366,16 +367,34 @@ package body Sem_Ch6 is
then
Set_Has_Completion (Prev, False);
Set_Is_Inlined (Prev);
Ret_Type := Etype (Prev);
-- An expression function that is a completion freezes the
-- expression. This means freezing the return type, and if it is
-- an access type, freezing its designated type as well.
-- expression. This means freezing the return type, and if it is an
-- access type, freezing its designated type as well.
-- Note that we cannot defer this freezing to the analysis of the
-- expression itself, because a freeze node might appear in a nested
-- scope, leading to an elaboration order issue in gigi.
Freeze_Before (N, Etype (Prev));
-- An entity can only be frozen if it has a completion, so we must
-- check this explicitly. If it is declared elsewhere it will have
-- been frozen already, so only types declared in currently opend
-- scopes need to be tested.
if Ekind (Ret_Type) = E_Private_Type
and then In_Open_Scopes (Scope (Ret_Type))
and then not Is_Generic_Type (Ret_Type)
and then not Is_Frozen (Ret_Type)
and then No (Full_View (Ret_Type))
then
Error_Msg_NE
("premature use of private type&",
Result_Definition (Specification (N)), Ret_Type);
else
Freeze_Before (N, Ret_Type);
end if;
if Is_Access_Type (Etype (Prev)) then
Freeze_Before (N, Designated_Type (Etype (Prev)));