OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

ali.adb: Set Allocator_In_Body if AB parameter present on M line 

2010-10-08  Robert Dewar  <dewar@adacore.com>

	* ali.adb: Set Allocator_In_Body if AB parameter present on M line
	* ali.ads (Allocator_In_Body): New flag
	* bcheck.adb (Check_Consistent_Restrictions): Handle case of main
	program violating No_Allocators_After_Elaboration restriction.
	* gnatbind.adb (No_Restriction_List): Add entries for
	No_Anonymous_Allocators, and No_Allocators_After_Elaboration.
	* lib-load.adb: Initialize Has_Allocator flag
	* lib-writ.adb: Initialize Has_Allocator flag
	(M_Parameters): Set AB switch if Has_Allocator flag set
	* lib-writ.ads: Document AB flag on M line
	* lib.adb (Has_Allocator): New function
	(Set_Has_Allocator): New procedure
	* lib.ads (Has_Allocator): New function
	(Set_Has_Allocator): New procedure
	(Has_Allocator): New flag in Unit_Record
	* sem_ch4.adb (Analyze_Allocator): Add processing for
	No_Allocators_After_Elaboration.

From-SVN: r165171
This commit is contained in:
Robert Dewar 2010-10-08 12:54:03 +00:00 committed by Arnaud Charlet
parent 0b89eea892
commit 87003b2853
11 changed files with 153 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
gcc/ada/ChangeLog
View File

@ -1,3 +1,23 @@
2010-10-08 Robert Dewar <dewar@adacore.com>
* ali.adb: Set Allocator_In_Body if AB parameter present on M line
* ali.ads (Allocator_In_Body): New flag
* bcheck.adb (Check_Consistent_Restrictions): Handle case of main
program violating No_Allocators_After_Elaboration restriction.
* gnatbind.adb (No_Restriction_List): Add entries for
No_Anonymous_Allocators, and No_Allocators_After_Elaboration.
* lib-load.adb: Initialize Has_Allocator flag
* lib-writ.adb: Initialize Has_Allocator flag
(M_Parameters): Set AB switch if Has_Allocator flag set
* lib-writ.ads: Document AB flag on M line
* lib.adb (Has_Allocator): New function
(Set_Has_Allocator): New procedure
* lib.ads (Has_Allocator): New function
(Set_Has_Allocator): New procedure
(Has_Allocator): New flag in Unit_Record
* sem_ch4.adb (Analyze_Allocator): Add processing for
No_Allocators_After_Elaboration.
2010-10-08 Geert Bosch <bosch@adacore.com>
* a-textio.adb (Get_Line): Rewrite to use fgets instead of fgetc.

9
gcc/ada/ali.adb
View File

@ -828,6 +828,7 @@ package body ALI is
Sfile => No_File,
Task_Dispatching_Policy => ' ',
Time_Slice_Value => -1,
Allocator_In_Body => False,
WC_Encoding => 'b',
Unit_Exception_Table => False,
Ver => (others => ' '),
@ -910,6 +911,14 @@ package body ALI is
Skip_Space;
if Nextc = 'A' then
P := P + 1;
Checkc ('B');
ALIs.Table (Id).Allocator_In_Body := True;
end if;
Skip_Space;
Checkc ('W');
Checkc ('=');
ALIs.Table (Id).WC_Encoding := Getc;

6
gcc/ada/ali.ads
View File

@ -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- --
@ -136,6 +136,10 @@ package ALI is
-- line. A value of -1 indicates that no T=xxx parameter was found, or
-- no M line was present. Not set if 'M' appears in Ignore_Lines.
Allocator_In_Body : Boolean;
-- Set True if an AB switch appears on the main program line. False
-- if no M line, or AB not present, or 'M appears in Ignore_Lines.
WC_Encoding : Character;
-- Wide character encoding if main procedure. Otherwise not relevant.
-- Not set if 'M' appears in Ignore_Lines.

18
gcc/ada/bcheck.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- 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- --
@ -854,6 +854,22 @@ package body Bcheck is
-- Start of processing for Check_Consistent_Restrictions
begin
-- A special test, if we have a main program, then if it has an
-- allocator in the body, this is considered to be a violation of
-- the restriction No_Allocators_After_Elaboration. We just mark
-- this restriction and then the normal circuit will flag it.
if Bind_Main_Program
and then ALIs.Table (ALIs.First).Main_Program /= None
and then not No_Main_Subprogram
and then ALIs.Table (ALIs.First).Allocator_In_Body
then
Cumulative_Restrictions.Violated
(No_Allocators_After_Elaboration) := True;
ALIs.Table (ALIs.First).Restrictions.Violated
(No_Allocators_After_Elaboration) := True;
end if;
-- Loop through all restriction violations
for R in All_Restrictions loop

26
gcc/ada/gnatbind.adb
View File

