Skip to content

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

New file. 

Resync.

From-SVN: r123611
parent 8405d93c
Showing with 485 additions and 168 deletions
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. --
......
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;
......
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;
......
gcc/ada/a-diroro.adb deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- 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 --
-- --
-- B o d y --
-- --
-- Copyright (C) 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- --
-- 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, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, 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. --
-- --
------------------------------------------------------------------------------
package body Ada.Dispatching.Round_Robin is
-----------------
-- Set_Quantum --
-----------------
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;
-----------------
-- Set_Quantum --
-----------------
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;
--------------------
-- Actual_Quantum --
--------------------
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;
gcc/ada/a-disedf.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/a-etgrbu.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/a-exetim.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/a-extiti.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- 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;
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 *);
......
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
......
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
......
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
......
gcc/ada/g-io-put-vxworks.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- 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. --
-- --
------------------------------------------------------------------------------
-- vxworks zfp version of Put (C : Character)
with Interfaces.C; use Interfaces.C;
separate (GNAT.IO)
procedure Put (C : Character) is
function ioGlobalStdGet
(File : int) return int;
pragma Import (C, ioGlobalStdGet, "ioGlobalStdGet");
procedure fdprintf
(File : int;
Format : String;
Value : Character);
pragma Import (C, fdprintf, "fdprintf");
Stdout_ID : constant int := 1;
begin
fdprintf (ioGlobalStdGet (Stdout_ID), "%c" & ASCII.NUL, C);
end Put;
gcc/ada/g-io-put.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- 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;
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- *
......
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 --
-------------------------
......
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;
......
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- --
......
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- *
......
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- *
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment