Skip to content

R
riscv-gcc-1
Commit d23b8f57 by Richard Kenner
Options

New Language: Ada 

From-SVN: r45953
parent 84481f76
Showing with 4892 additions and 0 deletions
gcc/ada/a-astaco.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . A S Y N C H R O N O U S _ T A S K _ C O N T R O L --
-- --
-- B o d y --
-- --
-- $Revision: 1.4 $ --
-- --
-- Copyright (C) 1992,1993,1994,1995 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This is a dummy body, which will not normally be compiled when used with
-- standard versions of GNAT, which do not support this package. See comments
-- in spec for further details.
package body Ada.Asynchronous_Task_Control is
--------------
-- Continue --
--------------
procedure Continue (T : Ada.Task_Identification.Task_Id) is
begin
null;
end Continue;
----------
-- Hold --
----------
procedure Hold (T : Ada.Task_Identification.Task_Id) is
begin
raise Program_Error;
end Hold;
-------------
-- Is_Held --
-------------
function Is_Held (T : Ada.Task_Identification.Task_Id) return Boolean is
begin
return False;
end Is_Held;
end Ada.Asynchronous_Task_Control;
gcc/ada/a-astaco.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . A S Y N C H R O N O U S _ T A S K _ C O N T R O L --
-- --
-- S p e c --
-- --
-- $Revision: 1.9 $ --
-- --
-- This specification is adapted 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. The RM anticipates this situation (RM D.11(10)),
-- and permits an implementation to leave this unimplemented even if the
-- Real-Time Systems annex is fully supported.
-- 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. The framework for such a body is
-- included in the distributed sources.
with Ada.Task_Identification;
package Ada.Asynchronous_Task_Control is
pragma Unimplemented_Unit;
procedure Hold (T : Ada.Task_Identification.Task_Id);
procedure Continue (T : Ada.Task_Identification.Task_Id);
function Is_Held (T : Ada.Task_Identification.Task_Id) return Boolean;
end Ada.Asynchronous_Task_Control;
gcc/ada/a-caldel.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- A D A . C A L E N D A R . D E L A Y S --
-- --
-- B o d y --
-- --
-- $Revision: 1.37 $
-- --
-- Copyright (C) 1991-2001 Florida State University --
-- --
-- GNARL 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. GNARL 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 GNARL; 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. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. It is --
-- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
-- State University (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with System.OS_Primitives;
-- Used for Delay_Modes
-- Max_Sensible_Delay
with System.Soft_Links;
-- Used for Timed_Delay
package body Ada.Calendar.Delays is
package OSP renames System.OS_Primitives;
package SSL renames System.Soft_Links;
use type SSL.Timed_Delay_Call;
-- Earlier, the following operations were implemented using
-- System.Time_Operations. The idea was to avoid sucking in the tasking
-- packages. This did not work. Logically, we can't have it both ways.
-- There is no way to implement time delays that will have correct task
-- semantics without reference to the tasking run-time system.
-- To achieve this goal, we now use soft links.
-----------------------
-- Local Subprograms --
-----------------------
procedure Timed_Delay_NT (Time : Duration; Mode : Integer);
-- Timed delay procedure used when no tasking is active
---------------
-- Delay_For --
---------------
procedure Delay_For (D : Duration) is
begin
SSL.Timed_Delay.all (Duration'Min (D, OSP.Max_Sensible_Delay),
OSP.Relative);
end Delay_For;
-----------------
-- Delay_Until --
-----------------
procedure Delay_Until (T : Time) is
begin
SSL.Timed_Delay.all (To_Duration (T), OSP.Absolute_Calendar);
end Delay_Until;
--------------------
-- Timed_Delay_NT --
--------------------
procedure Timed_Delay_NT (Time : Duration; Mode : Integer) is
begin
OSP.Timed_Delay (Time, Mode);
end Timed_Delay_NT;
-----------------
-- To_Duration --
-----------------
function To_Duration (T : Time) return Duration is
begin
return Duration (T);
end To_Duration;
begin
-- Set up the Timed_Delay soft link to the non tasking version
-- if it has not been already set.
-- If tasking is present, Timed_Delay has already set this soft
-- link, or this will be overriden during the elaboration of
-- System.Tasking.Initialization
if SSL.Timed_Delay = null then
SSL.Timed_Delay := Timed_Delay_NT'Access;
end if;
end Ada.Calendar.Delays;
gcc/ada/a-caldel.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- A D A . C A L E N D A R . D E L A Y S --
-- --
-- S p e c --
-- --
-- $Revision: 1.16 $ --
-- --
-- Copyright (C) 1992-1998, Free Software Foundation, Inc. --
-- --
-- GNARL 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. GNARL 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 GNARL; 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. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. It is --
-- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
-- State University (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This package implements Calendar.Time delays using protected objects.
-- Note: the compiler generates direct calls to this interface, in the
-- processing of time types.
package Ada.Calendar.Delays is
procedure Delay_For (D : Duration);
-- Delay until an interval of length (at least) D seconds has passed,
-- or the task is aborted to at least the current ATC nesting level.
-- This is an abort completion point.
-- The body of this procedure must perform all the processing
-- required for an abortion point.
procedure Delay_Until (T : Time);
-- Delay until Clock has reached (at least) time T,
-- or the task is aborted to at least the current ATC nesting level.
-- The body of this procedure must perform all the processing
-- required for an abortion point.
function To_Duration (T : Time) return Duration;
end Ada.Calendar.Delays;
gcc/ada/a-calend.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . C A L E N D A R --
-- --
-- S p e c --
-- --
-- $Revision: 1.11 $ --
-- --
-- Copyright (C) 1992-1997 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. --
-- --
-- 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
package Ada.Calendar is
type Time is private;
-- Declarations representing limits of allowed local time values. Note that
-- these do NOT constrain the possible stored values of time which may well
-- permit a larger range of times (this is explicitly allowed in Ada 95).
subtype Year_Number is Integer range 1901 .. 2099;
subtype Month_Number is Integer range 1 .. 12;
subtype Day_Number is Integer range 1 .. 31;
subtype Day_Duration is Duration range 0.0 .. 86_400.0;
function Clock return Time;
function Year (Date : Time) return Year_Number;
function Month (Date : Time) return Month_Number;
function Day (Date : Time) return Day_Number;
function Seconds (Date : Time) return Day_Duration;
procedure Split
(Date : Time;
Year : out Year_Number;
Month : out Month_Number;
Day : out Day_Number;
Seconds : out Day_Duration);
function Time_Of
(Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Seconds : Day_Duration := 0.0)
return Time;
function "+" (Left : Time; Right : Duration) return Time;
function "+" (Left : Duration; Right : Time) return Time;
function "-" (Left : Time; Right : Duration) return Time;
function "-" (Left : Time; Right : Time) return Duration;
function "<" (Left, Right : Time) return Boolean;
function "<=" (Left, Right : Time) return Boolean;
function ">" (Left, Right : Time) return Boolean;
function ">=" (Left, Right : Time) return Boolean;
Time_Error : exception;
private
pragma Inline (Clock);
pragma Inline (Year);
pragma Inline (Month);
pragma Inline (Day);
pragma Inline ("+");
pragma Inline ("-");
pragma Inline ("<");
pragma Inline ("<=");
pragma Inline (">");
pragma Inline (">=");
-- Time is represented as a signed duration from the base point which is
-- what Unix calls the EPOCH (i.e. 12 midnight (24:00:00), Dec 31st, 1969,
-- or if you prefer 0:00:00 on Jan 1st, 1970). Since Ada allows dates
-- before this EPOCH value, the stored duration value may be negative.
-- The time value stored is typically a GMT value, as provided in standard
-- Unix environments. If this is the case then Split and Time_Of perform
-- required conversions to and from local times. The range of times that
-- can be stored in Time values depends on the declaration of the type
-- Duration, which must at least cover the required Ada range represented
-- by the declaration of Year_Number, but may be larger (we take full
-- advantage of the new permission in Ada 95 to store time values outside
-- the range that would be acceptable to Split). The Duration type is a
-- real value representing a time interval in seconds.
type Time is new Duration;
end Ada.Calendar;
gcc/ada/a-chahan.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . C H A R A C T E R S . H A N D L I N G --
-- --
-- S p e c --
-- --
-- $Revision: 1.6 $ --
-- --
-- Copyright (C) 1992-1997 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. --
-- --
-- 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
package Ada.Characters.Handling is
pragma Preelaborate (Handling);
----------------------------------------
-- Character Classification Functions --
----------------------------------------
function Is_Control (Item : in Character) return Boolean;
function Is_Graphic (Item : in Character) return Boolean;
function Is_Letter (Item : in Character) return Boolean;
function Is_Lower (Item : in Character) return Boolean;
function Is_Upper (Item : in Character) return Boolean;
function Is_Basic (Item : in Character) return Boolean;
function Is_Digit (Item : in Character) return Boolean;
function Is_Decimal_Digit (Item : in Character) return Boolean
renames Is_Digit;
function Is_Hexadecimal_Digit (Item : in Character) return Boolean;
function Is_Alphanumeric (Item : in Character) return Boolean;
function Is_Special (Item : in Character) return Boolean;
---------------------------------------------------
-- Conversion Functions for Character and String --
---------------------------------------------------
function To_Lower (Item : in Character) return Character;
function To_Upper (Item : in Character) return Character;
function To_Basic (Item : in Character) return Character;
function To_Lower (Item : in String) return String;
function To_Upper (Item : in String) return String;
function To_Basic (Item : in String) return String;
----------------------------------------------------------------------
-- Classifications of and Conversions Between Character and ISO 646 --
----------------------------------------------------------------------
subtype ISO_646 is
Character range Character'Val (0) .. Character'Val (127);
function Is_ISO_646 (Item : in Character) return Boolean;
function Is_ISO_646 (Item : in String) return Boolean;
function To_ISO_646
(Item : in Character;
Substitute : in ISO_646 := ' ')
return ISO_646;
function To_ISO_646
(Item : in String;
Substitute : in ISO_646 := ' ')
return String;
------------------------------------------------------
-- Classifications of Wide_Character and Characters --
------------------------------------------------------
function Is_Character (Item : in Wide_Character) return Boolean;
function Is_String (Item : in Wide_String) return Boolean;
------------------------------------------------------
-- Conversions between Wide_Character and Character --
------------------------------------------------------
function To_Character
(Item : in Wide_Character;
Substitute : in Character := ' ')
return Character;
function To_String
(Item : in Wide_String;
Substitute : in Character := ' ')
return String;
function To_Wide_Character (Item : in Character) return Wide_Character;
function To_Wide_String (Item : in String) return Wide_String;
private
pragma Inline (Is_Control);
pragma Inline (Is_Graphic);
pragma Inline (Is_Letter);
pragma Inline (Is_Lower);
pragma Inline (Is_Upper);
pragma Inline (Is_Basic);
pragma Inline (Is_Digit);
pragma Inline (Is_Hexadecimal_Digit);
pragma Inline (Is_Alphanumeric);
pragma Inline (Is_Special);
pragma Inline (To_Lower);
pragma Inline (To_Upper);
pragma Inline (To_Basic);
pragma Inline (Is_ISO_646);
pragma Inline (Is_Character);
pragma Inline (To_Character);
pragma Inline (To_Wide_Character);
end Ada.Characters.Handling;
gcc/ada/a-charac.ads 0 → 100644
-----------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . C H A R A C T E R S --
-- --
-- S p e c --
-- --
-- $Revision: 1.3 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
package Ada.Characters is
pragma Pure (Characters);
end Ada.Characters;
gcc/ada/a-colien.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . C O M M A N D _ L I N E . E N V I R O N M E N T --
-- --
-- B o d y --
-- --
-- $Revision: 1.2 $ --
-- --
-- Copyright (C) 1996-2001 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with System;
package body Ada.Command_Line.Environment is
-----------------------
-- Environment_Count --
-----------------------
function Environment_Count return Natural is
function Env_Count return Natural;
pragma Import (C, Env_Count, "__gnat_env_count");
begin
return Env_Count;
end Environment_Count;
-----------------------
-- Environment_Value --
-----------------------
function Environment_Value (Number : in Positive) return String is
procedure Fill_Env (E : System.Address; Env_Num : Integer);
pragma Import (C, Fill_Env, "__gnat_fill_env");
function Len_Env (Env_Num : Integer) return Integer;
pragma Import (C, Len_Env, "__gnat_len_env");
begin
if Number > Environment_Count then
raise Constraint_Error;
end if;
declare
Env : aliased String (1 .. Len_Env (Number - 1));
begin
Fill_Env (Env'Address, Number - 1);
return Env;
end;
end Environment_Value;
end Ada.Command_Line.Environment;
gcc/ada/a-colien.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . C O M M A N D _ L I N E . E N V I R O N M E N T --
-- --
-- S p e c --
-- --
-- $Revision: 1.2 $ --
-- --
-- Copyright (C) 1996-2001 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
package Ada.Command_Line.Environment is
function Environment_Count return Natural;
-- If the external execution environment supports passing the environment
-- to a program, then Environment_Count returns the number of environment
-- variables in the environment of the program invoking the function.
-- Otherwise it returns 0. And that's a lot of environment.
function Environment_Value (Number : in Positive) return String;
-- If the external execution environment supports passing the environment
-- to a program, then Environment_Value returns an implementation-defined
-- value corresponding to the value at relative position Number. If Number
-- is outside the range 1 .. Environment_Count, then Constraint_Error is
-- propagated.
--
-- in GNAT: Corresponds to envp [n-1] (for n > 0) in C.
end Ada.Command_Line.Environment;
gcc/ada/a-colire.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . C O M M A N D _ L I N E . R E M O V E --
-- --
-- B o d y --
-- --
-- $Revision: 1.1 $
-- --
-- Copyright (C) 1999 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
package body Ada.Command_Line.Remove is
-----------------------
-- Local Subprograms --
-----------------------
procedure Initialize;
-- Initialize the Remove_Count and Remove_Args variables.
----------------
-- Initialize --
----------------
procedure Initialize is
begin
if Remove_Args = null then
Remove_Count := Argument_Count;
Remove_Args := new Arg_Nums (1 .. Argument_Count);
for J in Remove_Args'Range loop
Remove_Args (J) := J;
end loop;
end if;
end Initialize;
---------------------
-- Remove_Argument --
---------------------
procedure Remove_Argument (Number : in Positive) is
begin
Initialize;
if Number > Remove_Count then
raise Constraint_Error;
end if;
Remove_Count := Remove_Count - 1;
for J in Number .. Remove_Count loop
Remove_Args (J) := Remove_Args (J + 1);
end loop;
end Remove_Argument;
procedure Remove_Argument (Argument : String) is
begin
for J in reverse 1 .. Argument_Count loop
if Argument = Ada.Command_Line.Argument (J) then
Remove_Argument (J);
end if;
end loop;
end Remove_Argument;
----------------------
-- Remove_Arguments --
----------------------
procedure Remove_Arguments (From : Positive; To : Natural) is
begin
Initialize;
if From > Remove_Count
or else To > Remove_Count
then
raise Constraint_Error;
end if;
if To >= From then
Remove_Count := Remove_Count - (To - From + 1);
for J in From .. Remove_Count loop
Remove_Args (J) := Remove_Args (J + (To - From + 1));
end loop;
end if;
end Remove_Arguments;
procedure Remove_Arguments (Argument_Prefix : String) is
begin
for J in reverse 1 .. Argument_Count loop
declare
Arg : constant String := Argument (J);
begin
if Arg'Length >= Argument_Prefix'Length
and then Arg (1 .. Argument_Prefix'Length) = Argument_Prefix
then
Remove_Argument (J);
end if;
end;
end loop;
end Remove_Arguments;
end Ada.Command_Line.Remove;
gcc/ada/a-colire.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . C O M M A N D _ L I N E . R E M O V E --
-- --
-- S p e c --
-- --
-- $Revision: 1.1 $
-- --
-- Copyright (C) 1999 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This package is intended to be used in conjunction with its parent unit,
-- Ada.Command_Line. It provides facilities for logically removing arguments
-- from the command line, so that subsequent calls to Argument_Count and
-- Argument will reflect the removals.
-- For example, if the original command line has three arguments A B C, so
-- that Argument_Count is initially three, then after removing B, the second
-- argument, Argument_Count will be 2, and Argument (2) will return C.
package Ada.Command_Line.Remove is
pragma Preelaborate (Remove);
procedure Remove_Argument (Number : in Positive);
-- Removes the argument identified by Number, which must be in the
-- range 1 .. Argument_Count (i.e. an in range argument number which
-- reflects removals). If Number is out of range Constraint_Error
-- will be raised.
--
-- Note: the numbering of arguments greater than Number is affected
-- by the call. If you need a loop through the arguments, removing
-- some as you go, run the loop in reverse to avoid confusion from
-- this renumbering:
--
-- for J in reverse 1 .. Argument_Count loop
-- if Should_Remove (Arguments (J)) then
-- Remove_Argument (J);
-- end if;
-- end loop;
--
-- Reversing the loop in this manner avoids the confusion.
procedure Remove_Arguments (From : Positive; To : Natural);
-- Removes arguments in the given From..To range. From must be in the
-- range 1 .. Argument_Count and To in the range 0 .. Argument_Count.
-- Constraint_Error is raised if either argument is out of range. If
-- To is less than From, then the call has no effect.
procedure Remove_Argument (Argument : String);
-- Removes the argument which matches the given string Argument. Has
-- no effect if no argument matches the string. If more than one
-- argument matches the string, all are removed.
procedure Remove_Arguments (Argument_Prefix : String);
-- Removes all arguments whose prefix matches Argument_Prefix. Has
-- no effect if no argument matches the string. For example a call
-- to Remove_Arguments ("--") removes all arguments starting with --.
end Ada.Command_Line.Remove;
gcc/ada/a-comlin.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . C O M M A N D _ L I N E --
-- --
-- B o d y --
-- --
-- $Revision: 1.12 $
-- --
-- Copyright (C) 1992-2001 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with System;
package body Ada.Command_Line is
function Arg_Count return Natural;
pragma Import (C, Arg_Count, "__gnat_arg_count");
procedure Fill_Arg (A : System.Address; Arg_Num : Integer);
pragma Import (C, Fill_Arg, "__gnat_fill_arg");
function Len_Arg (Arg_Num : Integer) return Integer;
pragma Import (C, Len_Arg, "__gnat_len_arg");
--------------
-- Argument --
--------------
function Argument (Number : in Positive) return String is
Num : Positive;
begin
if Number > Argument_Count then
raise Constraint_Error;
end if;
if Remove_Args = null then
Num := Number;
else
Num := Remove_Args (Number);
end if;
declare
Arg : aliased String (1 .. Len_Arg (Num));
begin
Fill_Arg (Arg'Address, Num);
return Arg;
end;
end Argument;
--------------------
-- Argument_Count --
--------------------
function Argument_Count return Natural is
begin
if Remove_Args = null then
return Arg_Count - 1;
else
return Remove_Count;
end if;
end Argument_Count;
------------------
-- Command_Name --
------------------
function Command_Name return String is
Arg : aliased String (1 .. Len_Arg (0));
begin
Fill_Arg (Arg'Address, 0);
return Arg;
end Command_Name;
end Ada.Command_Line;
gcc/ada/a-comlin.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . C O M M A N D _ L I N E --
-- --
-- S p e c --
-- --
-- $Revision: 1.12 $
-- --
-- Copyright (C) 1992-2001 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. --
-- --
-- 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
package Ada.Command_Line is
pragma Preelaborate (Command_Line);
function Argument_Count return Natural;
-- If the external execution environment supports passing arguments to a
-- program, then Argument_Count returns the number of arguments passed to
-- the program invoking the function. Otherwise it return 0.
--
-- In GNAT: Corresponds to (argc - 1) in C.
function Argument (Number : Positive) return String;
-- If the external execution environment supports passing arguments to
-- a program, then Argument returns an implementation-defined value
-- corresponding to the argument at relative position Number. If Number
-- is outside the range 1 .. Argument_Count, then Constraint_Error is
-- propagated.
--
-- in GNAT: Corresponds to argv [n] (for n > 0) in C.
function Command_Name return String;
-- If the external execution environment supports passing arguments to
-- a program, then Command_Name returns an implementation-defined value
-- corresponding to the name of the command invoking the program.
-- Otherwise Command_Name returns the null string.
--
-- in GNAT: Corresponds to argv [0] in C.
type Exit_Status is new Integer;
Success : constant Exit_Status;
Failure : constant Exit_Status;
procedure Set_Exit_Status (Code : Exit_Status);
private
Success : constant Exit_Status := 0;
Failure : constant Exit_Status := 1;
-- The following locations support the operation of the package
-- Ada.Command_Line_Remove, whih provides facilities for logically
-- removing arguments from the command line. If one of the remove
-- procedures is called in this unit, then Remove_Args/Remove_Count
-- are set to indicate which arguments are removed. If no such calls
-- have been made, then Remove_Args is null.
Remove_Count : Natural;
-- Number of arguments reflecting removals. Not defined unless
-- Remove_Args is non-null.
type Arg_Nums is array (Positive range <>) of Positive;
type Arg_Nums_Ptr is access Arg_Nums;
-- An array that maps logical argument numbers (reflecting removal)
-- to physical argument numbers (e.g. if the first argument has been
-- removed, but not the second, then Arg_Nums (1) will be set to 2.
Remove_Args : Arg_Nums_Ptr := null;
-- Left set to null if no remove calls have been made, otherwise set
-- to point to an appropriate mapping array. Only the first Remove_Count
-- elements are relevant.
pragma Import (C, Set_Exit_Status, "__gnat_set_exit_status");
end Ada.Command_Line;
gcc/ada/a-decima.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . D E C I M A L --
-- --
-- B o d y --
-- --
-- $Revision: 1.4 $ --
-- --
-- Copyright (C) 1992,1993,1994 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
package body Ada.Decimal is
------------
-- Divide --
------------
procedure Divide
(Dividend : in Dividend_Type;
Divisor : in Divisor_Type;
Quotient : out Quotient_Type;
Remainder : out Remainder_Type)
is
-- We have a nested procedure that is the actual intrinsic divide.
-- This is required because in the current RM, Divide itself does
-- not have convention Intrinsic.
procedure Divide
(Dividend : in Dividend_Type;
Divisor : in Divisor_Type;
Quotient : out Quotient_Type;
Remainder : out Remainder_Type);
pragma Import (Intrinsic, Divide);
begin
Divide (Dividend, Divisor, Quotient, Remainder);
end Divide;
end Ada.Decimal;
gcc/ada/a-decima.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . D E C I M A L --
-- --
-- S p e c --
-- --
-- $Revision: 1.9 $ --
-- --
-- Copyright (C) 1992-1997 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. --
-- --
-- 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
package Ada.Decimal is
pragma Pure (Decimal);
-- The compiler makes a number of assumptions based on the following five
-- constants (e.g. there is an assumption that decimal values can always
-- be represented in 64-bit signed binary form), so code modifications are
-- required to increase these constants.
Max_Scale : constant := +18;
Min_Scale : constant := -18;
Min_Delta : constant := 1.0E-18;
Max_Delta : constant := 1.0E+18;
Max_Decimal_Digits : constant := 18;
generic
type Dividend_Type is delta <> digits <>;
type Divisor_Type is delta <> digits <>;
type Quotient_Type is delta <> digits <>;
type Remainder_Type is delta <> digits <>;
procedure Divide
(Dividend : in Dividend_Type;
Divisor : in Divisor_Type;
Quotient : out Quotient_Type;
Remainder : out Remainder_Type);
private
pragma Inline (Divide);
end Ada.Decimal;
gcc/ada/a-diocst.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . D I R E C T _ I O . C _ S T R E A M S --
-- --
-- B o d y --
-- --
-- $Revision: 1.4 $ --
-- --
-- Copyright (C) 1992-1998 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Interfaces.C_Streams; use Interfaces.C_Streams;
with System.File_IO;
with System.File_Control_Block;
with System.Direct_IO;
with Unchecked_Conversion;
package body Ada.Direct_IO.C_Streams is
package FIO renames System.File_IO;
package FCB renames System.File_Control_Block;
package DIO renames System.Direct_IO;
subtype AP is FCB.AFCB_Ptr;
function To_FCB is new Unchecked_Conversion (File_Mode, FCB.File_Mode);
--------------
-- C_Stream --
--------------
function C_Stream (F : File_Type) return FILEs is
begin
FIO.Check_File_Open (AP (F));
return F.Stream;
end C_Stream;
----------
-- Open --
----------
procedure Open
(File : in out File_Type;
Mode : in File_Mode;
C_Stream : in FILEs;
Form : in String := "")
is
File_Control_Block : DIO.Direct_AFCB;
begin
FIO.Open (File_Ptr => AP (File),
Dummy_FCB => File_Control_Block,
Mode => To_FCB (Mode),
Name => "",
Form => Form,
Amethod => 'D',
Creat => False,
Text => False,
C_Stream => C_Stream);
File.Bytes := Bytes;
end Open;
end Ada.Direct_IO.C_Streams;
gcc/ada/a-diocst.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . D I R E C T _ I O . C _ S T R E A M S --
-- --
-- S p e c --
-- --
-- $Revision: 1.2 $ --
-- --
-- Copyright (C) 1992,1993,1994,1995 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This package provides an interface between Ada.Direct_IO and the
-- C streams. This allows sharing of a stream between Ada and C or C++,
-- as well as allowing the Ada program to operate directly on the stream.
with Interfaces.C_Streams;
generic
package Ada.Direct_IO.C_Streams is
package ICS renames Interfaces.C_Streams;
function C_Stream (F : File_Type) return ICS.FILEs;
-- Obtain stream from existing open file
procedure Open
(File : in out File_Type;
Mode : in File_Mode;
C_Stream : in ICS.FILEs;
Form : in String := "");
-- Create new file from existing stream
end Ada.Direct_IO.C_Streams;
gcc/ada/a-direio.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . D I R E C T _ I O --
-- --
-- B o d y --
-- --
-- $Revision: 1.22 $ --
-- --
-- Copyright (C) 1992-1998 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This is the generic template for Direct_IO, i.e. the code that gets
-- duplicated. We absolutely minimize this code by either calling routines
-- in System.File_IO (for common file functions), or in System.Direct_IO
-- (for specialized Direct_IO functions)
with Interfaces.C_Streams; use Interfaces.C_Streams;
with System; use System;
with System.File_Control_Block;
with System.File_IO;
with System.Direct_IO;
with System.Storage_Elements;
with Unchecked_Conversion;
use type System.Direct_IO.Count;
package body Ada.Direct_IO is
Zeroes : System.Storage_Elements.Storage_Array :=
(1 .. System.Storage_Elements.Storage_Offset (Bytes) => 0);
-- Buffer used to fill out partial records.
package FCB renames System.File_Control_Block;
package FIO renames System.File_IO;
package DIO renames System.Direct_IO;
SU : constant := System.Storage_Unit;
subtype AP is FCB.AFCB_Ptr;
subtype FP is DIO.File_Type;
subtype DCount is DIO.Count;
subtype DPCount is DIO.Positive_Count;
function To_FCB is new Unchecked_Conversion (File_Mode, FCB.File_Mode);
function To_DIO is new Unchecked_Conversion (FCB.File_Mode, File_Mode);
-----------
-- Close --
-----------
procedure Close (File : in out File_Type) is
begin
FIO.Close (AP (File));
end Close;
------------
-- Create --
------------
procedure Create
(File : in out File_Type;
Mode : in File_Mode := Inout_File;
Name : in String := "";
Form : in String := "")
is
begin
DIO.Create (FP (File), To_FCB (Mode), Name, Form);
File.Bytes := Bytes;
end Create;
------------
-- Delete --
------------
procedure Delete (File : in out File_Type) is
begin
FIO.Delete (AP (File));
end Delete;
-----------------
-- End_Of_File --
-----------------
function End_Of_File (File : in File_Type) return Boolean is
begin
return DIO.End_Of_File (FP (File));
end End_Of_File;
----------
-- Form --
----------
function Form (File : in File_Type) return String is
begin
return FIO.Form (AP (File));
end Form;
-----------
-- Index --
-----------
function Index (File : in File_Type) return Positive_Count is
begin
return Positive_Count (DIO.Index (FP (File)));
end Index;
-------------
-- Is_Open --
-------------
function Is_Open (File : in File_Type) return Boolean is
begin
return FIO.Is_Open (AP (File));
end Is_Open;
----------
-- Mode --
----------
function Mode (File : in File_Type) return File_Mode is
begin
return To_DIO (FIO.Mode (AP (File)));
end Mode;
----------
-- Name --
----------
function Name (File : in File_Type) return String is
begin
return FIO.Name (AP (File));
end Name;
----------
-- Open --
----------
procedure Open
(File : in out File_Type;
Mode : in File_Mode;
Name : in String;
Form : in String := "")
is
begin
DIO.Open (FP (File), To_FCB (Mode), Name, Form);
File.Bytes := Bytes;
end Open;
----------
-- Read --
----------
procedure Read
(File : in File_Type;
Item : out Element_Type;
From : in Positive_Count)
is
begin
-- For a non-constrained variant record type, we read into an
-- intermediate buffer, since we may have the case of discriminated
-- records where a discriminant check is required, and we may need
-- to assign only part of the record buffer originally written
if not Element_Type'Constrained then
declare
Buf : Element_Type;
begin
DIO.Read (FP (File), Buf'Address, Bytes, DPCount (From));
Item := Buf;
end;
-- In the normal case, we can read straight into the buffer
else
DIO.Read (FP (File), Item'Address, Bytes, DPCount (From));
end if;
end Read;
procedure Read (File : in File_Type; Item : out Element_Type) is
begin
-- Same processing for unconstrained case as above
if not Element_Type'Constrained then
declare
Buf : Element_Type;
begin
DIO.Read (FP (File), Buf'Address, Bytes);
Item := Buf;
end;
else
DIO.Read (FP (File), Item'Address, Bytes);
end if;
end Read;
-----------
-- Reset --
-----------
procedure Reset (File : in out File_Type; Mode : in File_Mode) is
begin
DIO.Reset (FP (File), To_FCB (Mode));
end Reset;
procedure Reset (File : in out File_Type) is
begin
DIO.Reset (FP (File));
end Reset;
---------------
-- Set_Index --
---------------
procedure Set_Index (File : in File_Type; To : in Positive_Count) is
begin
DIO.Set_Index (FP (File), DPCount (To));
end Set_Index;
----------
-- Size --
----------
function Size (File : in File_Type) return Count is
begin
return Count (DIO.Size (FP (File)));
end Size;
-----------
-- Write --
-----------
procedure Write
(File : in File_Type;
Item : in Element_Type;
To : in Positive_Count)
is
begin
DIO.Set_Index (FP (File), DPCount (To));
DIO.Write (FP (File), Item'Address, Item'Size / SU, Zeroes);
end Write;
procedure Write (File : in File_Type; Item : in Element_Type) is
begin
DIO.Write (FP (File), Item'Address, Item'Size / SU, Zeroes);
end Write;
end Ada.Direct_IO;
gcc/ada/a-direio.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . D I R E C T _ I O --
-- --
-- S p e c --
-- --
-- $Revision: 1.19 $
-- --
-- Copyright (C) 1992-1999 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. --
-- --
-- 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Ada.IO_Exceptions;
with System.Direct_IO;
with Interfaces.C_Streams;
generic
type Element_Type is private;
package Ada.Direct_IO is
type File_Type is limited private;
type File_Mode is (In_File, Inout_File, Out_File);
-- The following representation clause allows the use of unchecked
-- conversion for rapid translation between the File_Mode type
-- used in this package and System.File_IO.
for File_Mode use
(In_File => 0, -- System.File_IO.File_Mode'Pos (In_File)
Inout_File => 1, -- System.File_IO.File_Mode'Pos (Inout_File);
Out_File => 2); -- System.File_IO.File_Mode'Pos (Out_File)
type Count is range 0 .. System.Direct_IO.Count'Last;
subtype Positive_Count is Count range 1 .. Count'Last;
---------------------
-- File Management --
---------------------
procedure Create
(File : in out File_Type;
Mode : in File_Mode := Inout_File;
Name : in String := "";
Form : in String := "");
procedure Open
(File : in out File_Type;
Mode : in File_Mode;
Name : in String;
Form : in String := "");
procedure Close (File : in out File_Type);
procedure Delete (File : in out File_Type);
procedure Reset (File : in out File_Type; Mode : in File_Mode);
procedure Reset (File : in out File_Type);
function Mode (File : in File_Type) return File_Mode;
function Name (File : in File_Type) return String;
function Form (File : in File_Type) return String;
function Is_Open (File : in File_Type) return Boolean;
---------------------------------
-- Input and Output Operations --
---------------------------------
procedure Read
(File : in File_Type;
Item : out Element_Type;
From : in Positive_Count);
procedure Read
(File : in File_Type;
Item : out Element_Type);
procedure Write
(File : in File_Type;
Item : in Element_Type;
To : in Positive_Count);
procedure Write
(File : in File_Type;
Item : in Element_Type);
procedure Set_Index (File : in File_Type; To : in Positive_Count);
function Index (File : in File_Type) return Positive_Count;
function Size (File : in File_Type) return Count;
function End_Of_File (File : in File_Type) return Boolean;
----------------
-- Exceptions --
----------------
Status_Error : exception renames IO_Exceptions.Status_Error;
Mode_Error : exception renames IO_Exceptions.Mode_Error;
Name_Error : exception renames IO_Exceptions.Name_Error;
Use_Error : exception renames IO_Exceptions.Use_Error;
Device_Error : exception renames IO_Exceptions.Device_Error;
End_Error : exception renames IO_Exceptions.End_Error;
Data_Error : exception renames IO_Exceptions.Data_Error;
private
type File_Type is new System.Direct_IO.File_Type;
Bytes : constant Interfaces.C_Streams.size_t :=
Element_Type'Max_Size_In_Storage_Elements;
-- Size of an element in storage units
pragma Inline (Close);
pragma Inline (Create);
pragma Inline (Delete);
pragma Inline (End_Of_File);
pragma Inline (Form);
pragma Inline (Index);
pragma Inline (Is_Open);
pragma Inline (Mode);
pragma Inline (Name);
pragma Inline (Open);
pragma Inline (Read);
pragma Inline (Reset);
pragma Inline (Set_Index);
pragma Inline (Size);
pragma Inline (Write);
end Ada.Direct_IO;
gcc/ada/a-dynpri.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- A D A . D Y N A M I C _ P R I O R I T I E S --
-- --
-- B o d y --
-- --
-- $Revision: 1.25 $
-- --
-- Copyright (C) 1991-2001 Florida State University --
-- --
-- GNARL 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. GNARL 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 GNARL; 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. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. It is --
-- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
-- State University (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Ada.Task_Identification;
-- used for Task_Id
-- Current_Task
-- Null_Task_Id
-- Is_Terminated
with System.Task_Primitives.Operations;
-- used for Write_Lock
-- Unlock
-- Set_Priority
-- Wakeup
-- Self
with System.Tasking;
-- used for Task_ID
with Ada.Exceptions;
-- used for Raise_Exception
with System.Tasking.Initialization;
-- used for Defer/Undefer_Abort
with Unchecked_Conversion;
package body Ada.Dynamic_Priorities is
use System.Tasking;
use Ada.Exceptions;
function Convert_Ids is new
Unchecked_Conversion
(Task_Identification.Task_Id, System.Tasking.Task_ID);
------------------
-- Get_Priority --
------------------
-- Inquire base priority of a task
function Get_Priority
(T : Ada.Task_Identification.Task_Id :=
Ada.Task_Identification.Current_Task)
return System.Any_Priority is
Target : constant Task_ID := Convert_Ids (T);
Error_Message : constant String := "Trying to get the priority of a ";
begin
if Target = Convert_Ids (Ada.Task_Identification.Null_Task_Id) then
Raise_Exception (Program_Error'Identity,
Error_Message & "null task");
end if;
if Task_Identification.Is_Terminated (T) then
Raise_Exception (Tasking_Error'Identity,
Error_Message & "null task");
end if;
return Target.Common.Base_Priority;
end Get_Priority;
------------------
-- Set_Priority --
------------------
-- Change base priority of a task dynamically
procedure Set_Priority
(Priority : System.Any_Priority;
T : Ada.Task_Identification.Task_Id :=
Ada.Task_Identification.Current_Task)
is
Target : constant Task_ID := Convert_Ids (T);
Self_ID : constant Task_ID := System.Task_Primitives.Operations.Self;
Error_Message : constant String := "Trying to set the priority of a ";
begin
if Target = Convert_Ids (Ada.Task_Identification.Null_Task_Id) then
Raise_Exception (Program_Error'Identity,
Error_Message & "null task");
end if;
if Task_Identification.Is_Terminated (T) then
Raise_Exception (Tasking_Error'Identity,
Error_Message & "terminated task");
end if;
System.Tasking.Initialization.Defer_Abort (Self_ID);
System.Task_Primitives.Operations.Write_Lock (Target);
if Self_ID = Target then
Target.Common.Base_Priority := Priority;
System.Task_Primitives.Operations.Set_Priority (Target, Priority);
System.Task_Primitives.Operations.Unlock (Target);
System.Task_Primitives.Operations.Yield;
-- Yield is needed to enforce FIFO task dispatching.
-- LL Set_Priority is made while holding the RTS lock so that
-- it is inheriting high priority until it release all the RTS
-- locks.
-- If this is used in a system where Ceiling Locking is
-- not enforced we may end up getting two Yield effects.
else
Target.New_Base_Priority := Priority;
Target.Pending_Priority_Change := True;
Target.Pending_Action := True;
System.Task_Primitives.Operations.Wakeup
(Target, Target.Common.State);
-- If the task is suspended, wake it up to perform the change.
-- check for ceiling violations ???
System.Task_Primitives.Operations.Unlock (Target);
end if;
System.Tasking.Initialization.Undefer_Abort (Self_ID);
end Set_Priority;
end Ada.Dynamic_Priorities;
gcc/ada/a-dynpri.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . D Y N A M I C _ P R I O R I T I E S --
-- --
-- S p e c --
-- --
-- $Revision: 1.5 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
with System;
with Ada.Task_Identification;
package Ada.Dynamic_Priorities is
procedure Set_Priority
(Priority : System.Any_Priority;
T : Ada.Task_Identification.Task_Id :=
Ada.Task_Identification.Current_Task);
function Get_Priority
(T : Ada.Task_Identification.Task_Id :=
Ada.Task_Identification.Current_Task)
return System.Any_Priority;
end Ada.Dynamic_Priorities;
gcc/ada/a-einuoc.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . E X C E P T I O N S . I S _ N U L L _ O C C U R R E N C E --
-- --
-- B o d y --
-- --
-- $Revision: 1.2 $
-- --
-- Copyright (C) 2000 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This is a GNAT-specific child function of Ada.Exceptions. It provides
-- clearly missing functionality for its parent package, and most reasonably
-- would simply be an added function to that package, but this change cannot
-- be made in a conforming manner.
function Ada.Exceptions.Is_Null_Occurrence
(X : Exception_Occurrence)
return Boolean
is
begin
-- The null exception is uniquely identified by the fact that the Id
-- value is null. No other exception occurrence can have a null Id.
if X.Id = Null_Id then
return True;
else
return False;
end if;
end Ada.Exceptions.Is_Null_Occurrence;
gcc/ada/a-einuoc.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . E X C E P T I O N S . I S _ N U L L _ O C C U R R E N C E --
-- --
-- S p e c --
-- --
-- $Revision: 1.1 $
-- --
-- Copyright (C) 2000 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This is a GNAT-specific child function of Ada.Exceptions. It provides
-- clearly missing functionality for its parent package, and most reasonably
-- would simply be an added function to that package, but this change cannot
-- be made in a conforming manner.
function Ada.Exceptions.Is_Null_Occurrence
(X : Exception_Occurrence)
return Boolean;
-- This function yields True if X is Null_Occurrence, and False otherwise
gcc/ada/a-excpol.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- A D A . E X C E P T I O N S . P O L L --
-- --
-- B o d y --
-- (dummy version where polling is not used) --
-- --
-- $Revision: 1.5 $ --
-- --
-- Copyright (C) 1992-1998, Free Software Foundation, Inc. --
-- --
-- GNARL 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. GNARL 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 GNARL; 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. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. It is --
-- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
-- State University (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
separate (Ada.Exceptions)
----------
-- Poll --
----------
procedure Poll is
begin
null;
end Poll;
gcc/ada/a-exctra.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . E X C E P T I O N S . T R A C E B A C K --
-- --
-- B o d y --
-- --
-- $Revision: 1.3 $
-- --
-- Copyright (C) 1999-2001 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. --
-- --
-- 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
package body Ada.Exceptions.Traceback is
function Tracebacks
(E : Exception_Occurrence)
return GNAT.Traceback.Tracebacks_Array
is
begin
return
GNAT.Traceback.Tracebacks_Array (E.Tracebacks (1 .. E.Num_Tracebacks));
end Tracebacks;
end Ada.Exceptions.Traceback;
gcc/ada/a-exctra.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . E X C E P T I O N S . T R A C E B A C K --
-- --
-- S p e c --
-- --
-- $Revision: 1.3 $
-- --
-- Copyright (C) 1999-2001 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. --
-- --
-- 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This package is part of the support for tracebacks on exceptions. It is
-- used ONLY from GNAT.Traceback.Symbolic and is provided to get access to
-- the tracebacks in an exception occurrence. It may not be used directly
-- from the Ada hierarchy (since it references GNAT.Traceback).
with GNAT.Traceback;
package Ada.Exceptions.Traceback is
function Tracebacks
(E : Exception_Occurrence)
return GNAT.Traceback.Tracebacks_Array;
-- This function extracts the traceback information from an exception
-- occurrence, and returns it formatted in the manner required for
-- processing in GNAT.Traceback. See g-traceb.ads for details.
end Ada.Exceptions.Traceback;
gcc/ada/a-filico.adb 0 → 100644
-----------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . L I S T _ F I N A L I Z A T I O N --
-- --
-- B o d y --
-- --
-- $Revision: 1.9 $
-- --
-- Copyright (C) 1992-2001 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with System.Finalization_Implementation;
package body Ada.Finalization.List_Controller is
package SFI renames System.Finalization_Implementation;
--------------
-- Finalize --
--------------
procedure Finalize (Object : in out List_Controller) is
use type SFR.Finalizable_Ptr;
Last_Ptr : constant SFR.Finalizable_Ptr := Object.Last'Unchecked_Access;
begin
while Object.First.Next /= Last_Ptr loop
SFI.Finalize_One (Object.First.Next.all);
end loop;
end Finalize;
procedure Finalize (Object : in out Simple_List_Controller) is
begin
SFI.Finalize_List (Object.F);
Object.F := null;
end Finalize;
----------------
-- Initialize --
----------------
procedure Initialize (Object : in out List_Controller) is
begin
Object.F := Object.First'Unchecked_Access;
Object.First.Next := Object.Last 'Unchecked_Access;
Object.Last.Prev := Object.First'Unchecked_Access;
end Initialize;
end Ada.Finalization.List_Controller;
gcc/ada/a-filico.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- A D A . F I N A L I Z A T I O N . L I S T _ C O N T R O L L E R --
-- --
-- B o d y --
-- --
-- $Revision: 1.7 $ --
-- --
-- Copyright (C) 1992-1997 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with System.Finalization_Root;
package Ada.Finalization.List_Controller is
pragma Elaborate_Body (List_Controller);
package SFR renames System.Finalization_Root;
----------------------------
-- Simple_List_Controller --
----------------------------
type Simple_List_Controller is new Ada.Finalization.Limited_Controlled
with record
F : SFR.Finalizable_Ptr;
end record;
-- Used by the compiler to carry a list of temporary objects that
-- needs to be finalized after having being used. This list is
-- embedded in a controlled type so that if an exception is raised
-- while those temporaries are still in use, they will be reclaimed
-- by the normal finalization mechanism.
procedure Finalize (Object : in out Simple_List_Controller);
---------------------
-- List_Controller --
---------------------
-- Management of a bidirectional linked heterogenous list of
-- dynamically Allocated objects. To simplify the management of the
-- linked list, the First and Last elements are statically part of the
-- original List controller:
--
-- +------------+
-- | --|-->--
-- +------------+
-- |--<-- | record with ctrl components
-- |------------| +----------+
-- +--|-- L | | |
-- | |------------| | |
-- | |+--------+ | +--------+ |+--------+|
-- +->|| prev | F|---<---|-- |----<---||-- ||--<--+
-- ||--------| i| |--------| ||--------|| |
-- || next | r|--->---| --|---->---|| --||--------+
-- |+--------+ s| |--------| ||--------|| | |
-- | t| | ctrl | || || | |
-- | | : : |+--------+| | |
-- | | : object : |rec | | |
-- | | : : |controller| | |
-- | | | | | | | v
-- |+--------+ | +--------+ +----------+ | |
-- || prev -|-L|--------------------->--------------------+ |
-- ||--------| a| |
-- || next | s|-------------------<-------------------------+
-- |+--------+ t|
-- | |
-- +------------+
type List_Controller is new Ada.Finalization.Limited_Controlled
with record
F : SFR.Finalizable_Ptr;
First,
Last : aliased SFR.Root_Controlled;
end record;
-- Controls the chains of dynamically allocated controlled
-- objects makes sure that they get finalized upon exit from
-- the access type that defined them
procedure Initialize (Object : in out List_Controller);
procedure Finalize (Object : in out List_Controller);
end Ada.Finalization.List_Controller;
gcc/ada/a-finali.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- A D A . F I N A L I Z A T I O N --
-- --
-- B o d y --
-- --
-- $Revision: 1.10 $
-- --
-- Copyright (C) 1992-2001 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with System.Finalization_Root; use System.Finalization_Root;
package body Ada.Finalization is
---------
-- "=" --
---------
function "=" (A, B : Controlled) return Boolean is
begin
return Empty_Root_Controlled (A) = Empty_Root_Controlled (B);
end "=";
------------
-- Adjust --
------------
procedure Adjust (Object : in out Controlled) is
begin
null;
end Adjust;
--------------
-- Finalize --
--------------
procedure Finalize (Object : in out Controlled) is
begin
null;
end Finalize;
procedure Finalize (Object : in out Limited_Controlled) is
begin
null;
end Finalize;
----------------
-- Initialize --
----------------
procedure Initialize (Object : in out Controlled) is
begin
null;
end Initialize;
procedure Initialize (Object : in out Limited_Controlled) is
begin
null;
end Initialize;
end Ada.Finalization;
gcc/ada/a-finali.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . F I N A L I Z A T I O N --
-- --
-- S p e c --
-- --
-- $Revision: 1.17 $ --
-- --
-- Copyright (C) 1992-1997 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. --
-- --
-- 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with System.Finalization_Root;
package Ada.Finalization is
pragma Preelaborate (Finalization);
type Controlled is abstract tagged private;
procedure Initialize (Object : in out Controlled);
procedure Adjust (Object : in out Controlled);
procedure Finalize (Object : in out Controlled);
type Limited_Controlled is abstract tagged limited private;
procedure Initialize (Object : in out Limited_Controlled);
procedure Finalize (Object : in out Limited_Controlled);
private
package SFR renames System.Finalization_Root;
type Controlled is abstract new SFR.Root_Controlled with null record;
function "=" (A, B : Controlled) return Boolean;
-- Need to be defined explictly because we don't want to compare the
-- hidden pointers
type Limited_Controlled is
abstract new SFR.Root_Controlled with null record;
end Ada.Finalization;
gcc/ada/a-flteio.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . F L O A T _ T E X T _ I O --
-- --
-- S p e c --
-- --
-- $Revision: 1.3 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
with Ada.Text_IO;
pragma Elaborate_All (Ada.Text_IO);
package Ada.Float_Text_IO is
new Ada.Text_IO.Float_IO (Float);
gcc/ada/a-fwteio.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . F L O A T _ W I D E _ T E X T _ I O --
-- --
-- S p e c --
-- --
-- $Revision: 1.2 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
with Ada.Wide_Text_IO;
package Ada.Float_Wide_Text_IO is
new Ada.Wide_Text_IO.Float_IO (Float);
gcc/ada/a-inteio.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . I N T E G E R _ T E X T _ I O --
-- --
-- S p e c --
-- --
-- $Revision: 1.2 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
with Ada.Text_IO;
package Ada.Integer_Text_IO is
new Ada.Text_IO.Integer_IO (Integer);
gcc/ada/a-interr.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- A D A . I N T E R R U P T S --
-- --
-- B o d y --
-- --
-- $Revision: 1.12 $ --
-- --
-- Copyright (C) 1991-2001 Florida State University --
-- --
-- GNARL 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. GNARL 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 GNARL; 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. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. It is --
-- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
-- State University (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with System.Interrupts;
-- used for Interrupt_ID
-- Parameterless_Handler
-- Is_Reserved
-- Is_Handler_Attached
-- Current_Handler
-- Attach_Handler
-- Exchange_Handler
-- Detach_Handler
-- Reference
with Unchecked_Conversion;
package body Ada.Interrupts is
package SI renames System.Interrupts;
function To_System is new Unchecked_Conversion
(Parameterless_Handler, SI.Parameterless_Handler);
function To_Ada is new Unchecked_Conversion
(SI.Parameterless_Handler, Parameterless_Handler);
--------------------
-- Attach_Handler --
--------------------
procedure Attach_Handler
(New_Handler : Parameterless_Handler;
Interrupt : Interrupt_ID)
is
begin
SI.Attach_Handler
(To_System (New_Handler), SI.Interrupt_ID (Interrupt), False);
end Attach_Handler;
---------------------
-- Current_Handler --
---------------------
function Current_Handler
(Interrupt : Interrupt_ID)
return Parameterless_Handler
is
begin
return To_Ada (SI.Current_Handler (SI.Interrupt_ID (Interrupt)));
end Current_Handler;
--------------------
-- Detach_Handler --
--------------------
procedure Detach_Handler (Interrupt : in Interrupt_ID) is
begin
SI.Detach_Handler (SI.Interrupt_ID (Interrupt), False);
end Detach_Handler;
----------------------
-- Exchange_Handler --
----------------------
procedure Exchange_Handler
(Old_Handler : out Parameterless_Handler;
New_Handler : Parameterless_Handler;
Interrupt : Interrupt_ID)
is
H : SI.Parameterless_Handler;
begin
SI.Exchange_Handler
(H, To_System (New_Handler),
SI.Interrupt_ID (Interrupt), False);
Old_Handler := To_Ada (H);
end Exchange_Handler;
-----------------
-- Is_Attached --
-----------------
function Is_Attached (Interrupt : Interrupt_ID) return Boolean is
begin
return SI.Is_Handler_Attached (SI.Interrupt_ID (Interrupt));
end Is_Attached;
-----------------
-- Is_Reserved --
-----------------
function Is_Reserved (Interrupt : Interrupt_ID) return Boolean is
begin
return SI.Is_Reserved (SI.Interrupt_ID (Interrupt));
end Is_Reserved;
---------------
-- Reference --
---------------
function Reference (Interrupt : Interrupt_ID) return System.Address is
begin
return SI.Reference (SI.Interrupt_ID (Interrupt));
end Reference;
end Ada.Interrupts;
gcc/ada/a-interr.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . I N T E R R U P T S --
-- --
-- S p e c --
-- --
-- $Revision: 1.16 $
-- --
-- Copyright (C) 1992-2001 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. --
-- --
-- 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with System.Interrupts;
-- used for Ada_Interrupt_ID.
package Ada.Interrupts is
type Interrupt_ID is new System.Interrupts.Ada_Interrupt_ID;
type Parameterless_Handler is access protected procedure;
function Is_Reserved (Interrupt : Interrupt_ID) return Boolean;
function Is_Attached (Interrupt : Interrupt_ID) return Boolean;
function Current_Handler
(Interrupt : Interrupt_ID)
return Parameterless_Handler;
procedure Attach_Handler
(New_Handler : Parameterless_Handler;
Interrupt : Interrupt_ID);
procedure Exchange_Handler
(Old_Handler : out Parameterless_Handler;
New_Handler : Parameterless_Handler;
Interrupt : Interrupt_ID);
procedure Detach_Handler (Interrupt : Interrupt_ID);
function Reference (Interrupt : Interrupt_ID) return System.Address;
private
pragma Inline (Is_Reserved);
pragma Inline (Is_Attached);
pragma Inline (Current_Handler);
pragma Inline (Attach_Handler);
pragma Inline (Detach_Handler);
pragma Inline (Exchange_Handler);
end Ada.Interrupts;
gcc/ada/a-intnam.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . I N T E R R U P T S . N A M E S --
-- --
-- S p e c --
-- --
-- $Revision: 1.3 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
-- The standard implementation of this spec contains only dummy interrupt
-- names. These dummy entries permit checking out code for correctness of
-- semantics, even if interrupts are not supported.
-- For specific implementations that fully support interrupts, this package
-- spec is replaced by an implementation dependent version that defines the
-- interrupts available on the system.
package Ada.Interrupts.Names is
DUMMY_INTERRUPT_1 : constant Interrupt_ID := 1;
DUMMY_INTERRUPT_2 : constant Interrupt_ID := 2;
end Ada.Interrupts.Names;
gcc/ada/a-intsig.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- A D A . I N T E R R U P T S . S I G N A L --
-- --
-- B o d y --
-- --
-- $Revision: 1.1 $ --
-- --
-- Copyright (C) 2000 Free Software Foundation, Inc. --
-- --
-- GNARL 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. GNARL 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 GNARL; 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. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. It is --
-- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
-- State University (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
--
with System.Interrupt_Management.Operations;
package body Ada.Interrupts.Signal is
-------------------------
-- Generate_Interrupt --
-------------------------
procedure Generate_Interrupt (Interrupt : Interrupt_ID) is
begin
System.Interrupt_Management.Operations.Interrupt_Self_Process
(System.Interrupt_Management.Interrupt_ID (Interrupt));
end Generate_Interrupt;
end Ada.Interrupts.Signal;
gcc/ada/a-intsig.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- A D A . I N T E R R U P T S . S I G N A L --
-- --
-- S p e c --
-- --
-- $Revision: 1.1 $ --
-- --
-- Copyright (C) 2000 Free Software Foundation, Inc. --
-- --
-- GNARL 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. GNARL 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 GNARL; 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. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. It is --
-- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
-- State University (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
--
-- This package encapsulates the procedures for generating interrupts
-- by user programs and avoids importing low level children of System
-- (e.g. System.Interrupt_Management.Operations), or defining an interface
-- to complex system calls.
--
package Ada.Interrupts.Signal is
procedure Generate_Interrupt (Interrupt : Interrupt_ID);
-- Generate Interrupt at the process level
end Ada.Interrupts.Signal;
gcc/ada/a-ioexce.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . I O _ E X C E P T I O N S --
-- --
-- S p e c --
-- --
-- $Revision: 1.6 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
package Ada.IO_Exceptions is
pragma Pure (IO_Exceptions);
Status_Error : exception;
Mode_Error : exception;
Name_Error : exception;
Use_Error : exception;
Device_Error : exception;
End_Error : exception;
Data_Error : exception;
Layout_Error : exception;
end Ada.IO_Exceptions;
gcc/ada/a-iwteio.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . I N T E G E R _ W I D E _ T E X T _ I O --
-- --
-- S p e c --
-- --
-- $Revision: 1.2 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
with Ada.Wide_Text_IO;
package Ada.Integer_Wide_Text_IO is
new Ada.Wide_Text_IO.Integer_IO (Integer);
gcc/ada/a-lfteio.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . L O N G _ F L O A T _ T E X T _ I O --
-- --
-- S p e c --
-- --
-- $Revision: 1.2 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
with Ada.Text_IO;
package Ada.Long_Float_Text_IO is
new Ada.Text_IO.Float_IO (Long_Float);
gcc/ada/a-lfwtio.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . L O N G _ F L O A T _ W I D E _ T E X T _ I O --
-- --
-- S p e c --
-- --
-- $Revision: 1.2 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
with Ada.Wide_Text_IO;
package Ada.Long_Float_Wide_Text_IO is
new Ada.Wide_Text_IO.Float_IO (Long_Float);
gcc/ada/a-liteio.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . L O N G _ I N T E G E R _ T E X T _ I O --
-- --
-- S p e c --
-- --
-- $Revision: 1.2 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
with Ada.Text_IO;
package Ada.Long_Integer_Text_IO is
new Ada.Text_IO.Integer_IO (Long_Integer);
gcc/ada/a-liwtio.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . L O N G _ I N T E G E R _ W I D E _ T E X T _ I O --
-- --
-- S p e c --
-- --
-- $Revision: 1.2 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
with Ada.Wide_Text_IO;
package Ada.Long_Integer_Wide_Text_IO is
new Ada.Wide_Text_IO.Integer_IO (Long_Integer);
gcc/ada/a-llftio.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . L O N G _ L O N G _ F L O A T _ T E X T _ I O --
-- --
-- S p e c --
-- --
-- $Revision: 1.2 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
with Ada.Text_IO;
package Ada.Long_Long_Float_Text_IO is
new Ada.Text_IO.Float_IO (Long_Long_Float);
gcc/ada/a-llfwti.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . L O N G _ L O N G _ F L O A T _ W I D E _ T E X T _ I O --
-- --
-- S p e c --
-- --
-- $Revision: 1.2 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
with Ada.Wide_Text_IO;
package Ada.Long_Long_Float_Wide_Text_IO is
new Ada.Wide_Text_IO.Float_IO (Long_Long_Float);
gcc/ada/a-llitio.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . L O N G _ L O N G _ I N T E G E R _ T E X T _ I O --
-- --
-- S p e c --
-- --
-- $Revision: 1.2 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
with Ada.Text_IO;
package Ada.Long_Long_Integer_Text_IO is
new Ada.Text_IO.Integer_IO (Long_Long_Integer);
gcc/ada/a-lliwti.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . L O N G _ L O N G _ I N T E G E R _ W I D E _ T E X T _ I O --
-- --
-- S p e c --
-- --
-- $Revision: 1.2 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
with Ada.Wide_Text_IO;
package Ada.Long_Long_Integer_Wide_Text_IO is
new Ada.Wide_Text_IO.Integer_IO (Long_Long_Integer);
gcc/ada/a-ncelfu.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- ADA.NUMERICS.GENERIC_COMPLEX.ELEMENTARY_FUNCTIONS --
-- --
-- S p e c --
-- --
-- $Revision: 1.3 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
with Ada.Numerics.Complex_Types;
with Ada.Numerics.Generic_Complex_Elementary_Functions;
package Ada.Numerics.Complex_Elementary_Functions is
new Ada.Numerics.Generic_Complex_Elementary_Functions
(Ada.Numerics.Complex_Types);
gcc/ada/a-ngcefu.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- ADA.NUMERICS.GENERIC_COMPLEX_ELEMENTARY_FUNCTIONS --
-- --
-- S p e c --
-- --
-- $Revision: 1.8 $
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
with Ada.Numerics.Generic_Complex_Types;
generic
with package Complex_Types is new Ada.Numerics.Generic_Complex_Types (<>);
use Complex_Types;
package Ada.Numerics.Generic_Complex_Elementary_Functions is
pragma Pure (Ada.Numerics.Generic_Complex_Elementary_Functions);
function Sqrt (X : Complex) return Complex;
function Log (X : Complex) return Complex;
function Exp (X : Complex) return Complex;
function Exp (X : Imaginary) return Complex;
function "**" (Left : Complex; Right : Complex) return Complex;
function "**" (Left : Complex; Right : Real'Base) return Complex;
function "**" (Left : Real'Base; Right : Complex) return Complex;
function Sin (X : Complex) return Complex;
function Cos (X : Complex) return Complex;
function Tan (X : Complex) return Complex;
function Cot (X : Complex) return Complex;
function Arcsin (X : Complex) return Complex;
function Arccos (X : Complex) return Complex;
function Arctan (X : Complex) return Complex;
function Arccot (X : Complex) return Complex;
function Sinh (X : Complex) return Complex;
function Cosh (X : Complex) return Complex;
function Tanh (X : Complex) return Complex;
function Coth (X : Complex) return Complex;
function Arcsinh (X : Complex) return Complex;
function Arccosh (X : Complex) return Complex;
function Arctanh (X : Complex) return Complex;
function Arccoth (X : Complex) return Complex;
end Ada.Numerics.Generic_Complex_Elementary_Functions;
gcc/ada/a-ngcoty.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . N U M E R I C S . G E N E R I C _ C O M P L E X _ T Y P E S --
-- --
-- S p e c --
-- --
-- $Revision: 1.7 $ --
-- --
-- Copyright (C) 1992-1997 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. --
-- --
-- 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
generic
type Real is digits <>;
package Ada.Numerics.Generic_Complex_Types is
pragma Pure (Generic_Complex_Types);
type Complex is record
Re, Im : Real'Base;
end record;
pragma Complex_Representation (Complex);
type Imaginary is private;
i : constant Imaginary;
j : constant Imaginary;
function Re (X : Complex) return Real'Base;
function Im (X : Complex) return Real'Base;
function Im (X : Imaginary) return Real'Base;
procedure Set_Re (X : in out Complex; Re : in Real'Base);
procedure Set_Im (X : in out Complex; Im : in Real'Base);
procedure Set_Im (X : out Imaginary; Im : in Real'Base);
function Compose_From_Cartesian (Re, Im : Real'Base) return Complex;
function Compose_From_Cartesian (Re : Real'Base) return Complex;
function Compose_From_Cartesian (Im : Imaginary) return Complex;
function Modulus (X : Complex) return Real'Base;
function "abs" (Right : Complex) return Real'Base renames Modulus;
function Argument (X : Complex) return Real'Base;
function Argument (X : Complex; Cycle : Real'Base) return Real'Base;
function Compose_From_Polar (
Modulus, Argument : Real'Base)
return Complex;
function Compose_From_Polar (
Modulus, Argument, Cycle : Real'Base)
return Complex;
function "+" (Right : Complex) return Complex;
function "-" (Right : Complex) return Complex;
function Conjugate (X : Complex) return Complex;
function "+" (Left, Right : Complex) return Complex;
function "-" (Left, Right : Complex) return Complex;
function "*" (Left, Right : Complex) return Complex;
function "/" (Left, Right : Complex) return Complex;
function "**" (Left : Complex; Right : Integer) return Complex;
function "+" (Right : Imaginary) return Imaginary;
function "-" (Right : Imaginary) return Imaginary;
function Conjugate (X : Imaginary) return Imaginary renames "-";
function "abs" (Right : Imaginary) return Real'Base;
function "+" (Left, Right : Imaginary) return Imaginary;
function "-" (Left, Right : Imaginary) return Imaginary;
function "*" (Left, Right : Imaginary) return Real'Base;
function "/" (Left, Right : Imaginary) return Real'Base;
function "**" (Left : Imaginary; Right : Integer) return Complex;
function "<" (Left, Right : Imaginary) return Boolean;
function "<=" (Left, Right : Imaginary) return Boolean;
function ">" (Left, Right : Imaginary) return Boolean;
function ">=" (Left, Right : Imaginary) return Boolean;
function "+" (Left : Complex; Right : Real'Base) return Complex;
function "+" (Left : Real'Base; Right : Complex) return Complex;
function "-" (Left : Complex; Right : Real'Base) return Complex;
function "-" (Left : Real'Base; Right : Complex) return Complex;
function "*" (Left : Complex; Right : Real'Base) return Complex;
function "*" (Left : Real'Base; Right : Complex) return Complex;
function "/" (Left : Complex; Right : Real'Base) return Complex;
function "/" (Left : Real'Base; Right : Complex) return Complex;
function "+" (Left : Complex; Right : Imaginary) return Complex;
function "+" (Left : Imaginary; Right : Complex) return Complex;
function "-" (Left : Complex; Right : Imaginary) return Complex;
function "-" (Left : Imaginary; Right : Complex) return Complex;
function "*" (Left : Complex; Right : Imaginary) return Complex;
function "*" (Left : Imaginary; Right : Complex) return Complex;
function "/" (Left : Complex; Right : Imaginary) return Complex;
function "/" (Left : Imaginary; Right : Complex) return Complex;
function "+" (Left : Imaginary; Right : Real'Base) return Complex;
function "+" (Left : Real'Base; Right : Imaginary) return Complex;
function "-" (Left : Imaginary; Right : Real'Base) return Complex;
function "-" (Left : Real'Base; Right : Imaginary) return Complex;
function "*" (Left : Imaginary; Right : Real'Base) return Imaginary;
function "*" (Left : Real'Base; Right : Imaginary) return Imaginary;
function "/" (Left : Imaginary; Right : Real'Base) return Imaginary;
function "/" (Left : Real'Base; Right : Imaginary) return Imaginary;
private
type Imaginary is new Real'Base;
i : constant Imaginary := 1.0;
j : constant Imaginary := 1.0;
pragma Inline ("+");
pragma Inline ("-");
pragma Inline ("*");
pragma Inline ("<");
pragma Inline ("<=");
pragma Inline (">");
pragma Inline (">=");
pragma Inline ("abs");
pragma Inline (Compose_From_Cartesian);
pragma Inline (Conjugate);
pragma Inline (Im);
pragma Inline (Re);
pragma Inline (Set_Im);
pragma Inline (Set_Re);
end Ada.Numerics.Generic_Complex_Types;
gcc/ada/a-ngelfu.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- ADA.NUMERICS.GENERIC_ELEMENTARY_FUNCTIONS --
-- --
-- S p e c --
-- --
-- $Revision: 1.7 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
generic
type Float_Type is digits <>;
package Ada.Numerics.Generic_Elementary_Functions is
pragma Pure (Generic_Elementary_Functions);
function Sqrt (X : Float_Type'Base) return Float_Type'Base;
function Log (X : Float_Type'Base) return Float_Type'Base;
function Log (X, Base : Float_Type'Base) return Float_Type'Base;
function Exp (X : Float_Type'Base) return Float_Type'Base;
function "**" (Left, Right : Float_Type'Base) return Float_Type'Base;
function Sin (X : Float_Type'Base) return Float_Type'Base;
function Sin (X, Cycle : Float_Type'Base) return Float_Type'Base;
function Cos (X : Float_Type'Base) return Float_Type'Base;
function Cos (X, Cycle : Float_Type'Base) return Float_Type'Base;
function Tan (X : Float_Type'Base) return Float_Type'Base;
function Tan (X, Cycle : Float_Type'Base) return Float_Type'Base;
function Cot (X : Float_Type'Base) return Float_Type'Base;
function Cot (X, Cycle : Float_Type'Base) return Float_Type'Base;
function Arcsin (X : Float_Type'Base) return Float_Type'Base;
function Arcsin (X, Cycle : Float_Type'Base) return Float_Type'Base;
function Arccos (X : Float_Type'Base) return Float_Type'Base;
function Arccos (X, Cycle : Float_Type'Base) return Float_Type'Base;
function Arctan
(Y : Float_Type'Base;
X : Float_Type'Base := 1.0)
return Float_Type'Base;
function Arctan
(Y : Float_Type'Base;
X : Float_Type'Base := 1.0;
Cycle : Float_Type'Base)
return Float_Type'Base;
function Arccot
(X : Float_Type'Base;
Y : Float_Type'Base := 1.0)
return Float_Type'Base;
function Arccot
(X : Float_Type'Base;
Y : Float_Type'Base := 1.0;
Cycle : Float_Type'Base)
return Float_Type'Base;
function Sinh (X : Float_Type'Base) return Float_Type'Base;
function Cosh (X : Float_Type'Base) return Float_Type'Base;
function Tanh (X : Float_Type'Base) return Float_Type'Base;
function Coth (X : Float_Type'Base) return Float_Type'Base;
function Arcsinh (X : Float_Type'Base) return Float_Type'Base;
function Arccosh (X : Float_Type'Base) return Float_Type'Base;
function Arctanh (X : Float_Type'Base) return Float_Type'Base;
function Arccoth (X : Float_Type'Base) return Float_Type'Base;
end Ada.Numerics.Generic_Elementary_Functions;
gcc/ada/a-nlcefu.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- ADA.NUMERICS.LONG_COMPLEX.ELEMENTARY_FUNCTIONS --
-- --
-- S p e c --
-- --
-- $Revision: 1.3 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
with Ada.Numerics.Long_Complex_Types;
with Ada.Numerics.Generic_Complex_Elementary_Functions;
package Ada.Numerics.Long_Complex_Elementary_Functions is
new Ada.Numerics.Generic_Complex_Elementary_Functions
(Ada.Numerics.Long_Complex_Types);
gcc/ada/a-nlcoty.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . N U M E R I C S . L O N G _ C O M P L E X _ T Y P E S --
-- --
-- S p e c --
-- --
-- $Revision: 1.4 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
with Ada.Numerics.Generic_Complex_Types;
package Ada.Numerics.Long_Complex_Types is
new Ada.Numerics.Generic_Complex_Types (Long_Float);
pragma Pure (Long_Complex_Types);
gcc/ada/a-nlelfu.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- ADA.NUMERICS.LONG_ELEMENTARY_FUNCTIONS --
-- --
-- S p e c --
-- --
-- $Revision: 1.5 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
with Ada.Numerics.Generic_Elementary_Functions;
package Ada.Numerics.Long_Elementary_Functions is
new Ada.Numerics.Generic_Elementary_Functions (Long_Float);
pragma Pure (Long_Elementary_Functions);
gcc/ada/a-nllcef.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- ADA.NUMERICS.LONG_LONG_COMPLEX.ELEMENTARY_FUNCTIONS --
-- --
-- S p e c --
-- --
-- $Revision: 1.3 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
with Ada.Numerics.Long_Long_Complex_Types;
with Ada.Numerics.Generic_Complex_Elementary_Functions;
package Ada.Numerics.Long_Long_Complex_Elementary_Functions is
new Ada.Numerics.Generic_Complex_Elementary_Functions
(Ada.Numerics.Long_Long_Complex_Types);
gcc/ada/a-nllcty.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . N U M E R I C S . L O N G _ L O N G _ C O M P L E X _ T Y P E S --
-- --
-- S p e c --
-- --
-- $Revision: 1.4 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
with Ada.Numerics.Generic_Complex_Types;
package Ada.Numerics.Long_Long_Complex_Types is
new Ada.Numerics.Generic_Complex_Types (Long_Long_Float);
pragma Pure (Long_Long_Complex_Types);
gcc/ada/a-nllefu.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- ADA.NUMERICS.LONG_LONG_ELEMENTARY_FUNCTIONS --
-- --
-- S p e c --
-- --
-- $Revision: 1.5 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
with Ada.Numerics.Generic_Elementary_Functions;
package Ada.Numerics.Long_Long_Elementary_Functions is
new Ada.Numerics.Generic_Elementary_Functions (Long_Long_Float);
pragma Pure (Long_Long_Elementary_Functions);
gcc/ada/a-nscefu.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- ADA.NUMERICS.SHORT.COMPLEX.ELEMENTARY_FUNCTIONS --
-- --
-- S p e c --
-- --
-- $Revision: 1.3 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
with Ada.Numerics.Short_Complex_Types;
with Ada.Numerics.Generic_Complex_Elementary_Functions;
package Ada.Numerics.Short_Complex_Elementary_Functions is
new Ada.Numerics.Generic_Complex_Elementary_Functions
(Ada.Numerics.Short_Complex_Types);
gcc/ada/a-nscoty.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . N U M E R I C S . S H O R T _ C O M P L E X _ T Y P E S --
-- --
-- S p e c --
-- --
-- $Revision: 1.4 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
with Ada.Numerics.Generic_Complex_Types;
package Ada.Numerics.Short_Complex_Types is
new Ada.Numerics.Generic_Complex_Types (Short_Float);
pragma Pure (Short_Complex_Types);
gcc/ada/a-nselfu.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- ADA.NUMERICS.SHORT_ELEMENTARY_FUNCTIONS --
-- --
-- S p e c --
-- --
-- $Revision: 1.5 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
with Ada.Numerics.Generic_Elementary_Functions;
package Ada.Numerics.Short_Elementary_Functions is
new Ada.Numerics.Generic_Elementary_Functions (Short_Float);
pragma Pure (Short_Elementary_Functions);
gcc/ada/a-nucoty.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . N U M E R I C S . C O M P L E X _ T Y P E S --
-- --
-- S p e c --
-- --
-- $Revision: 1.4 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
with Ada.Numerics.Generic_Complex_Types;
package Ada.Numerics.Complex_Types is
new Ada.Numerics.Generic_Complex_Types (Float);
pragma Pure (Complex_Types);
gcc/ada/a-nudira.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . N U M E R I C S . D I S C R E T E _ R A N D O M --
-- --
-- B o d y --
-- --
-- $Revision: 1.17 $
-- --
-- Copyright (C) 1992-1999 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Ada.Calendar;
with Interfaces; use Interfaces;
package body Ada.Numerics.Discrete_Random is
-------------------------
-- Implementation Note --
-------------------------
-- The design of this spec is very awkward, as a result of Ada 95 not
-- permitting in-out parameters for function formals (most naturally
-- Generator values would be passed this way). In pure Ada 95, the only
-- solution is to use the heap and pointers, and, to avoid memory leaks,
-- controlled types.
-- This is awfully heavy, so what we do is to use Unrestricted_Access to
-- get a pointer to the state in the passed Generator. This works because
-- Generator is a limited type and will thus always be passed by reference.
type Pointer is access all State;
Need_64 : constant Boolean := Rst'Pos (Rst'Last) > Int'Last;
-----------------------
-- Local Subprograms --
-----------------------
function Square_Mod_N (X, N : Int) return Int;
pragma Inline (Square_Mod_N);
-- Computes X**2 mod N avoiding intermediate overflow
-----------
-- Image --
-----------
function Image (Of_State : State) return String is
begin
return Int'Image (Of_State.X1) &
',' &
Int'Image (Of_State.X2) &
',' &
Int'Image (Of_State.Q);
end Image;
------------
-- Random --
------------
function Random (Gen : Generator) return Rst is
Genp : constant Pointer := Gen.Gen_State'Unrestricted_Access;
Temp : Int;
TF : Flt;
begin
-- Check for flat range here, since we are typically run with checks
-- off, note that in practice, this condition will usually be static
-- so we will not actually generate any code for the normal case.
if Rst'Last < Rst'First then
raise Constraint_Error;
end if;
-- Continue with computation if non-flat range
Genp.X1 := Square_Mod_N (Genp.X1, Genp.P);
Genp.X2 := Square_Mod_N (Genp.X2, Genp.Q);
Temp := Genp.X2 - Genp.X1;
-- Following duplication is not an error, it is a loop unwinding!
if Temp < 0 then
Temp := Temp + Genp.Q;
end if;
if Temp < 0 then
Temp := Temp + Genp.Q;
end if;
TF := Offs + (Flt (Temp) * Flt (Genp.P) + Flt (Genp.X1)) * Genp.Scl;
-- Pathological, but there do exist cases where the rounding implicit
-- in calculating the scale factor will cause rounding to 'Last + 1.
-- In those cases, returning 'First results in the least bias.
if TF >= Flt (Rst'Pos (Rst'Last)) + 0.5 then
return Rst'First;
elsif Need_64 then
return Rst'Val (Interfaces.Integer_64 (TF));
else
return Rst'Val (Int (TF));
end if;
end Random;
-----------
-- Reset --
-----------
procedure Reset (Gen : Generator; Initiator : Integer) is
Genp : constant Pointer := Gen.Gen_State'Unrestricted_Access;
X1, X2 : Int;
begin
X1 := 2 + Int (Initiator) mod (K1 - 3);
X2 := 2 + Int (Initiator) mod (K2 - 3);
for J in 1 .. 5 loop
X1 := Square_Mod_N (X1, K1);
X2 := Square_Mod_N (X2, K2);
end loop;
-- eliminate effects of small Initiators.
Genp.all :=
(X1 => X1,
X2 => X2,
P => K1,
Q => K2,
FP => K1F,
Scl => Scal);
end Reset;
-----------
-- Reset --
-----------
procedure Reset (Gen : Generator) is
Genp : constant Pointer := Gen.Gen_State'Unrestricted_Access;
Now : constant Calendar.Time := Calendar.Clock;
X1 : Int;
X2 : Int;
begin
X1 := Int (Calendar.Year (Now)) * 12 * 31 +
Int (Calendar.Month (Now) * 31) +
Int (Calendar.Day (Now));
X2 := Int (Calendar.Seconds (Now) * Duration (1000.0));
X1 := 2 + X1 mod (K1 - 3);
X2 := 2 + X2 mod (K2 - 3);
-- Eliminate visible effects of same day starts
for J in 1 .. 5 loop
X1 := Square_Mod_N (X1, K1);
X2 := Square_Mod_N (X2, K2);
end loop;
Genp.all :=
(X1 => X1,
X2 => X2,
P => K1,
Q => K2,
FP => K1F,
Scl => Scal);
end Reset;
-----------
-- Reset --
-----------
procedure Reset (Gen : Generator; From_State : State) is
Genp : constant Pointer := Gen.Gen_State'Unrestricted_Access;
begin
Genp.all := From_State;
end Reset;
----------
-- Save --
----------
procedure Save (Gen : Generator; To_State : out State) is
begin
To_State := Gen.Gen_State;
end Save;
------------------
-- Square_Mod_N --
------------------
function Square_Mod_N (X, N : Int) return Int is
begin
return Int ((Integer_64 (X) ** 2) mod (Integer_64 (N)));
end Square_Mod_N;
-----------
-- Value --
-----------
function Value (Coded_State : String) return State is
Start : Positive := Coded_State'First;
Stop : Positive := Coded_State'First;
Outs : State;
begin
while Coded_State (Stop) /= ',' loop
Stop := Stop + 1;
end loop;
Outs.X1 := Int'Value (Coded_State (Start .. Stop - 1));
Start := Stop + 1;
loop
Stop := Stop + 1;
exit when Coded_State (Stop) = ',';
end loop;
Outs.X2 := Int'Value (Coded_State (Start .. Stop - 1));
Outs.Q := Int'Value (Coded_State (Stop + 1 .. Coded_State'Last));
Outs.P := Outs.Q * 2 + 1;
Outs.FP := Flt (Outs.P);
Outs.Scl := (RstL - RstF + 1.0) / (Flt (Outs.P) * Flt (Outs.Q));
-- Now do *some* sanity checks.
if Outs.Q < 31
or else Outs.X1 not in 2 .. Outs.P - 1
or else Outs.X2 not in 2 .. Outs.Q - 1
then
raise Constraint_Error;
end if;
return Outs;
end Value;
end Ada.Numerics.Discrete_Random;
gcc/ada/a-nudira.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . N U M E R I C S . D I S C R E T E _ R A N D O M --
-- --
-- S p e c --
-- --
-- $Revision: 1.13 $
-- --
-- Copyright (C) 1992-2001 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. --
-- --
-- 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- Note: the implementation used in this package was contributed by
-- Robert Eachus. It is based on the work of L. Blum, M. Blum, and
-- M. Shub, SIAM Journal of Computing, Vol 15. No 2, May 1986. The
-- particular choices for P and Q chosen here guarantee a period of
-- 562,085,314,430,582 (about 2**49), and the generated sequence has
-- excellent randomness properties. For further details, see the
-- paper "Fast Generation of Trustworthy Random Numbers", by Robert
-- Eachus, which describes both the algorithm and the efficient
-- implementation approach used here.
with Interfaces;
generic
type Result_Subtype is (<>);
package Ada.Numerics.Discrete_Random is
-- Basic facilities.
type Generator is limited private;
function Random (Gen : Generator) return Result_Subtype;
procedure Reset (Gen : Generator);
procedure Reset (Gen : Generator; Initiator : Integer);
-- Advanced facilities.
type State is private;
procedure Save (Gen : Generator; To_State : out State);
procedure Reset (Gen : Generator; From_State : State);
Max_Image_Width : constant := 80;
function Image (Of_State : State) return String;
function Value (Coded_State : String) return State;
private
subtype Int is Interfaces.Integer_32;
subtype Rst is Result_Subtype;
type Flt is digits 14;
RstF : constant Flt := Flt (Rst'Pos (Rst'First));
RstL : constant Flt := Flt (Rst'Pos (Rst'Last));
Offs : constant Flt := RstF - 0.5;
K1 : constant := 94_833_359;
K1F : constant := 94_833_359.0;
K2 : constant := 47_416_679;
K2F : constant := 47_416_679.0;
Scal : constant Flt := (RstL - RstF + 1.0) / (K1F * K2F);
type State is record
X1 : Int := Int (2999 ** 2);
X2 : Int := Int (1439 ** 2);
P : Int := K1;
Q : Int := K2;
FP : Flt := K1F;
Scl : Flt := Scal;
end record;
type Generator is limited record
Gen_State : State;
end record;
end Ada.Numerics.Discrete_Random;
gcc/ada/a-nuelfu.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . N U M E R I C S . E L E M E N T A R Y _ F U N C T I O N S --
-- --
-- S p e c --
-- --
-- $Revision: 1.6 $
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
with Ada.Numerics.Generic_Elementary_Functions;
package Ada.Numerics.Elementary_Functions is
new Ada.Numerics.Generic_Elementary_Functions (Float);
pragma Pure (Elementary_Functions);
gcc/ada/a-nuflra.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . N U M E R I C S . F L O A T _ R A N D O M --
-- --
-- B o d y --
-- --
-- $Revision: 1.17 $ --
-- --
-- Copyright (C) 1992-1998, 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Ada.Calendar;
package body Ada.Numerics.Float_Random is
-------------------------
-- Implementation Note --
-------------------------
-- The design of this spec is very awkward, as a result of Ada 95 not
-- permitting in-out parameters for function formals (most naturally
-- Generator values would be passed this way). In pure Ada 95, the only
-- solution is to use the heap and pointers, and, to avoid memory leaks,
-- controlled types.
-- This is awfully heavy, so what we do is to use Unrestricted_Access to
-- get a pointer to the state in the passed Generator. This works because
-- Generator is a limited type and will thus always be passed by reference.
type Pointer is access all State;
-----------------------
-- Local Subprograms --
-----------------------
procedure Euclid (P, Q : in Int; X, Y : out Int; GCD : out Int);
function Euclid (P, Q : Int) return Int;
function Square_Mod_N (X, N : Int) return Int;
------------
-- Euclid --
------------
procedure Euclid (P, Q : in Int; X, Y : out Int; GCD : out Int) is
XT : Int := 1;
YT : Int := 0;
procedure Recur
(P, Q : in Int; -- a (i-1), a (i)
X, Y : in Int; -- x (i), y (i)
XP, YP : in out Int; -- x (i-1), y (i-1)
GCD : out Int);
procedure Recur
(P, Q : in Int;
X, Y : in Int;
XP, YP : in out Int;
GCD : out Int)
is
Quo : Int := P / Q; -- q <-- |_ a (i-1) / a (i) _|
XT : Int := X; -- x (i)
YT : Int := Y; -- y (i)
begin
if P rem Q = 0 then -- while does not divide
GCD := Q;
XP := X;
YP := Y;
else
Recur (Q, P - Q * Quo, XP - Quo * X, YP - Quo * Y, XT, YT, Quo);
-- a (i) <== a (i)
-- a (i+1) <-- a (i-1) - q*a (i)
-- x (i+1) <-- x (i-1) - q*x (i)
-- y (i+1) <-- y (i-1) - q*y (i)
-- x (i) <== x (i)
-- y (i) <== y (i)
XP := XT;
YP := YT;
GCD := Quo;
end if;
end Recur;
-- Start of processing for Euclid
begin
Recur (P, Q, 0, 1, XT, YT, GCD);
X := XT;
Y := YT;
end Euclid;
function Euclid (P, Q : Int) return Int is
X, Y, GCD : Int;
begin
Euclid (P, Q, X, Y, GCD);
return X;
end Euclid;
-----------
-- Image --
-----------
function Image (Of_State : State) return String is
begin
return Int'Image (Of_State.X1) & ',' & Int'Image (Of_State.X2)
& ',' &
Int'Image (Of_State.P) & ',' & Int'Image (Of_State.Q);
end Image;
------------
-- Random --
------------
function Random (Gen : Generator) return Uniformly_Distributed is
Genp : constant Pointer := Gen.Gen_State'Unrestricted_Access;
begin
Genp.X1 := Square_Mod_N (Genp.X1, Genp.P);
Genp.X2 := Square_Mod_N (Genp.X2, Genp.Q);
return
Float ((Flt (((Genp.X2 - Genp.X1) * Genp.X)
mod Genp.Q) * Flt (Genp.P)
+ Flt (Genp.X1)) * Genp.Scl);
end Random;
-----------
-- Reset --
-----------
-- Version that works from given initiator value
procedure Reset (Gen : in Generator; Initiator : in Integer) is
Genp : constant Pointer := Gen.Gen_State'Unrestricted_Access;
X1, X2 : Int;
begin
X1 := 2 + Int (Initiator) mod (K1 - 3);
X2 := 2 + Int (Initiator) mod (K2 - 3);
-- Eliminate effects of small Initiators.
for J in 1 .. 5 loop
X1 := Square_Mod_N (X1, K1);
X2 := Square_Mod_N (X2, K2);
end loop;
Genp.all :=
(X1 => X1,
X2 => X2,
P => K1,
Q => K2,
X => 1,
Scl => Scal);
end Reset;
-- Version that works from specific saved state
procedure Reset (Gen : Generator; From_State : State) is
Genp : constant Pointer := Gen.Gen_State'Unrestricted_Access;
begin
Genp.all := From_State;
end Reset;
-- Version that works from calendar
procedure Reset (Gen : Generator) is
Genp : constant Pointer := Gen.Gen_State'Unrestricted_Access;
Now : constant Calendar.Time := Calendar.Clock;
X1, X2 : Int;
begin
X1 := Int (Calendar.Year (Now)) * 12 * 31 +
Int (Calendar.Month (Now)) * 31 +
Int (Calendar.Day (Now));
X2 := Int (Calendar.Seconds (Now) * Duration (1000.0));
X1 := 2 + X1 mod (K1 - 3);
X2 := 2 + X2 mod (K2 - 3);
-- Eliminate visible effects of same day starts
for J in 1 .. 5 loop
X1 := Square_Mod_N (X1, K1);
X2 := Square_Mod_N (X2, K2);
end loop;
Genp.all :=
(X1 => X1,
X2 => X2,
P => K1,
Q => K2,
X => 1,
Scl => Scal);
end Reset;
----------
-- Save --
----------
procedure Save (Gen : in Generator; To_State : out State) is
begin
To_State := Gen.Gen_State;
end Save;
------------------
-- Square_Mod_N --
------------------
function Square_Mod_N (X, N : Int) return Int is
Temp : Flt := Flt (X) * Flt (X);
Div : Int := Int (Temp / Flt (N));
begin
Div := Int (Temp - Flt (Div) * Flt (N));
if Div < 0 then
return Div + N;
else
return Div;
end if;
end Square_Mod_N;
-----------
-- Value --
-----------
function Value (Coded_State : String) return State is
Start : Positive := Coded_State'First;
Stop : Positive := Coded_State'First;
Outs : State;
begin
while Coded_State (Stop) /= ',' loop
Stop := Stop + 1;
end loop;
Outs.X1 := Int'Value (Coded_State (Start .. Stop - 1));
Start := Stop + 1;
loop
Stop := Stop + 1;
exit when Coded_State (Stop) = ',';
end loop;
Outs.X2 := Int'Value (Coded_State (Start .. Stop - 1));
Start := Stop + 1;
loop
Stop := Stop + 1;
exit when Coded_State (Stop) = ',';
end loop;
Outs.P := Int'Value (Coded_State (Start .. Stop - 1));
Outs.Q := Int'Value (Coded_State (Stop + 1 .. Coded_State'Last));
Outs.X := Euclid (Outs.P, Outs.Q);
Outs.Scl := 1.0 / (Flt (Outs.P) * Flt (Outs.Q));
-- Now do *some* sanity checks.
if Outs.Q < 31 or else Outs.P < 31
or else Outs.X1 not in 2 .. Outs.P - 1
or else Outs.X2 not in 2 .. Outs.Q - 1
then
raise Constraint_Error;
end if;
return Outs;
end Value;
end Ada.Numerics.Float_Random;
gcc/ada/a-nuflra.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . N U M E R I C S . F L O A T _ R A N D O M --
-- --
-- S p e c --
-- --
-- $Revision: 1.12 $ --
-- --
-- Copyright (C) 1992-1998 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. --
-- --
-- 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- Note: the implementation used in this package was contributed by
-- Robert Eachus. It is based on the work of L. Blum, M. Blum, and
-- M. Shub, SIAM Journal of Computing, Vol 15. No 2, May 1986. The
-- particular choices for P and Q chosen here guarantee a period of
-- 562,085,314,430,582 (about 2**49), and the generated sequence has
-- excellent randomness properties. For further details, see the
-- paper "Fast Generation of Trustworthy Random Numbers", by Robert
-- Eachus, which describes both the algorithm and the efficient
-- implementation approach used here. This paper is available at
-- the Ada Core Technologies web site (http://www.gnat.com).
with Interfaces;
package Ada.Numerics.Float_Random is
-- Basic facilities
type Generator is limited private;
subtype Uniformly_Distributed is Float range 0.0 .. 1.0;
function Random (Gen : Generator) return Uniformly_Distributed;
procedure Reset (Gen : Generator);
procedure Reset (Gen : Generator; Initiator : Integer);
-- Advanced facilities
type State is private;
procedure Save (Gen : Generator; To_State : out State);
procedure Reset (Gen : Generator; From_State : State);
Max_Image_Width : constant := 80;
function Image (Of_State : State) return String;
function Value (Coded_State : String) return State;
private
type Int is new Interfaces.Integer_32;
type Flt is digits 14;
K1 : constant := 94_833_359;
K1F : constant := 94_833_359.0;
K2 : constant := 47_416_679;
K2F : constant := 47_416_679.0;
Scal : constant := 1.0 / (K1F * K2F);
type State is record
X1 : Int := 2999 ** 2; -- Square mod p
X2 : Int := 1439 ** 2; -- Square mod q
P : Int := K1;
Q : Int := K2;
X : Int := 1;
Scl : Flt := Scal;
end record;
type Generator is limited record
Gen_State : State;
end record;
end Ada.Numerics.Float_Random;
gcc/ada/a-numaux.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . N U M E R I C S . A U X --
-- --
-- S p e c --
-- (C Library Version, non-x86) --
-- --
-- $Revision: 1.11 $ --
-- --
-- Copyright (C) 1992-1998 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This package provides the basic computational interface for the generic
-- elementary functions. The C library version interfaces with the routines
-- in the C mathematical library, and is thus quite portable, although it may
-- not necessarily meet the requirements for accuracy in the numerics annex.
-- One advantage of using this package is that it will interface directly to
-- hardware instructions, such as the those provided on the Intel x86.
-- Note: there are two versions of this package. One using the normal IEEE
-- 64-bit double format (which is this version), and one using 80-bit x86
-- long double (see file 4onumaux.ads).
package Ada.Numerics.Aux is
pragma Pure (Aux);
pragma Linker_Options ("-lm");
type Double is digits 15;
pragma Float_Representation (IEEE_Float, Double);
-- Type Double is the type used to call the C routines. Note that this
-- is IEEE format even when running on VMS with Vax_Float representation
-- since we use the IEEE version of the C library with VMS.
function Sin (X : Double) return Double;
pragma Import (C, Sin, "sin");
function Cos (X : Double) return Double;
pragma Import (C, Cos, "cos");
function Tan (X : Double) return Double;
pragma Import (C, Tan, "tan");
function Exp (X : Double) return Double;
pragma Import (C, Exp, "exp");
function Sqrt (X : Double) return Double;
pragma Import (C, Sqrt, "sqrt");
function Log (X : Double) return Double;
pragma Import (C, Log, "log");
function Acos (X : Double) return Double;
pragma Import (C, Acos, "acos");
function Asin (X : Double) return Double;
pragma Import (C, Asin, "asin");
function Atan (X : Double) return Double;
pragma Import (C, Atan, "atan");
function Sinh (X : Double) return Double;
pragma Import (C, Sinh, "sinh");
function Cosh (X : Double) return Double;
pragma Import (C, Cosh, "cosh");
function Tanh (X : Double) return Double;
pragma Import (C, Tanh, "tanh");
function Pow (X, Y : Double) return Double;
pragma Import (C, Pow, "pow");
end Ada.Numerics.Aux;
gcc/ada/a-numeri.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . N U M E R I C S --
-- --
-- S p e c --
-- --
-- $Revision: 1.5 $ --
-- --
-- This specification is adapted 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. --
-- --
------------------------------------------------------------------------------
package Ada.Numerics is
pragma Pure (Numerics);
Argument_Error : exception;
Pi : constant :=
3.14159_26535_89793_23846_26433_83279_50288_41971_69399_37511;
e : constant :=
2.71828_18284_59045_23536_02874_71352_66249_77572_47093_69996;
end Ada.Numerics;
gcc/ada/a-reatim.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- A D A . R E A L _ T I M E --
-- --
-- B o d y --
-- --
-- $Revision: 1.34 $
-- --
-- Copyright (C) 1991-2001, Florida State University --
-- --
-- GNARL 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. GNARL 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 GNARL; 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. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. It is --
-- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
-- State University (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with System.Task_Primitives.Operations;
-- used for Monotonic_Clock
package body Ada.Real_Time is
---------
-- "*" --
---------
-- Note that Constraint_Error may be propagated
function "*" (Left : Time_Span; Right : Integer) return Time_Span is
begin
return Time_Span (Duration (Left) * Right);
end "*";
function "*" (Left : Integer; Right : Time_Span) return Time_Span is
begin
return Time_Span (Left * Duration (Right));
end "*";
---------
-- "+" --
---------
-- Note that Constraint_Error may be propagated
function "+" (Left : Time; Right : Time_Span) return Time is
begin
return Time (Duration (Left) + Duration (Right));
end "+";
function "+" (Left : Time_Span; Right : Time) return Time is
begin
return Time (Duration (Left) + Duration (Right));
end "+";
function "+" (Left, Right : Time_Span) return Time_Span is
begin
return Time_Span (Duration (Left) + Duration (Right));
end "+";
---------
-- "-" --
---------
-- Note that Constraint_Error may be propagated
function "-" (Left : Time; Right : Time_Span) return Time is
begin
return Time (Duration (Left) - Duration (Right));
end "-";
function "-" (Left, Right : Time) return Time_Span is
begin
return Time_Span (Duration (Left) - Duration (Right));
end "-";
function "-" (Left, Right : Time_Span) return Time_Span is
begin
return Time_Span (Duration (Left) - Duration (Right));
end "-";
function "-" (Right : Time_Span) return Time_Span is
begin
return Time_Span_Zero - Right;
end "-";
---------
-- "/" --
---------
-- Note that Constraint_Error may be propagated
function "/" (Left, Right : Time_Span) return Integer is
begin
return Integer (Duration (Left) / Duration (Right));
end "/";
function "/" (Left : Time_Span; Right : Integer) return Time_Span is
begin
return Time_Span (Duration (Left) / Right);
end "/";
-----------
-- Clock --
-----------
function Clock return Time is
begin
return Time (System.Task_Primitives.Operations.Monotonic_Clock);
end Clock;
------------------
-- Microseconds --
------------------
function Microseconds (US : Integer) return Time_Span is
begin
return Time_Span_Unit * US * 1_000;
end Microseconds;
------------------
-- Milliseconds --
------------------
function Milliseconds (MS : Integer) return Time_Span is
begin
return Time_Span_Unit * MS * 1_000_000;
end Milliseconds;
-----------------
-- Nanoseconds --
-----------------
function Nanoseconds (NS : Integer) return Time_Span is
begin
return Time_Span_Unit * NS;
end Nanoseconds;
-----------
-- Split --
-----------
procedure Split (T : Time; SC : out Seconds_Count; TS : out Time_Span) is
begin
-- Extract the integer part of T
if T = 0.0 then
SC := 0;
else
SC := Seconds_Count (Time_Span'(T - 0.5));
end if;
-- Since we loose precision when converting a time value to float,
-- we need to add this check
if Time (SC) > T then
SC := SC - 1;
end if;
TS := T - Time (SC);
end Split;
-------------
-- Time_Of --
-------------
function Time_Of (SC : Seconds_Count; TS : Time_Span) return Time is
begin
return Time (SC) + TS;
end Time_Of;
-----------------
-- To_Duration --
-----------------
function To_Duration (TS : Time_Span) return Duration is
begin
return Duration (TS);
end To_Duration;
------------------
-- To_Time_Span --
------------------
function To_Time_Span (D : Duration) return Time_Span is
begin
return Time_Span (D);
end To_Time_Span;
end Ada.Real_Time;
gcc/ada/ada.ads 0 → 100644
This diff is collapsed. Click to expand it.
gcc/ada/ada.h 0 → 100644
This diff is collapsed. Click to expand it.
gcc/ada/ali.adb 0 → 100644
This diff is collapsed. Click to expand it.
gcc/ada/ali.ads 0 → 100644
This diff is collapsed. Click to expand it.
gcc/ada/argv.c 0 → 100644
This diff is collapsed. Click to expand it.
gcc/ada/atree.adb 0 → 100644
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/atree.h 0 → 100644
This diff is collapsed. Click to expand it.
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