@ -143,34 +143,40 @@ procedure Gnatbind is
-- should not be listed.
No_Restriction_List : constant array (All_Restrictions) of Boolean :=
(No_Exception_Propagation => True,
(No_Allocators_After_Elaboration => True,
-- This involves run-time conditions not checkable at compile time
No_Anonymous_Allocators => True,
-- Premature, since we have not implemented this yet
No_Exception_Propagation => True,
-- Modifies code resulting in different exception semantics
No_Exceptions => True,
No_Exceptions => True,
-- Has unexpected Suppress (All_Checks) effect
No_Implicit_Conditionals => True,
No_Implicit_Conditionals => True,
-- This could modify and pessimize generated code
No_Implicit_Dynamic_Code => True,
No_Implicit_Dynamic_Code => True,
-- This could modify and pessimize generated code
No_Implicit_Loops => True,
No_Implicit_Loops => True,
-- This could modify and pessimize generated code
No_Recursion => True,
No_Recursion => True,
-- Not checkable at compile time
No_Reentrancy => True,
No_Reentrancy => True,
-- Not checkable at compile time
Max_Entry_Queue_Length => True,
Max_Entry_Queue_Length => True,
-- Not checkable at compile time
Max_Storage_At_Blocking => True,
Max_Storage_At_Blocking => True,
-- Not checkable at compile time
others => False);
others => False);
Additional_Restrictions_Listed : Boolean := False;
-- Set True if we have listed header for restrictions

3
gcc/ada/lib-load.adb
View File

@ -214,6 +214,7 @@ package body Lib.Load is
Expected_Unit => Spec_Name,
Fatal_Error => True,
Generate_Code => False,
Has_Allocator => False,
Has_RACW => False,
Is_Compiler_Unit => False,
Ident_String => Empty,
@ -318,6 +319,7 @@ package body Lib.Load is
Expected_Unit => No_Unit_Name,
Fatal_Error => False,
Generate_Code => False,
Has_Allocator => False,
Has_RACW => False,
Is_Compiler_Unit => False,
Ident_String => Empty,
@ -647,6 +649,7 @@ package body Lib.Load is
Expected_Unit => Uname_Actual,
Fatal_Error => False,
Generate_Code => False,
Has_Allocator => False,
Has_RACW => False,
Is_Compiler_Unit => False,
Ident_String => Empty,

6
gcc/ada/lib-writ.adb
View File

@ -80,6 +80,7 @@ package body Lib.Writ is
Dynamic_Elab => False,
Fatal_Error => False,
Generate_Code => False,
Has_Allocator => False,
Has_RACW => False,
Is_Compiler_Unit => False,
Ident_String => Empty,
@ -135,6 +136,7 @@ package body Lib.Writ is
Dynamic_Elab => False,
Fatal_Error => False,
Generate_Code => False,
Has_Allocator => False,
Has_RACW => False,
Is_Compiler_Unit => False,
Ident_String => Empty,
@ -925,6 +927,10 @@ package body Lib.Writ is
Write_Info_Nat (Opt.Time_Slice_Value);
end if;
if Has_Allocator (Main_Unit) then
Write_Info_Str (" AB");
end if;
Write_Info_Str (" W=");
Write_Info_Char
(WC_Encoding_Letters (Wide_Character_Encoding_Method));

11
gcc/ada/lib-writ.ads
View File

@ -116,7 +116,7 @@ package Lib.Writ is
-- -- M Main Program --
-- ---------------------
-- M type [priority] [T=time-slice] W=?
-- M type [priority] [T=time-slice] [AB] W=?
-- This line appears only if the main unit for this file is suitable
-- for use as a main program. The parameters are:
@ -141,6 +141,15 @@ package Lib.Writ is
-- milliseconds. The actual significance of this parameter is
-- target dependent.
-- AB
-- Present if there is an allocator in the body of the procedure
-- after the BEGIN. This will be a violation of the restriction
-- No_Allocators_After_Elaboration if it is present, and this
-- unit is used as a main program (only the binder can find the
-- violation, since only the binder knows the main program).
--
-- W=?
-- This parameter indicates the wide character encoding method used

10
gcc/ada/lib.adb
View File

@ -113,6 +113,11 @@ package body Lib is
return Units.Table (U).Generate_Code;
end Generate_Code;
function Has_Allocator (U : Unit_Number_Type) return Boolean is
begin
return Units.Table (U).Has_Allocator;
end Has_Allocator;
function Has_RACW (U : Unit_Number_Type) return Boolean is
begin
return Units.Table (U).Has_RACW;
@ -198,6 +203,11 @@ package body Lib is
Units.Table (U).Generate_Code := B;
end Set_Generate_Code;
procedure Set_Has_Allocator (U : Unit_Number_Type; B : Boolean := True) is
begin
Units.Table (U).Has_Allocator := B;
end Set_Has_Allocator;
procedure Set_Has_RACW (U : Unit_Number_Type; B : Boolean := True) is
begin
Units.Table (U).Has_RACW := B;

12
gcc/ada/lib.ads
View File

@ -357,6 +357,10 @@ package Lib is
-- that the default priority is to be used (and is also used for
-- entries that do not correspond to possible main programs).
-- Has_Allocator
-- This flag is set if a subprogram unit has an allocator after the
-- BEGIN (it is used to set the AB flag in the M ALI line).
-- OA_Setting
-- This is a character field containing L if Optimize_Alignment mode
-- was set locally, and O/T/S for Off/Time/Space default if not.
@ -397,6 +401,7 @@ package Lib is
function Fatal_Error (U : Unit_Number_Type) return Boolean;
function Generate_Code (U : Unit_Number_Type) return Boolean;
function Ident_String (U : Unit_Number_Type) return Node_Id;
function Has_Allocator (U : Unit_Number_Type) return Boolean;
function Has_RACW (U : Unit_Number_Type) return Boolean;
function Is_Compiler_Unit (U : Unit_Number_Type) return Boolean;
function Loading (U : Unit_Number_Type) return Boolean;
@ -415,6 +420,7 @@ package Lib is
procedure Set_Fatal_Error (U : Unit_Number_Type; B : Boolean := True);
procedure Set_Generate_Code (U : Unit_Number_Type; B : Boolean := True);
procedure Set_Has_RACW (U : Unit_Number_Type; B : Boolean := True);
procedure Set_Has_Allocator (U : Unit_Number_Type; B : Boolean := True);
procedure Set_Is_Compiler_Unit (U : Unit_Number_Type; B : Boolean := True);
procedure Set_Ident_String (U : Unit_Number_Type; N : Node_Id);
procedure Set_Loading (U : Unit_Number_Type; B : Boolean := True);
@ -653,6 +659,7 @@ private
pragma Inline (Dependency_Num);
pragma Inline (Fatal_Error);
pragma Inline (Generate_Code);
pragma Inline (Has_Allocator);
pragma Inline (Has_RACW);
pragma Inline (Is_Compiler_Unit);
pragma Inline (Increment_Serial_Number);
@ -664,6 +671,7 @@ private
pragma Inline (Set_Cunit_Entity);
pragma Inline (Set_Fatal_Error);
pragma Inline (Set_Generate_Code);
pragma Inline (Set_Has_Allocator);
pragma Inline (Set_Has_RACW);
pragma Inline (Set_Loading);
pragma Inline (Set_Main_Priority);
@ -693,6 +701,7 @@ private
Is_Compiler_Unit : Boolean;
Dynamic_Elab : Boolean;
Loading : Boolean;
Has_Allocator : Boolean;
OA_Setting : Character;
end record;
@ -720,7 +729,8 @@ private
Dynamic_Elab at 55 range 0 .. 7;
Is_Compiler_Unit at 56 range 0 .. 7;
OA_Setting at 57 range 0 .. 7;
Loading at 58 range 0 .. 15;
Loading at 58 range 0 .. 7;
Has_Allocator at 59 range 0 .. 7;
end record;
for Unit_Record'Size use 60 * 8;

47
gcc/ada/sem_ch4.adb
View File

@ -364,15 +364,60 @@ package body Sem_Ch4 is
E : Node_Id := Expression (N);
Acc_Type : Entity_Id;
Type_Id : Entity_Id;
P : Node_Id;
C : Node_Id;
begin
-- Deal with allocator restrictions
-- In accordance with H.4(7), the No_Allocators restriction only applies
-- to user-written allocators.
-- to user-written allocators. The same consideration applies to the
-- No_Allocators_Before_Elaboration restriction.
if Comes_From_Source (N) then
Check_Restriction (No_Allocators, N);
-- Processing for No_Allocators_After_Elaboration, loop to look at
-- enclosing context, checking task case and main subprogram case.
C := N;
P := Parent (C);
while Present (P) loop
-- In both cases we need a handled sequence of statements, where
-- the occurrence of the allocator is within the statements.
if Nkind (P) = N_Handled_Sequence_Of_Statements
and then Is_List_Member (C)
and then List_Containing (C) = Statements (P)
then
-- Check for allocator within task body, this is a definite
-- violation of No_Allocators_After_Elaboration we can detect.
if Nkind (Original_Node (Parent (P))) = N_Task_Body then
Check_Restriction (No_Allocators_After_Elaboration, N);
exit;
end if;
-- The other case is appearence in a subprogram body. This may
-- be a violation if this is a library level subprogram, and it
-- turns out to be used as the main program, but only the
-- binder knows that, so just record the occurrence.
if Nkind (Original_Node (Parent (P))) = N_Subprogram_Body
and then Nkind (Parent (Parent (P))) = N_Compilation_Unit
then
Set_Has_Allocator (Current_Sem_Unit);
end if;
end if;
C := P;
P := Parent (C);
end loop;
end if;
-- Analyze the allocator
if Nkind (E) = N_Qualified_Expression then
Acc_Type := Create_Itype (E_Allocator_Type, N);
Set_Etype (Acc_Type, Acc_Type);