diff options
| -rw-r--r-- | gcc/ada/a-cgcaso.ads | 2 | ||||
| -rw-r--r-- | gcc/ada/a-chtgop.adb | 62 | ||||
| -rw-r--r-- | gcc/ada/a-cohata.ads | 9 | ||||
| -rw-r--r-- | gcc/ada/a-disedf.ads | 50 | ||||
| -rw-r--r-- | gcc/ada/a-etgrbu.ads | 87 | ||||
| -rw-r--r-- | gcc/ada/a-exetim.ads | 84 | ||||
| -rw-r--r-- | gcc/ada/a-extiti.ads | 62 | ||||
| -rw-r--r-- | gcc/ada/adaint.h | 11 | ||||
| -rw-r--r-- | gcc/ada/bindusg.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/exp_aggr.ads | 5 | ||||
| -rw-r--r-- | gcc/ada/exp_tss.ads | 2 | ||||
| -rw-r--r-- | gcc/ada/g-io-put-vxworks.adb (renamed from gcc/ada/a-diroro.adb) | 79 | ||||
| -rw-r--r-- | gcc/ada/g-io-put.adb | 42 | ||||
| -rw-r--r-- | gcc/ada/gigi.h | 2 | ||||
| -rw-r--r-- | gcc/ada/gnatvsn.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/rtsfind.ads | 344 | ||||
| -rw-r--r-- | gcc/ada/s-intman-posix.adb | 63 | ||||
| -rw-r--r-- | gcc/ada/sem_ch10.ads | 2 | ||||
| -rw-r--r-- | gcc/ada/targtyps.c | 2 | ||||
| -rw-r--r-- | gcc/ada/tb-alvxw.c | 2 |
20 files changed, 583 insertions, 344 deletions
diff --git a/gcc/ada/a-cgcaso.ads b/gcc/ada/a-cgcaso.ads index c165032ad4f..6841f934dcf 100644 --- a/gcc/ada/a-cgcaso.ads +++ b/gcc/ada/a-cgcaso.ads @@ -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. -- diff --git a/gcc/ada/a-chtgop.adb b/gcc/ada/a-chtgop.adb index c22be825a48..93f45fa2315 100644 --- a/gcc/ada/a-chtgop.adb +++ b/gcc/ada/a-chtgop.adb @@ -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; diff --git a/gcc/ada/a-cohata.ads b/gcc/ada/a-cohata.ads index d9b07535b75..eac81e096e7 100644 --- a/gcc/ada/a-cohata.ads +++ b/gcc/ada/a-cohata.ads @@ -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; diff --git a/gcc/ada/a-disedf.ads b/gcc/ada/a-disedf.ads new file mode 100644 index 00000000000..f1a5f3c505b --- /dev/null +++ b/gcc/ada/a-disedf.ads @@ -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; diff --git a/gcc/ada/a-etgrbu.ads b/gcc/ada/a-etgrbu.ads new file mode 100644 index 00000000000..1c86cee7925 --- /dev/null +++ b/gcc/ada/a-etgrbu.ads @@ -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; diff --git a/gcc/ada/a-exetim.ads b/gcc/ada/a-exetim.ads new file mode 100644 index 00000000000..c4b45779450 --- /dev/null +++ b/gcc/ada/a-exetim.ads @@ -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; diff --git a/gcc/ada/a-extiti.ads b/gcc/ada/a-extiti.ads new file mode 100644 index 00000000000..f2b62ca9ae6 --- /dev/null +++ b/gcc/ada/a-extiti.ads @@ -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; diff --git a/gcc/ada/adaint.h b/gcc/ada/adaint.h index 3dbc9a44531..6fbb93d9a03 100644 --- a/gcc/ada/adaint.h +++ b/gcc/ada/adaint.h @@ -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 *); diff --git a/gcc/ada/bindusg.adb b/gcc/ada/bindusg.adb index 42779346795..83cfa698084 100644 --- a/gcc/ada/bindusg.adb +++ b/gcc/ada/bindusg.adb @@ -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 diff --git a/gcc/ada/exp_aggr.ads b/gcc/ada/exp_aggr.ads index 664e654a999..65897df5d66 100644 --- a/gcc/ada/exp_aggr.ads +++ b/gcc/ada/exp_aggr.ads @@ -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 diff --git a/gcc/ada/exp_tss.ads b/gcc/ada/exp_tss.ads index 690ff33d99e..3883d3c5bb6 100644 --- a/gcc/ada/exp_tss.ads +++ b/gcc/ada/exp_tss.ads @@ -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 diff --git a/gcc/ada/a-diroro.adb b/gcc/ada/g-io-put-vxworks.adb index 966058e192b..2fb89fd2652 100644 --- a/gcc/ada/a-diroro.adb +++ b/gcc/ada/g-io-put-vxworks.adb @@ -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; diff --git a/gcc/ada/g-io-put.adb b/gcc/ada/g-io-put.adb new file mode 100644 index 00000000000..1f1c319001c --- /dev/null +++ b/gcc/ada/g-io-put.adb @@ -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; diff --git a/gcc/ada/gigi.h b/gcc/ada/gigi.h index b16649fa1a6..b5d812008fd 100644 --- a/gcc/ada/gigi.h +++ b/gcc/ada/gigi.h @@ -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- * diff --git a/gcc/ada/gnatvsn.adb b/gcc/ada/gnatvsn.adb index dc6d706be20..774397548e9 100644 --- a/gcc/ada/gnatvsn.adb +++ b/gcc/ada/gnatvsn.adb @@ -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- -- @@ -41,15 +41,6 @@ package body Gnatvsn is 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 -- ------------------------- diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 065861184fa..81a8f34ead0 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -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,27 +2749,51 @@ package Rtsfind is -- Subprograms -- ----------------- + 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. + 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 Is_RTE (Ent : Entity_Id; E : RE_Id) return Boolean; + -- This function determines if the given entity corresponds to the entity + -- referenced by RE_Id. It is similar in effect to (Ent = RTE (E)) except + -- that the latter would unconditionally load the unit containing E. For + -- this call, if the unit is not loaded, then a result of False is returned + -- immediately, since obviously Ent cannot be the entity in question if the + -- corresponding unit has not been loaded. + + function Is_RTU (Ent : Entity_Id; U : RTU_Id) return Boolean; + pragma Inline (Is_RTU); + -- This function determines if the given entity corresponds to the entity + -- for the unit referenced by U. If this unit has not been loaded, the + -- answer will always be False. If the unit has been loaded, then the + -- 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. + -- 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. + -- 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 -- @@ -2898,27 +2807,46 @@ package Rtsfind is -- RE_Not_Available, which should terminate the expansion of the current -- construct. - function Is_RTE (Ent : Entity_Id; E : RE_Id) return Boolean; - -- This function determines if the given entity corresponds to the entity - -- referenced by RE_Id. It is similar in effect to (Ent = RTE (E)) except - -- that the latter would unconditionally load the unit containing E. For - -- this call, if the unit is not loaded, then a result of False is returned - -- immediately, since obviously Ent cannot be the entity in question if the - -- corresponding unit has not been loaded. - - function Is_RTU (Ent : Entity_Id; U : RTU_Id) return Boolean; - pragma Inline (Is_RTU); - -- This function determines if the given entity corresponds to the entity - -- for the unit referenced by U. If this unit has not been loaded, the - -- answer will always be False. If the unit has been loaded, then the - -- entity id values are compared and True is returned if Ent is the - -- entity for this unit. - 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; diff --git a/gcc/ada/s-intman-posix.adb b/gcc/ada/s-intman-posix.adb index 410589e441a..0c451164076 100644 --- a/gcc/ada/s-intman-posix.adb +++ b/gcc/ada/s-intman-posix.adb @@ -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; diff --git a/gcc/ada/sem_ch10.ads b/gcc/ada/sem_ch10.ads index c7018b45118..563423e4673 100644 --- a/gcc/ada/sem_ch10.ads +++ b/gcc/ada/sem_ch10.ads @@ -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- -- diff --git a/gcc/ada/targtyps.c b/gcc/ada/targtyps.c index 08bca930f5a..c23d9e9a9b1 100644 --- a/gcc/ada/targtyps.c +++ b/gcc/ada/targtyps.c @@ -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- * diff --git a/gcc/ada/tb-alvxw.c b/gcc/ada/tb-alvxw.c index 3c782762b86..52d9e1643f6 100644 --- a/gcc/ada/tb-alvxw.c +++ b/gcc/ada/tb-alvxw.c @@ -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- * |
