Skip to content

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

[multiple changes] 

2010-06-22  Emmanuel Briot  <briot@adacore.com>

	* fmap.adb, scng.adb, switch-m.ads, sinput-c.adb, opt.ads, output.ads,
	tree_io.ads, osint.adb, osint.ads: Use configuration pragmas to prevent
	warnings on use of internal GNAT units.

2010-06-22  Jose Ruiz  <ruiz@adacore.com>

	* s-taprop-vxworks.adb (Set_Priority): Update comments.

2010-06-22  Paul Hilfinger  <hilfinger@adacore.com>

	* s-rannum.adb: Make stylistic change to remove mystery constant in
	Extract_Value.  Image_Numeral_Length: new symbolic constant.

2010-06-22  Ed Schonberg  <schonberg@adacore.com>

	* einfo.ads, einfo.adb: Make Is_Protected_Interface,
	Is_Synchronized_Interface, Is_Task_Interface into computable
	predicates, to free three flags in entity nodes.
	* sem_ch3.adb: Remove setting of these flags.

From-SVN: r161181
parent f6da8aff
Showing with 183 additions and 133 deletions
gcc/ada/ChangeLog
2010-06-22 Emmanuel Briot <briot@adacore.com>
* fmap.adb, scng.adb, switch-m.ads, sinput-c.adb, opt.ads, output.ads,
tree_io.ads, osint.adb, osint.ads: Use configuration pragmas to prevent
warnings on use of internal GNAT units.
2010-06-22 Jose Ruiz <ruiz@adacore.com>
* s-taprop-vxworks.adb (Set_Priority): Update comments.
2010-06-22 Paul Hilfinger <hilfinger@adacore.com>
* s-rannum.adb: Make stylistic change to remove mystery constant in
Extract_Value. Image_Numeral_Length: new symbolic constant.
2010-06-22 Ed Schonberg <schonberg@adacore.com>
* einfo.ads, einfo.adb: Make Is_Protected_Interface,
Is_Synchronized_Interface, Is_Task_Interface into computable
predicates, to free three flags in entity nodes.
* sem_ch3.adb: Remove setting of these flags.
2010-06-22 Robert Dewar <dewar@adacore.com>
* uintp.adb, osint.adb, prj-conf.adb, prj-part.adb, prj.adb: Minor
......
gcc/ada/einfo.adb
......@@ -455,9 +455,6 @@ package body Einfo is
-- Is_Primitive_Wrapper Flag195
-- Was_Hidden Flag196
-- Is_Limited_Interface Flag197
-- Is_Protected_Interface Flag198
-- Is_Synchronized_Interface Flag199
-- Is_Task_Interface Flag200
-- Has_Anon_Block_Suffix Flag201
-- Itype_Printed Flag202
......@@ -511,6 +508,10 @@ package body Einfo is
-- Is_Underlying_Record_View Flag246
-- OK_To_Rename Flag247
-- (unused) Flag198
-- (unused) Flag199
-- (unused) Flag200
-----------------------
-- Local subprograms --
-----------------------
......@@ -1942,12 +1943,6 @@ package body Einfo is
return Flag245 (Id);
end Is_Private_Primitive;
function Is_Protected_Interface (Id : E) return B is
begin
pragma Assert (Is_Interface (Id));
return Flag198 (Id);
end Is_Protected_Interface;
function Is_Public (Id : E) return B is
begin
pragma Assert (Nkind (Id) in N_Entity);
......@@ -2007,12 +2002,6 @@ package body Einfo is
return Flag28 (Id);
end Is_Statically_Allocated;
function Is_Synchronized_Interface (Id : E) return B is
begin
pragma Assert (Is_Interface (Id));
return Flag199 (Id);
end Is_Synchronized_Interface;
function Is_Tag (Id : E) return B is
begin
pragma Assert (Nkind (Id) in N_Entity);
......@@ -2024,12 +2013,6 @@ package body Einfo is
return Flag55 (Id);
end Is_Tagged_Type;
function Is_Task_Interface (Id : E) return B is
begin
pragma Assert (Is_Interface (Id));
return Flag200 (Id);
end Is_Task_Interface;
function Is_Thunk (Id : E) return B is
begin
pragma Assert (Is_Subprogram (Id));
......@@ -4390,12 +4373,6 @@ package body Einfo is
Set_Flag245 (Id, V);
end Set_Is_Private_Primitive;
procedure Set_Is_Protected_Interface (Id : E; V : B := True) is
begin
pragma Assert (Is_Interface (Id));
Set_Flag198 (Id, V);
end Set_Is_Protected_Interface;
procedure Set_Is_Public (Id : E; V : B := True) is
begin
pragma Assert (Nkind (Id) in N_Entity);
......@@ -4461,12 +4438,6 @@ package body Einfo is
Set_Flag28 (Id, V);
end Set_Is_Statically_Allocated;
procedure Set_Is_Synchronized_Interface (Id : E; V : B := True) is
begin
pragma Assert (Is_Interface (Id));
Set_Flag199 (Id, V);
end Set_Is_Synchronized_Interface;
procedure Set_Is_Tag (Id : E; V : B := True) is
begin
pragma Assert (Ekind_In (Id, E_Component, E_Constant));
......@@ -4478,12 +4449,6 @@ package body Einfo is
Set_Flag55 (Id, V);
end Set_Is_Tagged_Type;
procedure Set_Is_Task_Interface (Id : E; V : B := True) is
begin
pragma Assert (Is_Interface (Id));
Set_Flag200 (Id, V);
end Set_Is_Task_Interface;
procedure Set_Is_Thunk (Id : E; V : B := True) is
begin
Set_Flag225 (Id, V);
......@@ -6112,6 +6077,22 @@ package body Einfo is
and then Is_Protected_Type (Scope (Id));
end Is_Protected_Component;
----------------------------
-- Is_Protected_Interface --
----------------------------
function Is_Protected_Interface (Id : E) return B is
Typ : constant Entity_Id := Base_Type (Id);
begin
if not Is_Interface (Typ) then
return False;
elsif Is_Class_Wide_Type (Typ) then
return Is_Protected_Interface (Etype (Typ));
else
return Protected_Present (Type_Definition (Parent (Typ)));
end if;
end Is_Protected_Interface;
------------------------------
-- Is_Protected_Record_Type --
------------------------------
......@@ -6158,6 +6139,43 @@ package body Einfo is
and then Is_Character_Type (Component_Type (Id)));
end Is_String_Type;
-------------------------------
-- Is_Synchronized_Interface --
-------------------------------
function Is_Synchronized_Interface (Id : E) return B is
Typ : constant Entity_Id := Base_Type (Id);
begin
if not Is_Interface (Typ) then
return False;
elsif Is_Class_Wide_Type (Typ) then
return Is_Synchronized_Interface (Etype (Typ));
else
return Protected_Present (Type_Definition (Parent (Typ)))
or else Synchronized_Present (Type_Definition (Parent (Typ)))
or else Task_Present (Type_Definition (Parent (Typ)));
end if;
end Is_Synchronized_Interface;
-----------------------
-- Is_Task_Interface --
-----------------------
function Is_Task_Interface (Id : E) return B is
Typ : constant Entity_Id := Base_Type (Id);
begin
if not Is_Interface (Typ) then
return False;
elsif Is_Class_Wide_Type (Typ) then
return Is_Task_Interface (Etype (Typ));
else
return Task_Present (Type_Definition (Parent (Typ)));
end if;
end Is_Task_Interface;
-------------------------
-- Is_Task_Record_Type --
-------------------------
......@@ -6927,7 +6945,6 @@ package body Einfo is
W ("Is_Private_Composite", Flag107 (Id));
W ("Is_Private_Descendant", Flag53 (Id));
W ("Is_Private_Primitive", Flag245 (Id));
W ("Is_Protected_Interface", Flag198 (Id));
W ("Is_Public", Flag10 (Id));
W ("Is_Pure", Flag44 (Id));
W ("Is_Pure_Unit_Access_Type", Flag189 (Id));
......@@ -6938,11 +6955,9 @@ package body Einfo is
W ("Is_Renaming_Of_Object", Flag112 (Id));
W ("Is_Return_Object", Flag209 (Id));
W ("Is_Shared_Passive", Flag60 (Id));
W ("Is_Synchronized_Interface", Flag199 (Id));
W ("Is_Statically_Allocated", Flag28 (Id));
W ("Is_Tag", Flag78 (Id));
W ("Is_Tagged_Type", Flag55 (Id));
W ("Is_Task_Interface", Flag200 (Id));
W ("Is_Thunk", Flag225 (Id));
W ("Is_Trivial_Subprogram", Flag235 (Id));
W ("Is_True_Constant", Flag163 (Id));
......
gcc/ada/einfo.ads
......@@ -2477,7 +2477,7 @@ package Einfo is
-- Applicable to all entities, true if the entity denotes a private
-- component of a protected type.
-- Is_Protected_Interface (Flag198)
-- Is_Protected_Interface (Synthesized)
-- Present in types that are interfaces. True if interface is declared
-- protected, or is derived from protected interfaces.
......@@ -2584,7 +2584,7 @@ package Einfo is
-- Applies to all entities, true for function, procedure and operator
-- entities.
-- Is_Synchronized_Interface (Flag199)
-- Is_Synchronized_Interface (synthesized)
-- Present in types that are interfaces. True if interface is declared
-- synchronized, task, or protected, or is derived from a synchronized
-- interface.
......@@ -2598,7 +2598,7 @@ package Einfo is
-- Is_Tagged_Type (Flag55)
-- Present in all entities. Set for an entity for a tagged type.
-- Is_Task_Interface (Flag200)
-- Is_Task_Interface (Synthesized)
-- Present in types that are interfaces. True if interface is declared as
-- a task interface, or if it is derived from task interfaces.
......@@ -4641,10 +4641,7 @@ package Einfo is
-- Is_Eliminated (Flag124)
-- Is_Frozen (Flag4)
-- Is_Generic_Actual_Type (Flag94)
-- Is_Protected_Interface (Flag198)
-- Is_RACW_Stub_Type (Flag244)
-- Is_Synchronized_Interface (Flag199)
-- Is_Task_Interface (Flag200)
-- Is_Non_Static_Subtype (Flag109)
-- Is_Packed (Flag51) (base type only)
-- Is_Private_Composite (Flag107)
......@@ -5915,7 +5912,6 @@ package Einfo is
function Is_Private_Composite (Id : E) return B;
function Is_Private_Descendant (Id : E) return B;
function Is_Private_Primitive (Id : E) return B;
function Is_Protected_Interface (Id : E) return B;
function Is_Public (Id : E) return B;
function Is_Pure (Id : E) return B;
function Is_Pure_Unit_Access_Type (Id : E) return B;
......@@ -5927,10 +5923,8 @@ package Einfo is
function Is_Return_Object (Id : E) return B;
function Is_Shared_Passive (Id : E) return B;
function Is_Statically_Allocated (Id : E) return B;
function Is_Synchronized_Interface (Id : E) return B;
function Is_Tag (Id : E) return B;
function Is_Tagged_Type (Id : E) return B;
function Is_Task_Interface (Id : E) return B;
function Is_Thunk (Id : E) return B;
function Is_Trivial_Subprogram (Id : E) return B;
function Is_True_Constant (Id : E) return B;
......@@ -6140,9 +6134,12 @@ package Einfo is
function Is_Package_Or_Generic_Package (Id : E) return B;
function Is_Prival (Id : E) return B;
function Is_Protected_Component (Id : E) return B;
function Is_Protected_Interface (Id : E) return B;
function Is_Protected_Record_Type (Id : E) return B;
function Is_Standard_Character_Type (Id : E) return B;
function Is_String_Type (Id : E) return B;
function Is_Synchronized_Interface (Id : E) return B;
function Is_Task_Interface (Id : E) return B;
function Is_Task_Record_Type (Id : E) return B;
function Is_Wrapper_Package (Id : E) return B;
function Next_Component (Id : E) return E;
......@@ -6478,7 +6475,6 @@ package Einfo is
procedure Set_Is_Private_Composite (Id : E; V : B := True);
procedure Set_Is_Private_Descendant (Id : E; V : B := True);
procedure Set_Is_Private_Primitive (Id : E; V : B := True);
procedure Set_Is_Protected_Interface (Id : E; V : B := True);
procedure Set_Is_Public (Id : E; V : B := True);
procedure Set_Is_Pure (Id : E; V : B := True);
procedure Set_Is_Pure_Unit_Access_Type (Id : E; V : B := True);
......@@ -6490,10 +6486,8 @@ package Einfo is
procedure Set_Is_Return_Object (Id : E; V : B := True);
procedure Set_Is_Shared_Passive (Id : E; V : B := True);
procedure Set_Is_Statically_Allocated (Id : E; V : B := True);
procedure Set_Is_Synchronized_Interface (Id : E; V : B := True);
procedure Set_Is_Tag (Id : E; V : B := True);
procedure Set_Is_Tagged_Type (Id : E; V : B := True);
procedure Set_Is_Task_Interface (Id : E; V : B := True);
procedure Set_Is_Thunk (Id : E; V : B := True);
procedure Set_Is_Trivial_Subprogram (Id : E; V : B := True);
procedure Set_Is_True_Constant (Id : E; V : B := True);
......@@ -7170,7 +7164,6 @@ package Einfo is
pragma Inline (Is_Private_Descendant);
pragma Inline (Is_Private_Primitive);
pragma Inline (Is_Private_Type);
pragma Inline (Is_Protected_Interface);
pragma Inline (Is_Protected_Type);
pragma Inline (Is_Public);
pragma Inline (Is_Pure);
......@@ -7188,10 +7181,8 @@ package Einfo is
pragma Inline (Is_Signed_Integer_Type);
pragma Inline (Is_Statically_Allocated);
pragma Inline (Is_Subprogram);
pragma Inline (Is_Synchronized_Interface);
pragma Inline (Is_Tag);
pragma Inline (Is_Tagged_Type);
pragma Inline (Is_Task_Interface);
pragma Inline (Is_True_Constant);
pragma Inline (Is_Task_Type);
pragma Inline (Is_Thunk);
......@@ -7570,7 +7561,6 @@ package Einfo is
pragma Inline (Set_Is_Private_Composite);
pragma Inline (Set_Is_Private_Descendant);
pragma Inline (Set_Is_Private_Primitive);
pragma Inline (Set_Is_Protected_Interface);
pragma Inline (Set_Is_Public);
pragma Inline (Set_Is_Pure);
pragma Inline (Set_Is_Pure_Unit_Access_Type);
......@@ -7582,10 +7572,8 @@ package Einfo is
pragma Inline (Set_Is_Return_Object);
pragma Inline (Set_Is_Shared_Passive);
pragma Inline (Set_Is_Statically_Allocated);
pragma Inline (Set_Is_Synchronized_Interface);
pragma Inline (Set_Is_Tag);
pragma Inline (Set_Is_Tagged_Type);
pragma Inline (Set_Is_Task_Interface);
pragma Inline (Set_Is_Thunk);
pragma Inline (Set_Is_Trivial_Subprogram);
pragma Inline (Set_Is_True_Constant);
......
gcc/ada/fmap.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2001-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- --
......@@ -23,6 +23,10 @@
-- --
------------------------------------------------------------------------------
-- This unit is used by gnatcoll
pragma Warnings (Off, "*is an internal GNAT unit");
pragma Warnings (Off, "*use * instead");
with Opt; use Opt;
with Osint; use Osint;
with Output; use Output;
......
gcc/ada/opt.ads
......@@ -38,6 +38,10 @@
-- use the Project Manager. These tools include gnatmake, gnatname, the gnat
-- driver, gnatclean, gprbuild and gprclean.
-- This unit is used by gnatcoll
pragma Warnings (Off, "*is an internal GNAT unit");
pragma Warnings (Off, "*use * instead");
with Hostparm; use Hostparm;
with Types; use Types;
......
gcc/ada/osint.adb
......@@ -23,11 +23,9 @@
-- --
------------------------------------------------------------------------------
with Unchecked_Conversion;
with System.Case_Util; use System.Case_Util;
with GNAT.HTable;
-- This unit is used by gnatcoll
pragma Warnings (Off, "*is an internal GNAT unit");
pragma Warnings (Off, "*use * instead");
with Alloc;
with Debug;
......@@ -40,6 +38,12 @@ with Sdefault; use Sdefault;
with Table;
with Targparm; use Targparm;
with Unchecked_Conversion;
with System.Case_Util; use System.Case_Util;
with GNAT.HTable;
package body Osint is
Running_Program : Program_Type := Unspecified;
......
gcc/ada/osint.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- --
......@@ -26,12 +26,16 @@
-- This package contains the low level, operating system routines used in the
-- compiler and binder for command line processing and file input output.
-- This unit is used by gnatcoll
pragma Warnings (Off, "*is an internal GNAT unit");
pragma Warnings (Off, "*use * instead");
with Namet; use Namet;
with Types; use Types;
with System.Storage_Elements;
with System.OS_Lib; use System.OS_Lib;
with System; use System;
with System.OS_Lib; use System.OS_Lib;
with System.Storage_Elements;
pragma Elaborate_All (System.OS_Lib);
-- For the call to function Get_Target_Object_Suffix in the private part
......@@ -39,9 +43,8 @@ pragma Elaborate_All (System.OS_Lib);
package Osint is
Multi_Unit_Index_Character : Character := '~';
-- The character before the index of the unit in a multi-unit source, in
-- ALI and object file names. This is not a constant, because it is changed
-- to '$' on VMS.
-- The character before the index of the unit in a multi-unit source in ALI
-- and object file names. Changed to '$' on VMS.
Ada_Include_Path : constant String := "ADA_INCLUDE_PATH";
Ada_Objects_Path : constant String := "ADA_OBJECTS_PATH";
......
gcc/ada/output.ads
......@@ -33,40 +33,43 @@
-- writing error messages and informational output. It is also used by the
-- debug source file output routines (see Sprint.Print_Debug_Line).
with System.OS_Lib; use System.OS_Lib;
-- This unit is used by gnatcoll
pragma Warnings (Off, "*is an internal GNAT unit");
pragma Warnings (Off, "*use * instead");
with Hostparm; use Hostparm;
with Types; use Types;
with System.OS_Lib; use System.OS_Lib;
package Output is
pragma Elaborate_Body;
type Output_Proc is access procedure (S : String);
-- This type is used for the Set_Special_Output procedure. If this
-- procedure is called, then instead of lines being written to
-- standard error or standard output, a call is made to the given
-- procedure for each line, passing the line with an end of line
-- character (which is a single ASCII.LF character, even in systems
-- which normally use CR/LF or some other sequence for line end).
-- This type is used for the Set_Special_Output procedure. If Output_Proc
-- is called, then instead of lines being written to standard error or
-- standard output, a call is made to the given procedure for each line,
-- passing the line with an end of line character (which is a single
-- ASCII.LF character, even in systems which normally use CR/LF or some
-- other sequence for line end).
-----------------
-- Subprograms --
-----------------
procedure Set_Special_Output (P : Output_Proc);
-- Sets subsequent output to call procedure P. If P is null, then
-- the call cancels the effect of a previous call, reverting the
-- output to standard error or standard output depending on the
-- mode at the time of previous call. Any exception generated by
-- by calls to P is simply propagated to the caller of the routine
-- causing the write operation.
-- Sets subsequent output to call procedure P. If P is null, then the call
-- cancels the effect of a previous call, reverting the output to standard
-- error or standard output depending on the mode at the time of previous
-- call. Any exception generated by by calls to P is simply propagated to
-- the caller of the routine causing the write operation.
procedure Cancel_Special_Output;
-- Cancels the effect of a call to Set_Special_Output, if any.
-- The output is then directed to standard error or standard output
-- depending on the last call to Set_Standard_Error or Set_Standard_Output.
-- It is never an error to call Cancel_Special_Output. It has the same
-- effect as calling Set_Special_Output (null).
-- Cancels the effect of a call to Set_Special_Output, if any. The output
-- is then directed to standard error or standard output depending on the
-- last call to Set_Standard_Error or Set_Standard_Output. It is never an
-- error to call Cancel_Special_Output. It has the same effect as calling
-- Set_Special_Output (null).
procedure Ignore_Output (S : String);
-- Does nothing. To disable output, pass Ignore_Output'Access to
......@@ -81,16 +84,16 @@ package Output is
procedure Set_Standard_Output;
-- Sets subsequent output to appear on the standard output file (whatever
-- that might mean for the host operating system, if anything) when
-- no special output is in effect. When a special output is in effect,
-- the output will appear on standard output only after special output
-- has been cancelled. Output to standard output is the default mode
-- before any call to either of the Set procedures.
-- that might mean for the host operating system, if anything) when no
-- special output is in effect. When a special output is in effect, the
-- output will appear on standard output only after special output has been
-- cancelled. Output to standard output is the default mode before any call
-- to either of the Set procedures.
procedure Set_Output (FD : File_Descriptor);
-- Sets subsequent output to appear on the given file descriptor when no
-- special output is in effect. When a special output is in effect,
-- the output will appear on the given file descriptor only after special
-- special output is in effect. When a special output is in effect, the
-- output will appear on the given file descriptor only after special
-- output has been cancelled.
procedure Indent;
......@@ -109,36 +112,36 @@ package Output is
-- If last character in buffer matches C, erase it, otherwise no effect
procedure Write_Eol;
-- Write an end of line (whatever is required by the system in use,
-- e.g. CR/LF for DOS, or LF for Unix) to the standard output file.
-- This routine also empties the line buffer, actually writing it
-- to the file. Note that Write_Eol is the only routine that causes
-- any actual output to be written. Trailing spaces are removed.
-- Write an end of line (whatever is required by the system in use, e.g.
-- CR/LF for DOS, or LF for Unix) to the standard output file. This routine
-- also empties the line buffer, actually writing it to the file. Note that
-- Write_Eol is the only routine that causes any actual output to be
-- written. Trailing spaces are removed.
procedure Write_Eol_Keep_Blanks;
-- Similar as Write_Eol, except that trailing spaces are not removed
procedure Write_Int (Val : Int);
-- Write an integer value with no leading blanks or zeroes. Negative
-- values are preceded by a minus sign).
-- Write an integer value with no leading blanks or zeroes. Negative values
-- are preceded by a minus sign).
procedure Write_Spaces (N : Nat);
-- Write N spaces
procedure Write_Str (S : String);
-- Write a string of characters to the standard output file. Note that
-- end of line is normally handled separately using WRITE_EOL, but it
-- is allowed for the string to contain LF (but not CR) characters,
-- which are properly interpreted as end of line characters. The string
-- may also contain horizontal tab characters.
-- end of line is normally handled separately using WRITE_EOL, but it is
-- allowable for the string to contain LF (but not CR) characters, which
-- are properly interpreted as end of line characters. The string may also
-- contain horizontal tab characters.
procedure Write_Line (S : String);
-- Equivalent to Write_Str (S) followed by Write_Eol;
function Column return Pos;
pragma Inline (Column);
-- Returns the number of the column about to be written (e.g. a value
-- of 1 means the current line is empty).
-- Returns the number of the column about to be written (e.g. a value of 1
-- means the current line is empty).
-------------------------
-- Buffer Save/Restore --
......
gcc/ada/s-rannum.adb
......@@ -119,6 +119,7 @@ package body System.Random_Numbers is
(Year => 2000, Month => 1, Day => 1, Seconds => 0.0);
-- First Year 2000 day
Image_Numeral_Length : constant := Max_Image_Width / N;
subtype Image_String is String (1 .. Max_Image_Width);
-- Utility functions
......@@ -526,9 +527,9 @@ package body System.Random_Numbers is
-------------------
function Extract_Value (S : String; Index : Integer) return State_Val is
Start : constant Integer := S'First + Index * Image_Numeral_Length;
begin
return State_Val'Value (S (S'First + Index * 11 ..
S'First + Index * 11 + 10));
return State_Val'Value (S (Start .. Start + Image_Numeral_Length - 1));
end Extract_Value;
end System.Random_Numbers;
gcc/ada/s-taprop-vxworks.adb
......@@ -745,10 +745,12 @@ package body System.Task_Primitives.Operations is
(T.Common.LL.Thread, To_VxWorks_Priority (int (Prio)));
pragma Assert (Result = 0);
-- Note: in VxWorks, the task is placed at the end of the priority queue
-- instead of the head. This is not the behavior required by Annex D,
-- but we consider it an acceptable variation (RM 1.1.3(6)), given this
-- is the built-in behavior of the operating system.
-- Note: in VxWorks 6.6 (or earlier), the task is placed at the end of
-- the priority queue instead of the head. This is not the behavior
-- required by Annex D (RM D.2.3(5/2)), but we consider it an acceptable
-- variation (RM 1.1.3(6)), given this is the built-in behavior of the
-- operating system. VxWorks versions starting from 6.7 implement the
-- required Annex D semantics.
-- In older versions we attempted to better approximate the Annex D
-- required behavior, but this simulation was not entirely accurate,
......
gcc/ada/scng.adb
......@@ -23,6 +23,11 @@
-- --
------------------------------------------------------------------------------
-- This unit is used by gnatcoll
pragma Warnings (Off, "*is an internal GNAT unit");
pragma Warnings (Off, "*use of this unit is non-portable*");
pragma Warnings (Off, "*use * instead");
with Csets; use Csets;
with Err_Vars; use Err_Vars;
with Hostparm; use Hostparm;
......
gcc/ada/sem_ch3.adb
......@@ -2166,17 +2166,6 @@ package body Sem_Ch3 is
or else Synchronized_Present (Def)
or else Task_Present (Def));
Set_Is_Protected_Interface (T, Protected_Present (Def));
Set_Is_Task_Interface (T, Task_Present (Def));
-- Type is a synchronized interface if it includes the keyword task,
-- protected, or synchronized.
Set_Is_Synchronized_Interface
(T, Synchronized_Present (Def)
or else Protected_Present (Def)
or else Task_Present (Def));
Set_Interfaces (T, New_Elmt_List);
Set_Primitive_Operations (T, New_Elmt_List);
......@@ -2186,9 +2175,6 @@ package body Sem_Ch3 is
if Present (CW) then
Set_Is_Interface (CW);
Set_Is_Limited_Interface (CW, Is_Limited_Interface (T));
Set_Is_Protected_Interface (CW, Is_Protected_Interface (T));
Set_Is_Synchronized_Interface (CW, Is_Synchronized_Interface (T));
Set_Is_Task_Interface (CW, Is_Task_Interface (T));
end if;
-- Check runtime support for synchronized interfaces
......
gcc/ada/sinput-c.adb
......@@ -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- --
......@@ -23,6 +23,10 @@
-- --
------------------------------------------------------------------------------
-- This unit is used by gnatcoll
pragma Warnings (Off, "*is an internal GNAT unit");
pragma Warnings (Off, "*use * instead");
with Opt; use Opt;
with System; use System;
......
gcc/ada/switch-m.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2001-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- --
......@@ -29,7 +29,12 @@
-- switches that are recognized. In addition, package Debug documents
-- the otherwise undocumented debug switches that are also recognized.
-- This unit is used by gnatcoll
pragma Warnings (Off, "*is an internal GNAT unit");
pragma Warnings (Off, "*use * instead");
with System.OS_Lib; use System.OS_Lib;
with Prj.Tree;
package Switch.M is
......
gcc/ada/tree_io.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- --
......@@ -34,6 +34,10 @@
-- create and close routines are elsewhere (in Osint in the compiler, and in
-- the tree read driver for the tree read interface).
-- This unit is used by gnatcoll
pragma Warnings (Off, "*is an internal GNAT unit");
pragma Warnings (Off, "*use * instead");
with Types; use Types;
with System; use System;
......
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