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

New file.

Browse Source 
Resync.

From-SVN: r123611
This commit is contained in:
Arnaud Charlet 2007-04-06 11:43:23 +02:00
parent 8405d93cb8
commit fa5537cb48
20 changed files with 584 additions and 345 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
gcc/ada/a-cgcaso.ads
View File

@ -7,7 +7,7 @@
-- --
-- S p e c --
-- --
-- This specification is adapted from the Ada Reference Manual for use with --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --

62
gcc/ada/a-chtgop.adb
View File

@ -133,7 +133,8 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
begin
if HT.Busy > 0 then
raise Program_Error;
raise Program_Error with
"attempt to tamper with elements (container is busy)";
end if;
while HT.Length > 0 loop
@ -171,14 +172,16 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
begin
if HT.Length = 0 then
raise Program_Error;
raise Program_Error with
"attempt to delete node from empty hashed container";
end if;
Indx := Index (HT, X);
Prev := HT.Buckets (Indx);
if Prev = null then
raise Program_Error;
raise Program_Error with
"attempt to delete node from empty hash bucket";
end if;
if Prev = X then
@ -188,14 +191,16 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
end if;
if HT.Length = 1 then
raise Program_Error;
raise Program_Error with
"attempt to delete node not in its proper hash bucket";
end if;
loop
Curr := Next (Prev);
if Curr = null then
raise Program_Error;
raise Program_Error with
"attempt to delete node not in its proper hash bucket";
end if;
if Curr = X then
@ -288,16 +293,19 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
return True;
end if;
L_Index := 0;
-- Find the first node of hash table L
L_Index := 0;
loop
L_Node := L.Buckets (L_Index);
exit when L_Node /= null;
L_Index := L_Index + 1;
end loop;
N := L.Length;
-- For each node of hash table L, search for an equivalent node in hash
-- table R.
N := L.Length;
loop
if not Find (HT => R, Key => L_Node) then
return False;
@ -308,10 +316,14 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
L_Node := Next (L_Node);
if L_Node = null then
-- We have exhausted the nodes in this bucket
if N = 0 then
return True;
end if;
-- Find the next bucket
loop
L_Index := L_Index + 1;
L_Node := L.Buckets (L_Index);
@ -347,7 +359,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
------------------
procedure Generic_Read
(Stream : access Root_Stream_Type'Class;
(Stream : not null access Root_Stream_Type'Class;
HT : out Hash_Table_Type)
is
N : Count_Type'Base;
@ -359,13 +371,18 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
Count_Type'Base'Read (Stream, N);
if N < 0 then
raise Program_Error;
raise Program_Error with "stream appears to be corrupt";
end if;
if N = 0 then
return;
end if;
-- The RM does not specify whether or how the capacity changes when a
-- hash table is streamed in. Therefore we decide here to allocate a new
-- buckets array only when it's necessary to preserve representation
-- invariants.
if HT.Buckets = null
or else HT.Buckets'Length < N
then
@ -393,7 +410,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
-------------------
procedure Generic_Write
(Stream : access Root_Stream_Type'Class;
(Stream : not null access Root_Stream_Type'Class;
HT : Hash_Table_Type)
is
procedure Write (Node : Node_Access);
@ -411,6 +428,9 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
end Write;
begin
-- See Generic_Read for an explanation of why we do not stream out the
-- buckets array length too.
Count_Type'Base'Write (Stream, HT.Length);
Write (HT);
end Generic_Write;
@ -444,7 +464,8 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
end if;
if Source.Busy > 0 then
raise Program_Error;
raise Program_Error with
"attempt to tamper with elements (container is busy)";
end if;
Clear (Target);
@ -507,6 +528,13 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
end if;
if HT.Length = 0 then
-- This is the easy case. There are no nodes, so no rehashing is
-- necessary. All we need to do is allocate a new buckets array
-- having a length implied by the specified capacity. (We say
-- "implied by" because bucket arrays are always allocated with a
-- length that corresponds to a prime number.)
if N = 0 then
Free (HT.Buckets);
return;
@ -537,6 +565,12 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
end if;
if N < HT.Buckets'Length then
-- This is a request to contract the buckets array. The amount of
-- contraction is bounded in order to preserve the invariant that the
-- buckets array length is never smaller than the number of elements
-- (the load factor is 1).
if HT.Length >= HT.Buckets'Length then
return;
end if;
@ -556,7 +590,8 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
end if;
if HT.Busy > 0 then
raise Program_Error;
raise Program_Error with
"attempt to tamper with elements (container is busy)";
end if;
Rehash : declare
@ -622,7 +657,8 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
end loop;
Free (Dst_Buckets);
raise Program_Error;
raise Program_Error with
"hash function raised exception during rehash";
end;
Src_Index := Src_Index + 1;

9
gcc/ada/a-cohata.ads
View File

@ -6,11 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- apply solely to the contents of the part following the private keyword. --
-- Copyright (C) 2004-2006, 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- --
@ -33,6 +29,9 @@
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
-- This package declares the hash-table type used to implement hashed
-- containers.
package Ada.Containers.Hash_Tables is
pragma Preelaborate;

50
gcc/ada/a-disedf.ads Normal file
View File

@ -0,0 +1,50 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . D I S P A T C H I N G . E D F --
-- --
-- S p e c --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
-- This unit is not implemented in typical GNAT implementations that lie on
-- top of operating systems, because it is infeasible to implement in such
-- environments.
-- If a target environment provides appropriate support for this package,
-- then the Unimplemented_Unit pragma should be removed from this spec and
-- an appropriate body provided.
with Ada.Real_Time;
with Ada.Task_Identification;
package Ada.Dispatching.EDF is
pragma Preelaborate;
pragma Unimplemented_Unit;
subtype Deadline is Ada.Real_Time.Time;
Default_Deadline : constant Deadline := Ada.Real_Time.Time_Last;
procedure Set_Deadline
(D : Deadline;
T : Ada.Task_Identification.Task_Id :=
Ada.Task_Identification.Current_Task);
procedure Delay_Until_And_Set_Deadline
(Delay_Until_Time : Ada.Real_Time.Time;
Deadline_Offset : Ada.Real_Time.Time_Span);
function Get_Deadline
(T : Ada.Task_Identification.Task_Id :=
Ada.Task_Identification.Current_Task)
return Deadline;
end Ada.Dispatching.EDF;

87
gcc/ada/a-etgrbu.ads Normal file
View File

@ -0,0 +1,87 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . E X E C U T I O N _ T I M E . G R O U P _ B U D G E T S --
-- --
-- S p e c --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
-- This unit is not implemented in typical GNAT implementations that lie on
-- top of operating systems, because it is infeasible to implement in such
-- environments.
-- If a target environment provides appropriate support for this package,
-- then the Unimplemented_Unit pragma should be removed from this spec and
-- an appropriate body provided.
with System;
package Ada.Execution_Time.Group_Budgets is
pragma Preelaborate;
pragma Unimplemented_Unit;
type Group_Budget is tagged limited private;
type Group_Budget_Handler is access
protected procedure (GB : in out Group_Budget);
type Task_Array is
array (Positive range <>) of Ada.Task_Identification.Task_Id;
Min_Handler_Ceiling : constant System.Any_Priority :=
System.Any_Priority'First;
-- Initial value is an arbitrary choice ???
procedure Add_Task
(GB : in out Group_Budget;
T : Ada.Task_Identification.Task_Id);
procedure Remove_Task
(GB : in out Group_Budget;
T : Ada.Task_Identification.Task_Id);
function Is_Member
(GB : Group_Budget;
T : Ada.Task_Identification.Task_Id) return Boolean;
function Is_A_Group_Member
(T : Ada.Task_Identification.Task_Id) return Boolean;
function Members (GB : Group_Budget) return Task_Array;
procedure Replenish
(GB : in out Group_Budget;
To : Ada.Real_Time.Time_Span);
procedure Add
(GB : in out Group_Budget;
Interval : Ada.Real_Time.Time_Span);
function Budget_Has_Expired (GB : Group_Budget) return Boolean;
function Budget_Remaining
(GB : Group_Budget) return Ada.Real_Time.Time_Span;
procedure Set_Handler
(GB : in out Group_Budget;
Handler : Group_Budget_Handler);
function Current_Handler (GB : Group_Budget) return Group_Budget_Handler;
procedure Cancel_Handler
(GB : in out Group_Budget;
Cancelled : out Boolean);
Group_Budget_Error : exception;
private
type Group_Budget is tagged limited null record;
end Ada.Execution_Time.Group_Budgets;

84
gcc/ada/a-exetim.ads Normal file
View File

@ -0,0 +1,84 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . E X E C U T I O N _ T I M E --
-- --
-- S p e c --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
-- This unit is not implemented in typical GNAT implementations that lie on
-- top of operating systems, because it is infeasible to implement in such
-- environments.
-- If a target environment provides appropriate support for this package
-- then the Unimplemented_Unit pragma should be removed from this spec and
-- an appropriate body provided.
with Ada.Task_Identification;
with Ada.Real_Time;
package Ada.Execution_Time is
pragma Preelaborate;
pragma Unimplemented_Unit;
type CPU_Time is private;
CPU_Time_First : constant CPU_Time;
CPU_Time_Last : constant CPU_Time;
CPU_Time_Unit : constant := 0.000001;
CPU_Tick : constant Ada.Real_Time.Time_Span;
function Clock
(T : Ada.Task_Identification.Task_Id
:= Ada.Task_Identification.Current_Task)
return CPU_Time;
function "+"
(Left : CPU_Time;
Right : Ada.Real_Time.Time_Span) return CPU_Time;
function "+"
(Left : Ada.Real_Time.Time_Span;
Right : CPU_Time) return CPU_Time;
function "-"
(Left : CPU_Time;
Right : Ada.Real_Time.Time_Span) return CPU_Time;
function "-"
(Left : CPU_Time;
Right : CPU_Time) return Ada.Real_Time.Time_Span;
function "<" (Left, Right : CPU_Time) return Boolean;
function "<=" (Left, Right : CPU_Time) return Boolean;
function ">" (Left, Right : CPU_Time) return Boolean;
function ">=" (Left, Right : CPU_Time) return Boolean;
procedure Split
(T : CPU_Time;
SC : out Ada.Real_Time.Seconds_Count;
TS : out Ada.Real_Time.Time_Span);
function Time_Of
(SC : Ada.Real_Time.Seconds_Count;
TS : Ada.Real_Time.Time_Span := Ada.Real_Time.Time_Span_Zero)
return CPU_Time;
private
type CPU_Time is new Ada.Real_Time.Time;
CPU_Time_First : constant CPU_Time := CPU_Time (Ada.Real_Time.Time_First);
CPU_Time_Last : constant CPU_Time := CPU_Time (Ada.Real_Time.Time_Last);
CPU_Tick : constant Ada.Real_Time.Time_Span := Ada.Real_Time.Tick;
end Ada.Execution_Time;

62
gcc/ada/a-extiti.ads Normal file
View File

@ -0,0 +1,62 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . E X E C U T I O N _ T I M E . T I M E R S --
-- --
-- S p e c --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
-- This unit is not implemented in typical GNAT implementations that lie on
-- top of operating systems, because it is infeasible to implement in such
-- environments.
-- If a target environment provides appropriate support for this package,
-- then the Unimplemented_Unit pragma should be removed from this spec and
-- an appropriate body provided.
with System;
package Ada.Execution_Time.Timers is
pragma Preelaborate;
pragma Unimplemented_Unit;
type Timer (T : access Ada.Task_Identification.Task_Id) is
tagged limited private;
type Timer_Handler is
access protected procedure (TM : in out Timer);
Min_Handler_Ceiling : constant System.Any_Priority := System.Priority'Last;
procedure Set_Handler
(TM : in out Timer;
In_Time : Ada.Real_Time.Time_Span;
Handler : Timer_Handler);
procedure Set_Handler
(TM : in out Timer;
At_Time : CPU_Time;
Handler : Timer_Handler);
function Current_Handler (TM : Timer) return Timer_Handler;
procedure Cancel_Handler
(TM : in out Timer;
Cancelled : in out Boolean);
function Time_Remaining (TM : Timer) return Ada.Real_Time.Time_Span;
Timer_Resource_Error : exception;
private
type Timer (T : access Ada.Task_Identification.Task_Id) is
tagged limited null record;
end Ada.Execution_Time.Timers;

11
gcc/ada/adaint.h
View File

@ -39,9 +39,14 @@
#include <dirent.h>
/* Constants used for the form parameter encoding values */
#define Encoding_UTF8 0
#define Encoding_8bits 1
typedef long OS_Time; /* Type corresponding to GNAT.OS_Lib.OS_Time */
extern int __gnat_max_path_len;
extern OS_Time __gnat_current_time (void);
extern void __gnat_to_gm_time (OS_Time *, int *,
int *, int *,
int *, int *,
@ -66,8 +71,8 @@ extern int __gnat_open_new_temp (char *, int);
extern int __gnat_mkdir (char *);
extern int __gnat_stat (char *,
struct stat *);
extern FILE *__gnat_fopen (char *, char *);
extern FILE *__gnat_freopen (char *, char *, FILE *);
extern FILE *__gnat_fopen (char *, char *, int);
extern FILE *__gnat_freopen (char *, char *, FILE *, int);
extern int __gnat_open_read (char *, int);
extern int __gnat_open_rw (char *, int);
extern int __gnat_open_create (char *, int);
@ -117,7 +122,7 @@ extern char *__gnat_to_host_dir_spec (char *, int);
extern char *__gnat_to_host_file_spec (char *);
extern char *__gnat_to_canonical_path_spec (char *);
extern void __gnat_adjust_os_resource_limits (void);
extern void convert_addresses (void *, int,
extern void convert_addresses (const char *, void *, int,
void *, int *);
extern int __gnat_copy_attribs (char *, char *, int);
extern int __gnat_feof (FILE *);

6
gcc/ada/bindusg.adb
View File

@ -180,10 +180,10 @@ package body Bindusg is
Write_Line (" -s Require all source files to be present");
-- Line for -Sxx switch
-- Line for -S?? switch
Write_Line (" -S?? Sin/lo/hi/xx for Initialize_Scalars " &
"invalid/low/high/hex");
Write_Line (" -S?? Sin/lo/hi/xx/ev Initialize_Scalars " &
"invalid/low/high/hex/env var");
-- Line for -static

5
gcc/ada/exp_aggr.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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,7 +32,8 @@ package Exp_Aggr is
procedure Expand_N_Extension_Aggregate (N : Node_Id);
function Is_Delayed_Aggregate (N : Node_Id) return Boolean;
-- returns True if N is a delayed aggregate of some kind
-- Returns True if N is an aggregate of some kind whose Expansion_Delayed
-- flag is set (see sinfo for meaning of flag).
procedure Convert_Aggr_In_Object_Decl (N : Node_Id);
-- N is a N_Object_Declaration with an expression which must be

2
gcc/ada/exp_tss.ads
View File

@ -198,7 +198,7 @@ package Exp_Tss is
-- the corresponding base type (see Base_Init_Proc function). A special
-- case arises for concurrent types. Such types do not themselves have an
-- init proc TSS, but initialization is required. The init proc used is
-- the one fot the corresponding record type (see Base_Init_Proc).
-- the one for the corresponding record type (see Base_Init_Proc).
function Base_Init_Proc (Typ : Entity_Id) return Entity_Id;
-- Obtains the _Init TSS entry from the base type of the entity, and also

79
gcc/ada/a-diroro.adb → gcc/ada/g-io-put-vxworks.adb
View File

@ -2,11 +2,11 @@
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . D I S P A T C H I N G . R O U N D _ R O B I N --
-- G N A T . I O --
-- --
-- B o d y --
-- --
-- Copyright (C) 2006, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2006, 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- --
@ -16,8 +16,8 @@
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
@ -31,64 +31,25 @@
-- --
------------------------------------------------------------------------------
package body Ada.Dispatching.Round_Robin is
-- vxworks zfp version of Put (C : Character)
-----------------
-- Set_Quantum --
-----------------
with Interfaces.C; use Interfaces.C;
procedure Set_Quantum
(Pri : System.Priority;
Quantum : Ada.Real_Time.Time_Span)
is
pragma Unreferenced (Quantum);
begin
if not Is_Round_Robin (Pri) then
raise Dispatching_Policy_Error;
end if;
end Set_Quantum;
separate (GNAT.IO)
procedure Put (C : Character) is
-----------------
-- Set_Quantum --
-----------------
function ioGlobalStdGet
(File : int) return int;
pragma Import (C, ioGlobalStdGet, "ioGlobalStdGet");
procedure Set_Quantum
(Low, High : System.Priority;
Quantum : Ada.Real_Time.Time_Span)
is
pragma Unreferenced (Quantum);
begin
for Index in Low .. High loop
if not Is_Round_Robin (Index) then
raise Dispatching_Policy_Error;
end if;
end loop;
end Set_Quantum;
procedure fdprintf
(File : int;
Format : String;
Value : Character);
pragma Import (C, fdprintf, "fdprintf");
--------------------
-- Actual_Quantum --
--------------------
Stdout_ID : constant int := 1;
function Actual_Quantum
(Pri : System.Priority) return Ada.Real_Time.Time_Span
is
begin
if Is_Round_Robin (Pri) then
return Default_Quantum;
else
raise Dispatching_Policy_Error;
end if;
end Actual_Quantum;
--------------------
-- Is_Round_Robin --
--------------------
function Is_Round_Robin (Pri : System.Priority) return Boolean is
function Get_Policy (Prio : System.Any_Priority) return Character;
pragma Import (C, Get_Policy, "__gnat_get_specific_dispatching");
begin
return Get_Policy (Pri) = 'R';
end Is_Round_Robin;
end Ada.Dispatching.Round_Robin;
begin
fdprintf (ioGlobalStdGet (Stdout_ID), "%c" & ASCII.NUL, C);
end Put;

42
gcc/ada/g-io-put.adb Normal file
View File

@ -0,0 +1,42 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- G N A T . I O --
-- --
-- B o d y --
-- --
-- Copyright (C) 1995-2006, 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- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- zfp version of Put (C : Character)
separate (GNAT.IO)
procedure Put (C : Character) is
procedure Putchar (C : Character);
pragma Import (C, Putchar, "putchar");
begin
Putchar (C);
end Put;

2
gcc/ada/gigi.h
View File

@ -6,7 +6,7 @@
* *
* C Header File *
* *
* Copyright (C) 1992-2006 Free Software Foundation, Inc. *
* Copyright (C) 1992-2006, 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- *

11
gcc/ada/gnatvsn.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2003 Free Software Foundation, Inc. --
-- Copyright (C) 2002-2006 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- --
@ -40,15 +40,6 @@ package body Gnatvsn is
-- check for the nul character in Gnat_Version_String.
pragma Import (C, Version_String, "version_string");
-------------------------
-- Get_Gnat_Build_Type --
-------------------------
function Get_Gnat_Build_Type return Gnat_Build_Type is
begin
return FSF;
end Get_Gnat_Build_Type;
-------------------------
-- Gnat_Version_String --
-------------------------

346
gcc/ada/rtsfind.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2006 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
@ -449,7 +449,6 @@ package Rtsfind is
RE_Null,
RE_Exceptions_Available_In_HIE, -- Ada.Exceptions
RE_Code_Loc, -- Ada.Exceptions
RE_Current_Target_Exception, -- Ada.Exceptions (JGNAT use only)
RE_Exception_Id, -- Ada.Exceptions
@ -457,7 +456,7 @@ package Rtsfind is
RE_Exception_Message, -- Ada.Exceptions
RE_Exception_Name_Simple, -- Ada.Exceptions
RE_Exception_Occurrence, -- Ada.Exceptions
RE_Null_Id, -- Ada.Exceptions
RE_Local_Raise, -- Ada.Exceptions
RE_Null_Occurrence, -- Ada.Exceptions
RE_Poll, -- Ada.Exceptions
RE_Raise_Exception, -- Ada.Exceptions
@ -483,24 +482,27 @@ package Rtsfind is
RE_Root_Stream_Type, -- Ada.Streams
RE_Stream_Element, -- Ada.Streams
RE_Stream_Element_Count, -- Ada.Streams
RE_Stream_Element_Offset, -- Ada.Streams
RE_Stream_Element_Array, -- Ada.Streams
RE_Stream_Access, -- Ada.Streams.Stream_IO
RE_Abstract_Interface, -- Ada.Tags
RE_Access_Level, -- Ada.Tags
RE_Addr_Ptr, -- Ada.Tags
RE_Address_Array, -- Ada.Tags
RE_CW_Membership, -- Ada.Tags
RE_Base_Address, -- Ada.Tags
RE_Cstring_Ptr, -- Ada.Tags
RE_Default_Prim_Op_Count, -- Ada.Tags
RE_Descendant_Tag, -- Ada.Tags
RE_Dispatch_Table, -- Ada.Tags
RE_Displace, -- Ada.Tags
RE_DT_Entry_Size, -- Ada.Tags
RE_DT_Min_Prologue_Size, -- Ada.Tags
RE_DT_Prologue_Size, -- Ada.Tags
RE_DT_Typeinfo_Ptr_Size, -- Ada.Tags
RE_Expanded_Name, -- Ada.Tags
RE_External_Tag, -- Ada.Tags
RO_TA_External_Tag, -- Ada.Tags
RE_Get_Access_Level, -- Ada.Tags
RE_Get_Entry_Index, -- Ada.Tags
RE_Get_External_Tag, -- Ada.Tags
RE_Get_Offset_Index, -- Ada.Tags
RE_Get_Predefined_Prim_Op_Address, -- Ada.Tags
RE_Get_Prim_Op_Address, -- Ada.Tags
@ -508,16 +510,17 @@ package Rtsfind is
RE_Get_RC_Offset, -- Ada.Tags
RE_Get_Remotely_Callable, -- Ada.Tags
RE_Get_Tagged_Kind, -- Ada.Tags
RE_Inherit_CPP_DT, -- Ada.Tags
RE_Inherit_DT, -- Ada.Tags
RE_Inherit_TSD, -- Ada.Tags
RE_Idepth, -- Ada.Tags
RE_Ifaces_Table, -- Ada.Tags
RE_Ifaces_Table_Ptr, -- Ada.Tags
RE_Interface_Data, -- Ada.Tags
RE_Interface_Data_Ptr, -- Ada.Tags
RE_Interface_Tag, -- Ada.Tags
RE_Internal_Tag, -- Ada.Tags
RE_Is_Descendant_At_Same_Level, -- Ada.Tags
RE_IW_Membership, -- Ada.Tags
RE_Nb_Ifaces, -- Ada.Tags
RE_Object_Specific_Data, -- Ada.Tags
RE_Offset_To_Top, -- Ada.Tags
RE_Type_Specific_Data, -- Ada.Tags
RE_POK_Function, -- Ada.Tags
RE_POK_Procedure, -- Ada.Tags
RE_POK_Protected_Entry, -- Ada.Tags
@ -528,15 +531,16 @@ package Rtsfind is
RE_POK_Task_Procedure, -- Ada.Tags
RE_Prim_Op_Kind, -- Ada.Tags
RE_Primary_DT, -- Ada.Tags
RE_Prims_Ptr, -- Ada.Tags
RE_Register_Interface_Tag, -- Ada.Tags
RE_Register_Tag, -- Ada.Tags
RE_Remotely_Callable, -- Ada.Tags
RE_RC_Offset, -- Ada.Tags
RE_Secondary_DT, -- Ada.Tags
RE_Select_Specific_Data, -- Ada.Tags
RE_Set_Access_Level, -- Ada.Tags
RE_Set_Entry_Index, -- Ada.Tags
RE_Set_Expanded_Name, -- Ada.Tags
RE_Set_External_Tag, -- Ada.Tags
RE_Set_Interface_Table, -- Ada.Tags
RE_Set_Num_Prim_Ops, -- Ada.Tags
RE_Set_Offset_Index, -- Ada.Tags
RE_Set_Offset_To_Top, -- Ada.Tags
@ -552,16 +556,16 @@ package Rtsfind is
RE_Set_TSD, -- Ada.Tags
RE_Tag, -- Ada.Tags
RE_Tag_Error, -- Ada.Tags
RE_Tag_Ptr, -- Ada.Tags
RE_Tags_Table, -- Ada.Tags
RE_Tagged_Kind, -- Ada.Tags
RE_TSD_Entry_Size, -- Ada.Tags
RE_TSD_Prologue_Size, -- Ada.Tags
RE_Type_Specific_Data_Ptr, -- Ada.Tags
RE_TK_Abstract_Limited_Tagged, -- Ada.Tags
RE_TK_Abstract_Tagged, -- Ada.Tags
RE_TK_Limited_Tagged, -- Ada.Tags
RE_TK_Protected, -- Ada.Tags
RE_TK_Tagged, -- Ada.Tags
RE_TK_Task, -- Ada.Tags
RE_Valid_Signature, -- Ada.Tags
RE_Abort_Task, -- Ada.Task_Identification
RE_Current_Task, -- Ada.Task_Identification
@ -584,42 +588,13 @@ package Rtsfind is
RE_Unsigned_32, -- Interfaces
RE_Unsigned_64, -- Interfaces
RE_Vtable_Ptr, -- Interfaces.CPP
RE_Displaced_This, -- Interfaces.CPP
RE_CPP_CW_Membership, -- Interfaces.CPP
RE_CPP_DT_Entry_Size, -- Interfaces.CPP
RE_CPP_DT_Prologue_Size, -- Interfaces.CPP
RE_CPP_Get_External_Tag, -- Interfaces.CPP
RE_CPP_Get_Prim_Op_Address, -- Interfaces.CPP
RE_CPP_Get_RC_Offset, -- Interfaces.CPP
RE_CPP_Get_Remotely_Callable, -- Interfaces.CPP
RE_CPP_Inherit_DT, -- Interfaces.CPP
RE_CPP_Inherit_TSD, -- Interfaces.CPP
RE_CPP_Register_Tag, -- Interfaces.CPP
RE_CPP_Set_Expanded_Name, -- Interfaces.CPP
RE_CPP_Set_External_Tag, -- Interfaces.CPP
RE_CPP_Set_Prim_Op_Address, -- Interfaces.CPP
RE_CPP_Set_RC_Offset, -- Interfaces.CPP
RE_CPP_Set_Remotely_Callable, -- Interfaces.CPP
RE_CPP_Set_TSD, -- Interfaces.CPP
RE_CPP_TSD_Entry_Size, -- Interfaces.CPP
RE_CPP_TSD_Prologue_Size, -- Interfaces.CPP
RE_Packed_Size, -- Interfaces.Packed_Decimal
RE_Packed_To_Int32, -- Interfaces.Packed_Decimal
RE_Packed_To_Int64, -- Interfaces.Packed_Decimal
RE_Int32_To_Packed, -- Interfaces.Packed_Decimal
RE_Int64_To_Packed, -- Interfaces.Packed_Decimal
RE_Address, -- System
RE_Any_Priority, -- System
RE_Bit_Order, -- System
RE_Default_Priority, -- System
RE_High_Order_First, -- System
RE_Interrupt_Priority, -- System
RE_Lib_Stop, -- System
RE_Low_Order_First, -- System
RE_Max_Interrupt_Priority, -- System
RE_Max_Priority, -- System
RE_Null_Address, -- System
RE_Priority, -- System
@ -654,7 +629,6 @@ package Rtsfind is
RE_Bit_Or, -- System.Bit_Ops
RE_Bit_Xor, -- System.Bit_Ops
RE_Boolean_Array, -- System_Boolean_Array_Operations,
RE_Vector_Not, -- System_Boolean_Array_Operations,
RE_Vector_And, -- System_Boolean_Array_Operations,
RE_Vector_Or, -- System_Boolean_Array_Operations,
@ -684,6 +658,8 @@ package Rtsfind is
RE_Compare_Array_U64, -- System.Compare_Array_Unsigned_16
RE_Get_Active_Partition_Id, -- System.DSA_Services
RE_Get_Local_Partition_Id, -- System.DSA_Services
RE_Get_Passive_Partition_Id, -- System.DSA_Services
RE_Register_Exception, -- System.Exception_Table
@ -727,18 +703,14 @@ package Rtsfind is
RE_Fat_VAX_G, -- System.Fat_VAX_G_Float
RE_Attach_To_Final_List, -- System.Finalization_Implementation
RE_Finalizable_Ptr_Ptr, -- System.Finalization_Implementation
RE_Move_Final_List, -- System.Finalization_Implementation
RE_Finalize_List, -- System.Finalization_Implementation
RE_Finalize_One, -- System.Finalization_Implementation
RE_Global_Final_List, -- System.Finalization_Implementation
RE_Record_Controller, -- System.Finalization_Implementation
RE_Limited_Record_Controller, -- System.Finalization_Implementation
RE_Deep_Tag_Initialize, -- System.Finalization_Implementation
RE_Deep_Tag_Adjust, -- System.Finalization_Implementation
RE_Deep_Tag_Finalize, -- System.Finalization_Implementation
RE_Deep_Tag_Attach, -- System.Finalization_Implementation
RE_Deep_Rec_Initialize, -- System.Finalization_Implementation
RE_Deep_Rec_Adjust, -- System.Finalization_Implementation
RE_Deep_Rec_Finalize, -- System.Finalization_Implementation
RE_Root_Controlled, -- System.Finalization_Root
RE_Finalizable, -- System.Finalization_Root
@ -786,9 +758,6 @@ package Rtsfind is
RE_Mantissa_Value, -- System_Mantissa
RE_memcpy, -- System_Memcop
RE_memmove, -- System_Memcop
RE_Bits_03, -- System.Pack_03
RE_Get_03, -- System.Pack_03
RE_Set_03, -- System.Pack_03
@ -1076,13 +1045,9 @@ package Rtsfind is
RE_Unspecified_Size, -- System.Parameters
RE_DSA_Implementation, -- System.Partition_Interface
RE_Get_Passive_Partition_Id, -- System.Partition_Interface
RE_Get_Local_Partition_Id, -- System.Partition_Interface
RE_Get_RCI_Package_Receiver, -- System.Partition_Interface
RE_Get_Unique_Remote_Pointer, -- System.Partition_Interface
RE_RACW_Stub_Type, -- System.Partition_Interface
RE_RACW_Stub_Type_Access, -- System.Partition_Interface
RE_RAS_Proxy_Type, -- System.Partition_Interface
RE_RAS_Proxy_Type_Access, -- System.Partition_Interface
RE_Raise_Program_Error_Unknown_Tag, -- System.Partition_Interface
RE_Register_Passive_Package, -- System.Partition_Interface
@ -1105,7 +1070,6 @@ package Rtsfind is
RE_Partition_ID, -- System.RPC
RE_To_PolyORB_String, -- System.Partition_Interface
RE_To_Standard_String, -- System.Partition_Interface
RE_Caseless_String_Eq, -- System.Partition_Interface
RE_TypeCode, -- System.Partition_Interface
RE_Any, -- System.Partition_Interface
@ -1122,6 +1086,7 @@ package Rtsfind is
RE_Content_Type, -- System.Partition_Interface
RE_Any_Member_Type, -- System.Partition_Interface
RE_Get_Nested_Sequence_Length, -- System.Partition_Interface
RE_Get_Any_Type, -- System.Partition_Interface
RE_Extract_Union_Value, -- System.Partition_Interface
RE_NVList_Ref, -- System.Partition_Interface
RE_NVList_Create, -- System.Partition_Interface
@ -1133,7 +1098,7 @@ package Rtsfind is
RE_Request_Raise_Occurrence, -- System.Partition_Interface
RE_Nil_Exc_List, -- System.Partition_Interface
RE_Servant, -- System.Partition_Interface
RE_Copy_Any_Value, -- System.Partition_Interface
RE_Move_Any_Value, -- System.Partition_Interface
RE_Set_Result, -- System.Partition_Interface
RE_Register_Obj_Receiving_Stub, -- System.Partition_Interface
RE_Register_Pkg_Receiving_Stub, -- System.Partition_Interface
@ -1145,7 +1110,6 @@ package Rtsfind is
RE_Make_Ref, -- System.Partition_Interface
RE_Get_Local_Address, -- System.Partition_Interface
RE_Get_Reference, -- System.Partition_Interface
RE_Local_Oid_To_Address, -- System.Partition_Interface
RE_Asynchronous_P_To_Sync_Scope, -- System.Partition_Interface
RE_Buffer_Stream_Type, -- System.Partition_Interface
RE_Allocate_Buffer, -- System.Partition_Interface
@ -1153,8 +1117,6 @@ package Rtsfind is
RE_BS_To_Any, -- System.Partition_Interface
RE_Any_To_BS, -- System.Partition_Interface
RE_FA_AD, -- System.Partition_Interface
RE_FA_AS, -- System.Partition_Interface
RE_FA_B, -- System.Partition_Interface
RE_FA_C, -- System.Partition_Interface
RE_FA_F, -- System.Partition_Interface
@ -1176,8 +1138,7 @@ package Rtsfind is
RE_FA_String, -- System.Partition_Interface
RE_FA_ObjRef, -- System.Partition_Interface
RE_TA_AD, -- System.Partition_Interface
RE_TA_AS, -- System.Partition_Interface
RE_TA_A, -- System.Partition_Interface
RE_TA_B, -- System.Partition_Interface
RE_TA_C, -- System.Partition_Interface
RE_TA_F, -- System.Partition_Interface
@ -1205,8 +1166,6 @@ package Rtsfind is
RE_Get_TC, -- System.Partition_Interface
RE_Set_TC, -- System.Partition_Interface
RE_TC_Any, -- System.Partition_Interface
RE_TC_AD, -- System.Partition_Interface
RE_TC_AS, -- System.Partition_Interface
RE_TC_B, -- System.Partition_Interface
RE_TC_C, -- System.Partition_Interface
RE_TC_F, -- System.Partition_Interface
@ -1271,16 +1230,12 @@ package Rtsfind is
RE_Integer_Address, -- System.Storage_Elements
RE_Storage_Offset, -- System.Storage_Elements
RE_Storage_Array, -- System.Storage_Elements
RE_Storage_Element, -- System.Storage_Elements
RE_To_Address, -- System.Storage_Elements
RE_Root_Storage_Pool, -- System.Storage_Pools
RE_Allocate_Any, -- System_Storage_Pools,
RE_Deallocate_Any, -- System_Storage_Pools,
RE_Thin_Pointer, -- System.Stream_Attributes
RE_Fat_Pointer, -- System.Stream_Attributes
RE_I_AD, -- System.Stream_Attributes
RE_I_AS, -- System.Stream_Attributes
RE_I_B, -- System.Stream_Attributes
@ -1323,8 +1278,6 @@ package Rtsfind is
RE_W_WC, -- System.Stream_Attributes
RE_W_WWC, -- System.Stream_Attributes
RE_Block_Stream_Ops_OK, -- System.Stream_Attributes
RE_Str_Concat, -- System.String_Ops
RE_Str_Concat_CC, -- System.String_Ops
RE_Str_Concat_CS, -- System.String_Ops
@ -1339,8 +1292,6 @@ package Rtsfind is
RE_Task_Info_Type, -- System.Task_Info
RE_Unspecified_Task_Info, -- System.Task_Info
RE_Library_Task_Level, -- System.Tasking
RE_Task_Procedure_Access, -- System.Tasking
RO_ST_Task_Id, -- System.Tasking
@ -1350,22 +1301,15 @@ package Rtsfind is
RE_Simple_Call, -- System.Tasking
RE_Conditional_Call, -- System.Tasking
RE_Asynchronous_Call, -- System.Tasking
RE_Timed_Call, -- System.Tasking
RE_Ada_Task_Control_Block, -- System.Tasking
RE_Task_List, -- System.Tasking
RE_Accept_Alternative, -- System.Tasking
RE_Accept_List, -- System.Tasking
RE_Accept_List_Access, -- System.Tasking
RE_Max_Select, -- System.Tasking
RE_Max_Task_Entry, -- System.Tasking
RE_No_Rendezvous, -- System.Tasking
RE_Null_Task_Entry, -- System.Tasking
RE_Positive_Select_Index, -- System.Tasking
RE_Select_Index, -- System.Tasking
RE_Select_Modes, -- System.Tasking
RE_Else_Mode, -- System.Tasking
RE_Simple_Mode, -- System.Tasking
RE_Terminate_Mode, -- System.Tasking
@ -1377,6 +1321,7 @@ package Rtsfind is
RE_Unspecified_Priority, -- System.Tasking
RE_Activation_Chain, -- System.Tasking
RE_Activation_Chain_Access, -- System.Tasking
RE_Storage_Size, -- System.Tasking
RE_Abort_Defer, -- System.Soft_Links
@ -1525,7 +1470,6 @@ package Rtsfind is
RE_Protection_Entries, -- Tasking.Protected_Objects.Entries
RE_Initialize_Protection_Entries, -- Tasking.Protected_Objects.Entries
RE_Lock_Entries, -- Tasking.Protected_Objects.Entries
RE_Lock_Read_Only_Entries, -- Tasking.Protected_Objects.Entries
RO_PE_Get_Ceiling, -- Tasking.Protected_Objects.Entries
RO_PE_Set_Ceiling, -- Tasking.Protected_Objects.Entries
RE_Unlock_Entries, -- Tasking.Protected_Objects.Entries
@ -1546,7 +1490,6 @@ package Rtsfind is
RE_Protection_Entry, -- Protected_Objects.Single_Entry
RE_Initialize_Protection_Entry, -- Protected_Objects.Single_Entry
RE_Lock_Entry, -- Protected_Objects.Single_Entry
RE_Lock_Read_Only_Entry, -- Protected_Objects.Single_Entry
RE_Unlock_Entry, -- Protected_Objects.Single_Entry
RE_Protected_Single_Entry_Call, -- Protected_Objects.Single_Entry
RE_Service_Entry, -- Protected_Objects.Single_Entry
@ -1562,7 +1505,6 @@ package Rtsfind is
RE_Initialize_Protection, -- System.Tasking.Protected_Objects
RE_Finalize_Protection, -- System.Tasking.Protected_Objects
RE_Lock, -- System.Tasking.Protected_Objects
RE_Lock_Read_Only, -- System.Tasking.Protected_Objects
RE_Get_Ceiling, -- System.Tasking.Protected_Objects
RE_Set_Ceiling, -- System.Tasking.Protected_Objects
RE_Unlock, -- System.Tasking.Protected_Objects
@ -1603,6 +1545,7 @@ package Rtsfind is
RE_Complete_Task, -- System.Tasking.Stages
RE_Free_Task, -- System.Tasking.Stages
RE_Expunge_Unactivated_Tasks, -- System.Tasking.Stages
RE_Move_Activation_Chain, -- System_Tasking_Stages
RE_Terminated); -- System.Tasking.Stages
-- The following declarations build a table that is indexed by the
@ -1613,7 +1556,6 @@ package Rtsfind is
RE_Null => RTU_Null,
RE_Exceptions_Available_In_HIE => Ada_Exceptions,
RE_Code_Loc => Ada_Exceptions,
RE_Current_Target_Exception => Ada_Exceptions, -- of JGNAT
RE_Exception_Id => Ada_Exceptions,
@ -1621,7 +1563,7 @@ package Rtsfind is
RE_Exception_Message => Ada_Exceptions,
RE_Exception_Name_Simple => Ada_Exceptions,
RE_Exception_Occurrence => Ada_Exceptions,
RE_Null_Id => Ada_Exceptions,
RE_Local_Raise => Ada_Exceptions,
RE_Null_Occurrence => Ada_Exceptions,
RE_Poll => Ada_Exceptions,
RE_Raise_Exception => Ada_Exceptions,
@ -1647,24 +1589,27 @@ package Rtsfind is
RE_Root_Stream_Type => Ada_Streams,
RE_Stream_Element => Ada_Streams,
RE_Stream_Element_Count => Ada_Streams,
RE_Stream_Element_Offset => Ada_Streams,
RE_Stream_Element_Array => Ada_Streams,
RE_Stream_Access => Ada_Streams_Stream_IO,
RE_Abstract_Interface => Ada_Tags,
RE_Access_Level => Ada_Tags,
RE_Addr_Ptr => Ada_Tags,
RE_Address_Array => Ada_Tags,
RE_CW_Membership => Ada_Tags,
RE_Base_Address => Ada_Tags,
RE_Cstring_Ptr => Ada_Tags,
RE_Default_Prim_Op_Count => Ada_Tags,
RE_Descendant_Tag => Ada_Tags,
RE_Dispatch_Table => Ada_Tags,
RE_Displace => Ada_Tags,
RE_DT_Entry_Size => Ada_Tags,
RE_DT_Min_Prologue_Size => Ada_Tags,
RE_DT_Prologue_Size => Ada_Tags,
RE_DT_Typeinfo_Ptr_Size => Ada_Tags,
RE_Expanded_Name => Ada_Tags,
RE_External_Tag => Ada_Tags,
RO_TA_External_Tag => Ada_Tags,
RE_Get_Access_Level => Ada_Tags,
RE_Get_Entry_Index => Ada_Tags,
RE_Get_External_Tag => Ada_Tags,
RE_Get_Offset_Index => Ada_Tags,
RE_Get_Predefined_Prim_Op_Address => Ada_Tags,
RE_Get_Prim_Op_Address => Ada_Tags,
@ -1672,16 +1617,17 @@ package Rtsfind is
RE_Get_RC_Offset => Ada_Tags,
RE_Get_Remotely_Callable => Ada_Tags,
RE_Get_Tagged_Kind => Ada_Tags,
RE_Inherit_CPP_DT => Ada_Tags,
RE_Inherit_DT => Ada_Tags,
RE_Inherit_TSD => Ada_Tags,
RE_Idepth => Ada_Tags,
RE_Ifaces_Table => Ada_Tags,
RE_Ifaces_Table_Ptr => Ada_Tags,
RE_Interface_Data => Ada_Tags,
RE_Interface_Data_Ptr => Ada_Tags,
RE_Interface_Tag => Ada_Tags,
RE_Internal_Tag => Ada_Tags,
RE_Is_Descendant_At_Same_Level => Ada_Tags,
RE_IW_Membership => Ada_Tags,
RE_Nb_Ifaces => Ada_Tags,
RE_Object_Specific_Data => Ada_Tags,
RE_Offset_To_Top => Ada_Tags,
RE_Type_Specific_Data => Ada_Tags,
RE_POK_Function => Ada_Tags,
RE_POK_Procedure => Ada_Tags,
RE_POK_Protected_Entry => Ada_Tags,
@ -1692,15 +1638,16 @@ package Rtsfind is
RE_POK_Task_Procedure => Ada_Tags,
RE_Prim_Op_Kind => Ada_Tags,
RE_Primary_DT => Ada_Tags,
RE_Prims_Ptr => Ada_Tags,
RE_Register_Interface_Tag => Ada_Tags,
RE_Register_Tag => Ada_Tags,
RE_Remotely_Callable => Ada_Tags,
RE_RC_Offset => Ada_Tags,
RE_Secondary_DT => Ada_Tags,
RE_Select_Specific_Data => Ada_Tags,
RE_Set_Access_Level => Ada_Tags,
RE_Set_Entry_Index => Ada_Tags,
RE_Set_Expanded_Name => Ada_Tags,
RE_Set_External_Tag => Ada_Tags,
RE_Set_Interface_Table => Ada_Tags,
RE_Set_Num_Prim_Ops => Ada_Tags,
RE_Set_Offset_Index => Ada_Tags,
RE_Set_Offset_To_Top => Ada_Tags,
@ -1716,16 +1663,16 @@ package Rtsfind is
RE_Set_TSD => Ada_Tags,
RE_Tag => Ada_Tags,
RE_Tag_Error => Ada_Tags,
RE_Tag_Ptr => Ada_Tags,
RE_Tags_Table => Ada_Tags,
RE_Tagged_Kind => Ada_Tags,
RE_TSD_Entry_Size => Ada_Tags,
RE_TSD_Prologue_Size => Ada_Tags,
RE_Type_Specific_Data_Ptr => Ada_Tags,
RE_TK_Abstract_Limited_Tagged => Ada_Tags,
RE_TK_Abstract_Tagged => Ada_Tags,
RE_TK_Limited_Tagged => Ada_Tags,
RE_TK_Protected => Ada_Tags,
RE_TK_Tagged => Ada_Tags,
RE_TK_Task => Ada_Tags,
RE_Valid_Signature => Ada_Tags,
RE_Abort_Task => Ada_Task_Identification,
RE_Current_Task => Ada_Task_Identification,
@ -1746,42 +1693,13 @@ package Rtsfind is
RE_Unsigned_32 => Interfaces,
RE_Unsigned_64 => Interfaces,
RE_Vtable_Ptr => Interfaces_CPP,
RE_Displaced_This => Interfaces_CPP,
RE_CPP_CW_Membership => Interfaces_CPP,
RE_CPP_DT_Entry_Size => Interfaces_CPP,
RE_CPP_DT_Prologue_Size => Interfaces_CPP,
RE_CPP_Get_External_Tag => Interfaces_CPP,
RE_CPP_Get_Prim_Op_Address => Interfaces_CPP,
RE_CPP_Get_RC_Offset => Interfaces_CPP,
RE_CPP_Get_Remotely_Callable => Interfaces_CPP,
RE_CPP_Inherit_DT => Interfaces_CPP,
RE_CPP_Inherit_TSD => Interfaces_CPP,
RE_CPP_Register_Tag => Interfaces_CPP,
RE_CPP_Set_Expanded_Name => Interfaces_CPP,
RE_CPP_Set_External_Tag => Interfaces_CPP,
RE_CPP_Set_Prim_Op_Address => Interfaces_CPP,
RE_CPP_Set_RC_Offset => Interfaces_CPP,
RE_CPP_Set_Remotely_Callable => Interfaces_CPP,
RE_CPP_Set_TSD => Interfaces_CPP,
RE_CPP_TSD_Entry_Size => Interfaces_CPP,
RE_CPP_TSD_Prologue_Size => Interfaces_CPP,
RE_Packed_Size => Interfaces_Packed_Decimal,
RE_Packed_To_Int32 => Interfaces_Packed_Decimal,
RE_Packed_To_Int64 => Interfaces_Packed_Decimal,
RE_Int32_To_Packed => Interfaces_Packed_Decimal,
RE_Int64_To_Packed => Interfaces_Packed_Decimal,
RE_Address => System,
RE_Any_Priority => System,
RE_Bit_Order => System,
RE_Default_Priority => System,
RE_High_Order_First => System,
RE_Interrupt_Priority => System,
RE_Lib_Stop => System,
RE_Low_Order_First => System,
RE_Max_Interrupt_Priority => System,
RE_Max_Priority => System,
RE_Null_Address => System,
RE_Priority => System,
@ -1818,7 +1736,6 @@ package Rtsfind is
RE_Checked_Pool => System_Checked_Pools,
RE_Boolean_Array => System_Boolean_Array_Operations,
RE_Vector_Not => System_Boolean_Array_Operations,
RE_Vector_And => System_Boolean_Array_Operations,
RE_Vector_Or => System_Boolean_Array_Operations,
@ -1846,6 +1763,8 @@ package Rtsfind is
RE_Compare_Array_U64 => System_Compare_Array_Unsigned_64,
RE_Get_Active_Partition_Id => System_DSA_Services,
RE_Get_Local_Partition_Id => System_DSA_Services,
RE_Get_Passive_Partition_Id => System_DSA_Services,
RE_Register_Exception => System_Exception_Table,
@ -1889,18 +1808,14 @@ package Rtsfind is
RE_Fat_VAX_G => System_Fat_VAX_G_Float,
RE_Attach_To_Final_List => System_Finalization_Implementation,
RE_Finalizable_Ptr_Ptr => System_Finalization_Implementation,
RE_Move_Final_List => System_Finalization_Implementation,
RE_Finalize_List => System_Finalization_Implementation,
RE_Finalize_One => System_Finalization_Implementation,
RE_Global_Final_List => System_Finalization_Implementation,
RE_Record_Controller => System_Finalization_Implementation,
RE_Limited_Record_Controller => System_Finalization_Implementation,
RE_Deep_Tag_Initialize => System_Finalization_Implementation,
RE_Deep_Tag_Adjust => System_Finalization_Implementation,
RE_Deep_Tag_Finalize => System_Finalization_Implementation,
RE_Deep_Tag_Attach => System_Finalization_Implementation,
RE_Deep_Rec_Initialize => System_Finalization_Implementation,
RE_Deep_Rec_Adjust => System_Finalization_Implementation,
RE_Deep_Rec_Finalize => System_Finalization_Implementation,
RE_Root_Controlled => System_Finalization_Root,
RE_Finalizable => System_Finalization_Root,
@ -1948,9 +1863,6 @@ package Rtsfind is
RE_Mantissa_Value => System_Mantissa,
RE_memcpy => System_Memcop,
RE_memmove => System_Memcop,
RE_Bits_03 => System_Pack_03,
RE_Get_03 => System_Pack_03,
RE_Set_03 => System_Pack_03,
@ -2238,13 +2150,9 @@ package Rtsfind is
RE_Unspecified_Size => System_Parameters,
RE_DSA_Implementation => System_Partition_Interface,
RE_Get_Passive_Partition_Id => System_Partition_Interface,
RE_Get_Local_Partition_Id => System_Partition_Interface,
RE_Get_RCI_Package_Receiver => System_Partition_Interface,
RE_Get_Unique_Remote_Pointer => System_Partition_Interface,
RE_RACW_Stub_Type => System_Partition_Interface,
RE_RACW_Stub_Type_Access => System_Partition_Interface,
RE_RAS_Proxy_Type => System_Partition_Interface,
RE_RAS_Proxy_Type_Access => System_Partition_Interface,
RE_Raise_Program_Error_Unknown_Tag => System_Partition_Interface,
RE_Register_Passive_Package => System_Partition_Interface,
@ -2258,7 +2166,6 @@ package Rtsfind is
RE_Get_RAS_Info => System_Partition_Interface,
RE_To_PolyORB_String => System_Partition_Interface,
RE_To_Standard_String => System_Partition_Interface,
RE_Caseless_String_Eq => System_Partition_Interface,
RE_TypeCode => System_Partition_Interface,
RE_Any => System_Partition_Interface,
@ -2275,6 +2182,7 @@ package Rtsfind is
RE_Content_Type => System_Partition_Interface,
RE_Any_Member_Type => System_Partition_Interface,
RE_Get_Nested_Sequence_Length => System_Partition_Interface,
RE_Get_Any_Type => System_Partition_Interface,
RE_Extract_Union_Value => System_Partition_Interface,
RE_NVList_Ref => System_Partition_Interface,
RE_NVList_Create => System_Partition_Interface,
@ -2286,7 +2194,7 @@ package Rtsfind is
RE_Request_Raise_Occurrence => System_Partition_Interface,
RE_Nil_Exc_List => System_Partition_Interface,
RE_Servant => System_Partition_Interface,
RE_Copy_Any_Value => System_Partition_Interface,
RE_Move_Any_Value => System_Partition_Interface,
RE_Set_Result => System_Partition_Interface,
RE_Register_Obj_Receiving_Stub => System_Partition_Interface,
RE_Register_Pkg_Receiving_Stub => System_Partition_Interface,
@ -2298,7 +2206,6 @@ package Rtsfind is
RE_Make_Ref => System_Partition_Interface,
RE_Get_Local_Address => System_Partition_Interface,
RE_Get_Reference => System_Partition_Interface,
RE_Local_Oid_To_Address => System_Partition_Interface,
RE_Asynchronous_P_To_Sync_Scope => System_Partition_Interface,
RE_Buffer_Stream_Type => System_Partition_Interface,
RE_Allocate_Buffer => System_Partition_Interface,
@ -2306,8 +2213,6 @@ package Rtsfind is
RE_BS_To_Any => System_Partition_Interface,
RE_Any_To_BS => System_Partition_Interface,
RE_FA_AD => System_Partition_Interface,
RE_FA_AS => System_Partition_Interface,
RE_FA_B => System_Partition_Interface,
RE_FA_C => System_Partition_Interface,
RE_FA_F => System_Partition_Interface,
@ -2329,8 +2234,7 @@ package Rtsfind is
RE_FA_String => System_Partition_Interface,
RE_FA_ObjRef => System_Partition_Interface,
RE_TA_AD => System_Partition_Interface,
RE_TA_AS => System_Partition_Interface,
RE_TA_A => System_Partition_Interface,
RE_TA_B => System_Partition_Interface,
RE_TA_C => System_Partition_Interface,
RE_TA_F => System_Partition_Interface,
@ -2358,8 +2262,6 @@ package Rtsfind is
RE_Get_TC => System_Partition_Interface,
RE_Set_TC => System_Partition_Interface,
RE_TC_Any => System_Partition_Interface,
RE_TC_AD => System_Partition_Interface,
RE_TC_AS => System_Partition_Interface,
RE_TC_B => System_Partition_Interface,
RE_TC_C => System_Partition_Interface,
RE_TC_F => System_Partition_Interface,
@ -2433,16 +2335,12 @@ package Rtsfind is
RE_Integer_Address => System_Storage_Elements,
RE_Storage_Offset => System_Storage_Elements,
RE_Storage_Array => System_Storage_Elements,
RE_Storage_Element => System_Storage_Elements,
RE_To_Address => System_Storage_Elements,
RE_Root_Storage_Pool => System_Storage_Pools,
RE_Allocate_Any => System_Storage_Pools,
RE_Deallocate_Any => System_Storage_Pools,
RE_Thin_Pointer => System_Stream_Attributes,
RE_Fat_Pointer => System_Stream_Attributes,
RE_I_AD => System_Stream_Attributes,
RE_I_AS => System_Stream_Attributes,
RE_I_B => System_Stream_Attributes,
@ -2484,7 +2382,6 @@ package Rtsfind is
RE_W_U => System_Stream_Attributes,
RE_W_WC => System_Stream_Attributes,
RE_W_WWC => System_Stream_Attributes,
RE_Block_Stream_Ops_OK => System_Stream_Attributes,
RE_Str_Concat => System_String_Ops,
RE_Str_Concat_CC => System_String_Ops,
@ -2500,8 +2397,6 @@ package Rtsfind is
RE_Task_Info_Type => System_Task_Info,
RE_Unspecified_Task_Info => System_Task_Info,
RE_Library_Task_Level => System_Tasking,
RE_Task_Procedure_Access => System_Tasking,
RO_ST_Task_Id => System_Tasking,
@ -2511,22 +2406,15 @@ package Rtsfind is
RE_Simple_Call => System_Tasking,
RE_Conditional_Call => System_Tasking,
RE_Asynchronous_Call => System_Tasking,
RE_Timed_Call => System_Tasking,
RE_Ada_Task_Control_Block => System_Tasking,
RE_Task_List => System_Tasking,
RE_Accept_Alternative => System_Tasking,
RE_Accept_List => System_Tasking,
RE_Accept_List_Access => System_Tasking,
RE_Max_Select => System_Tasking,
RE_Max_Task_Entry => System_Tasking,
RE_No_Rendezvous => System_Tasking,
RE_Null_Task_Entry => System_Tasking,
RE_Positive_Select_Index => System_Tasking,
RE_Select_Index => System_Tasking,
RE_Select_Modes => System_Tasking,
RE_Else_Mode => System_Tasking,
RE_Simple_Mode => System_Tasking,
RE_Terminate_Mode => System_Tasking,
@ -2538,6 +2426,7 @@ package Rtsfind is
RE_Unspecified_Priority => System_Tasking,
RE_Activation_Chain => System_Tasking,
RE_Activation_Chain_Access => System_Tasking,
RE_Storage_Size => System_Tasking,
RE_Abort_Defer => System_Soft_Links,
@ -2691,8 +2580,6 @@ package Rtsfind is
System_Tasking_Protected_Objects_Entries,
RE_Lock_Entries =>
System_Tasking_Protected_Objects_Entries,
RE_Lock_Read_Only_Entries =>
System_Tasking_Protected_Objects_Entries,
RO_PE_Get_Ceiling =>
System_Tasking_Protected_Objects_Entries,
RO_PE_Set_Ceiling =>
@ -2732,8 +2619,6 @@ package Rtsfind is
System_Tasking_Protected_Objects_Single_Entry,
RE_Lock_Entry =>
System_Tasking_Protected_Objects_Single_Entry,
RE_Lock_Read_Only_Entry =>
System_Tasking_Protected_Objects_Single_Entry,
RE_Unlock_Entry =>
System_Tasking_Protected_Objects_Single_Entry,
RE_Protected_Single_Entry_Call =>
@ -2757,7 +2642,6 @@ package Rtsfind is
RE_Initialize_Protection => System_Tasking_Protected_Objects,
RE_Finalize_Protection => System_Tasking_Protected_Objects,
RE_Lock => System_Tasking_Protected_Objects,
RE_Lock_Read_Only => System_Tasking_Protected_Objects,
RE_Get_Ceiling => System_Tasking_Protected_Objects,
RE_Set_Ceiling => System_Tasking_Protected_Objects,
RE_Unlock => System_Tasking_Protected_Objects,
@ -2801,6 +2685,7 @@ package Rtsfind is
RE_Complete_Task => System_Tasking_Stages,
RE_Free_Task => System_Tasking_Stages,
RE_Expunge_Unactivated_Tasks => System_Tasking_Stages,
RE_Move_Activation_Chain => System_Tasking_Stages,
RE_Terminated => System_Tasking_Stages);
--------------------------------
@ -2864,39 +2749,16 @@ package Rtsfind is
-- Subprograms --
-----------------
procedure Initialize;
-- Procedure to initialize data structures used by RTE. Called at the
-- start of processing a new main source file. Must be called after
-- Initialize_Snames (since names it enters into name table must come
-- after names entered by Snames).
RE_Not_Available : exception;
-- Raised by RTE if the requested entity is not available. This can
-- occur either because the file in which the entity should be found
-- does not exist, or because the entity is not present in the file.
function RTE (E : RE_Id) return Entity_Id;
-- Given the entity defined in the above tables, as identified by the
-- corresponding value in the RE_Id enumeration type, returns the Id
-- of the corresponding entity, first loading in (parsing, analyzing and
-- expanding) its spec if the unit has not already been loaded.
--
-- Note: In the case of a package, RTE can return either an entity that
-- is declared at the top level of the package, or the package entity
-- itself. If an entity within the package has the same simple name as
-- the package, then the entity within the package is returned.
--
-- If RTE returns, the returned value is the required entity
--
-- If the entity is not available, then an error message is given. The
-- form of the message depends on whether we are in configurable run time
-- mode or not. In configurable run time mode, a missing entity is not
-- that surprising and merely says that the particular construct is not
-- supported by the run-time in use. If we are not in configurable run
-- time mode, a missing entity is some kind of run-time configuration
-- error. In either case, the result of the call is to raise the exception
-- RE_Not_Available, which should terminate the expansion of the current
-- construct.
procedure Initialize;
-- Procedure to initialize data structures used by RTE. Called at the
-- start of processing a new main source file. Must be called after
-- Initialize_Snames (since names it enters into name table must come
-- after names entered by Snames).
function Is_RTE (Ent : Entity_Id; E : RE_Id) return Boolean;
-- This function determines if the given entity corresponds to the entity
@ -2914,11 +2776,77 @@ package Rtsfind is
-- entity id values are compared and True is returned if Ent is the
-- entity for this unit.
function Is_Text_IO_Kludge_Unit (Nam : Node_Id) return Boolean;
-- Returns True if the given Nam is an Expanded Name, whose Prefix is Ada,
-- and whose selector is either Text_IO.xxx or Wide_Text_IO.xxx or
-- Wide_Wide_Text_IO.xxx, where xxx is one of the subpackages of Text_IO
-- that is specially handled as described above for Text_IO_Kludge.
function RTE (E : RE_Id) return Entity_Id;
-- Given the entity defined in the above tables, as identified by the
-- corresponding value in the RE_Id enumeration type, returns the Id of the
-- corresponding entity, first loading in (parsing, analyzing and
-- expanding) its spec if the unit has not already been loaded. For
-- efficiency reasons, this routine restricts the search to the package
-- entity chain.
--
-- Note: In the case of a package, RTE can return either an entity that is
-- declared at the top level of the package, or the package entity itself.
-- If an entity within the package has the same simple name as the package,
-- then the entity within the package is returned.
--
-- If RTE returns, the returned value is the required entity
--
-- If the entity is not available, then an error message is given. The
-- form of the message depends on whether we are in configurable run time
-- mode or not. In configurable run time mode, a missing entity is not
-- that surprising and merely says that the particular construct is not
-- supported by the run-time in use. If we are not in configurable run
-- time mode, a missing entity is some kind of run-time configuration
-- error. In either case, the result of the call is to raise the exception
-- RE_Not_Available, which should terminate the expansion of the current
-- construct.
function RTE_Available (E : RE_Id) return Boolean;
-- Returns true if a call to RTE will succeed without raising an
-- exception and without generating an error message, i.e. if the
-- call will obtain the desired entity without any problems.
function RTE_Record_Component (E : RE_Id) return Entity_Id;
-- Given the entity defined in the above tables, as identified by the
-- corresponding value in the RE_Id enumeration type, returns the Id of
-- the corresponding entity, first loading in (parsing, analyzing and
-- expanding) its spec if the unit has not already been loaded. For
-- efficiency reasons, this routine restricts the search of E to fields
-- of record type declarations found in the package entity chain.
--
-- Note: In the case of a package, RTE can return either an entity that is
-- declared at the top level of the package, or the package entity itself.
-- If an entity within the package has the same simple name as the package,
-- then the entity within the package is returned.
--
-- If RTE returns, the returned value is the required entity
--
-- If the entity is not available, then an error message is given. The
-- form of the message depends on whether we are in configurable run time
-- mode or not. In configurable run time mode, a missing entity is not
-- that surprising and merely says that the particular construct is not
-- supported by the run-time in use. If we are not in configurable run
-- time mode, a missing entity is some kind of run-time configuration
-- error. In either case, the result of the call is to raise the exception
-- RE_Not_Available, which should terminate the expansion of the current
-- construct.
function RTE_Record_Component_Available (E : RE_Id) return Boolean;
-- Returns true if a call to RTE_Record_Component will succeed without
-- raising an exception and without generating an error message, i.e.
-- if the call will obtain the desired entity without any problems.
function RTU_Entity (U : RTU_Id) return Entity_Id;
pragma Inline (RTU_Entity);
-- This function returns the entity for the unit referenced by U. If
-- this unit has not been loaded, it returns Empty.
function RTU_Loaded (U : RTU_Id) return Boolean;
pragma Inline (RTU_Loaded);
-- Returns true if indicated unit has already been successfully loaded.
@ -2942,10 +2870,4 @@ package Rtsfind is
-- is not necessary, but that doesn't matter. Wide_[Wide_]Text_IO is
-- handled in a similar manner.
function Is_Text_IO_Kludge_Unit (Nam : Node_Id) return Boolean;
-- Returns True if the given Nam is an Expanded Name, whose Prefix is Ada,
-- and whose selector is either Text_IO.xxx or Wide_Text_IO.xxx or
-- Wide_Wide_Text_IO.xxx, where xxx is one of the subpackages of Text_IO
-- that is specially handled as described above for Text_IO_Kludge.
end Rtsfind;

63
gcc/ada/s-intman-posix.adb
View File

@ -78,9 +78,8 @@ package body System.Interrupt_Management is
function State (Int : Interrupt_ID) return Character;
pragma Import (C, State, "__gnat_get_interrupt_state");
-- Get interrupt state. Defined in init.c
-- The input argument is the interrupt number,
-- and the result is one of the following:
-- Get interrupt state. Defined in init.c The input argument is the
-- interrupt number, and the result is one of the following:
User : constant Character := 'u';
Runtime : constant Character := 'r';
@ -95,10 +94,10 @@ package body System.Interrupt_Management is
(signo : Signal;
siginfo : System.Address;
ucontext : System.Address);
-- This function identifies the Ada exception to be raised using
-- the information when the system received a synchronous signal.
-- Since this function is machine and OS dependent, different code
-- has to be provided for different target.
-- This function identifies the Ada exception to be raised using the
-- information when the system received a synchronous signal. Since this
-- function is machine and OS dependent, different code has to be provided
-- for different target.
----------------------
-- Notify_Exception --
@ -114,10 +113,10 @@ package body System.Interrupt_Management is
is
pragma Unreferenced (siginfo);
-- The GCC unwinder requires adjustments to the signal's machine
-- context to be able to properly unwind through the signal handler.
-- This is achieved by the target specific subprogram below, provided
-- by init.c to be usable by the non-tasking handler also.
-- The GCC unwinder requires adjustments to the signal's machine context
-- to be able to properly unwind through the signal handler. This is
-- achieved by the target specific subprogram below, provided by init.c
-- to be usable by the non-tasking handler also.
procedure Adjust_Context_For_Raise
(signo : Signal;
@ -125,7 +124,7 @@ package body System.Interrupt_Management is
pragma Import
(C, Adjust_Context_For_Raise, "__gnat_adjust_context_for_raise");
Result : Interfaces.C.int;
Result : Interfaces.C.int;
begin
-- With the __builtin_longjmp, the signal mask is not restored, so we
@ -139,9 +138,8 @@ package body System.Interrupt_Management is
Adjust_Context_For_Raise (signo, ucontext);
-- Check that treatment of exception propagation here
-- is consistent with treatment of the abort signal in
-- System.Task_Primitives.Operations.
-- Check that treatment of exception propagation here is consistent with
-- treatment of the abort signal in System.Task_Primitives.Operations.
case signo is
when SIGFPE =>
@ -199,18 +197,19 @@ package body System.Interrupt_Management is
-- handler execution we do not change the Signal_Mask to be masked for
-- the Signal.
-- This is a temporary fix to the problem that the Signal_Mask is
-- not restored after the exception (longjmp) from the handler.
-- The right fix should be made in sigsetjmp so that we save
-- the Signal_Set and restore it after a longjmp.
-- This is a temporary fix to the problem that the Signal_Mask is not
-- restored after the exception (longjmp) from the handler. The right
-- fix should be made in sigsetjmp so that we save the Signal_Set and
-- restore it after a longjmp.
-- Since SA_NODEFER is obsolete, instead we reset explicitely
-- the mask in the exception handler.
-- Since SA_NODEFER is obsolete, instead we reset explicitely the mask
-- in the exception handler.
Result := sigemptyset (Signal_Mask'Access);
pragma Assert (Result = 0);
-- Add signals that map to Ada exceptions to the mask.
-- Add signals that map to Ada exceptions to the mask
for J in Exception_Interrupts'Range loop
if State (Exception_Interrupts (J)) /= Default then
Result :=
@ -225,6 +224,7 @@ package body System.Interrupt_Management is
pragma Assert (Reserve = (Interrupt_ID'Range => False));
-- Process state of exception signals
for J in Exception_Interrupts'Range loop
if State (Exception_Interrupts (J)) /= User then
Keep_Unmasked (Exception_Interrupts (J)) := True;
@ -245,16 +245,16 @@ package body System.Interrupt_Management is
Reserve (Abort_Task_Interrupt) := True;
end if;
-- Set SIGINT to unmasked state as long as it is not in "User"
-- state. Check for Unreserve_All_Interrupts last
-- Set SIGINT to unmasked state as long as it is not in "User" state.
-- Check for Unreserve_All_Interrupts last
if State (SIGINT) /= User then
Keep_Unmasked (SIGINT) := True;
Reserve (SIGINT) := True;
end if;
-- Check all signals for state that requires keeping them
-- unmasked and reserved
-- Check all signals for state that requires keeping them unmasked and
-- reserved
for J in Interrupt_ID'Range loop
if State (J) = Default or else State (J) = Runtime then
@ -276,18 +276,17 @@ package body System.Interrupt_Management is
Reserve (Interrupt_ID (Reserved (J))) := True;
end loop;
-- Process pragma Unreserve_All_Interrupts. This overrides any
-- settings due to pragma Interrupt_State:
-- Process pragma Unreserve_All_Interrupts. This overrides any settings
-- due to pragma Interrupt_State:
if Unreserve_All_Interrupts /= 0 then
Keep_Unmasked (SIGINT) := False;
Reserve (SIGINT) := False;
end if;
-- We do not have Signal 0 in reality. We just use this value
-- to identify non-existent signals (see s-intnam.ads). Therefore,
-- Signal 0 should not be used in all signal related operations hence
-- mark it as reserved.
-- We do not really have Signal 0. We just use this value to identify
-- non-existent signals (see s-intnam.ads). Therefore, Signal should not
-- be used in all signal related operations hence mark it as reserved.
Reserve (0) := True;
end Initialize;

2
gcc/ada/sem_ch10.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2006 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --

2
gcc/ada/targtyps.c
View File

@ -6,7 +6,7 @@
* *
* Body *
* *
* Copyright (C) 1992-2004 Free Software Foundation, Inc. *
* Copyright (C) 1992-2006, 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- *

2
gcc/ada/tb-alvxw.c
View File

@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
* Copyright (C) 2000-2005, AdaCore *
* Copyright (C) 2000-2006, 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- *