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

Resync. 

From-SVN: r118333
This commit is contained in:
Arnaud Charlet 2006-10-31 19:21:54 +01:00
parent ea7339d1fb
commit b5ace3b783
14 changed files with 1829 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1505
gcc/ada/a-crdlli.adb Normal file
View File

File diff suppressed because it is too large Load Diff

220
gcc/ada/a-crdlli.ads Normal file
View File

@ -0,0 +1,220 @@
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
-- A D A . C O N T A I N E R S . --
-- R E S R I C T E D _ D O U B L Y _ L I N K E D _ L I S T S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2006, 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, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
generic
type Element_Type is private;
with function "=" (Left, Right : Element_Type)
return Boolean is <>;
package Ada.Containers.Restricted_Doubly_Linked_Lists is
pragma Pure;
type List (Capacity : Count_Type) is tagged limited private;
pragma Preelaborable_Initialization (List);
type Cursor is private;
pragma Preelaborable_Initialization (Cursor);
Empty_List : constant List;
No_Element : constant Cursor;
function "=" (Left, Right : List) return Boolean;
procedure Assign (Target : in out List; Source : List);
function Length (Container : List) return Count_Type;
function Is_Empty (Container : List) return Boolean;
procedure Clear (Container : in out List);
function Element (Position : Cursor) return Element_Type;
procedure Replace_Element
(Container : in out List;
Position : Cursor;
New_Item : Element_Type);
procedure Query_Element
(Position : Cursor;
Process : not null access procedure (Element : Element_Type));
procedure Update_Element
(Container : in out List;
Position : Cursor;
Process : not null access procedure (Element : in out Element_Type));
procedure Insert
(Container : in out List;
Before : Cursor;
New_Item : Element_Type;
Count : Count_Type := 1);
procedure Insert
(Container : in out List;
Before : Cursor;
New_Item : Element_Type;
Position : out Cursor;
Count : Count_Type := 1);
procedure Insert
(Container : in out List;
Before : Cursor;
Position : out Cursor;
Count : Count_Type := 1);
procedure Prepend
(Container : in out List;
New_Item : Element_Type;
Count : Count_Type := 1);
procedure Append
(Container : in out List;
New_Item : Element_Type;
Count : Count_Type := 1);
procedure Delete
(Container : in out List;
Position : in out Cursor;
Count : Count_Type := 1);
procedure Delete_First
(Container : in out List;
Count : Count_Type := 1);
procedure Delete_Last
(Container : in out List;
Count : Count_Type := 1);
procedure Reverse_Elements (Container : in out List);
procedure Swap
(Container : in out List;
I, J : Cursor);
procedure Swap_Links
(Container : in out List;
I, J : Cursor);
procedure Splice
(Container : in out List;
Before : Cursor;
Position : in out Cursor);
function First (Container : List) return Cursor;
function First_Element (Container : List) return Element_Type;
function Last (Container : List) return Cursor;
function Last_Element (Container : List) return Element_Type;
function Next (Position : Cursor) return Cursor;
procedure Next (Position : in out Cursor);
function Previous (Position : Cursor) return Cursor;
procedure Previous (Position : in out Cursor);
function Find
(Container : List;
Item : Element_Type;
Position : Cursor := No_Element) return Cursor;
function Reverse_Find
(Container : List;
Item : Element_Type;
Position : Cursor := No_Element) return Cursor;
function Contains
(Container : List;
Item : Element_Type) return Boolean;
function Has_Element (Position : Cursor) return Boolean;
procedure Iterate
(Container : List;
Process : not null access procedure (Position : Cursor));
procedure Reverse_Iterate
(Container : List;
Process : not null access procedure (Position : Cursor));
generic
with function "<" (Left, Right : Element_Type) return Boolean is <>;
package Generic_Sorting is
function Is_Sorted (Container : List) return Boolean;
procedure Sort (Container : in out List);
end Generic_Sorting;
private
type Node_Type is limited record
Prev : Count_Type'Base;
Next : Count_Type;
Element : Element_Type;
end record;
type Node_Array is array (Count_Type range <>) of Node_Type;
type List (Capacity : Count_Type) is tagged limited record
Nodes : Node_Array (1 .. Capacity) := (others => <>);
Free : Count_Type'Base := -1;
First : Count_Type := 0;
Last : Count_Type := 0;
Length : Count_Type := 0;
end record;
Empty_List : constant List := (0, others => <>);
type List_Access is access all List;
for List_Access'Storage_Size use 0;
type Cursor is
record
Container : List_Access;
Node : Count_Type := 0;
end record;
No_Element : constant Cursor := (null, 0);
end Ada.Containers.Restricted_Doubly_Linked_Lists;

6
gcc/ada/a-wtenio.adb
View File

@ -44,11 +44,9 @@ package body Ada.Wide_Text_IO.Enumeration_IO is
procedure Get (File : File_Type; Item : out Enum) is
Buf : Wide_String (1 .. Enum'Width);
Buflen : Natural;
begin
Aux.Get_Enum_Lit (File, Buf, Buflen);
Item := Enum'Wide_Value (Buf (1 .. Buflen));
exception
when Constraint_Error => raise Data_Error;
end Get;
@ -64,11 +62,9 @@ package body Ada.Wide_Text_IO.Enumeration_IO is
Last : out Positive)
is
Start : Natural;
begin
Aux.Scan_Enum_Lit (From, Start, Last);
Item := Enum'Wide_Value (From (Start .. Last));
exception
when Constraint_Error => raise Data_Error;
end Get;
@ -84,7 +80,6 @@ package body Ada.Wide_Text_IO.Enumeration_IO is
Set : Type_Set := Default_Setting)
is
Image : constant Wide_String := Enum'Wide_Image (Item);
begin
Aux.Put (File, Image, Width, Set);
end Put;
@ -104,7 +99,6 @@ package body Ada.Wide_Text_IO.Enumeration_IO is
Set : Type_Set := Default_Setting)
is
Image : constant Wide_String := Enum'Wide_Image (Item);
begin
Aux.Puts (To, Image, Set);
end Put;

9
gcc/ada/elists.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -186,7 +186,6 @@ package body Elists is
N : constant Union_Id := Elmts.Table (Elmt).Next;
begin
pragma Assert (Elmt /= No_Elmt);
Elmts.Increment_Last;
@ -301,11 +300,11 @@ package body Elists is
return Elmt = No_Elmt;
end No;
-----------
----------
-- Node --
-----------
----------
function Node (Elmt : Elmt_Id) return Node_Id is
function Node (Elmt : Elmt_Id) return Node_Or_Entity_Id is
begin
if Elmt = No_Elmt then
return Empty;

22
gcc/ada/exp_tss.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -172,20 +172,20 @@ package Exp_Tss is
procedure Set_TSS (Typ : Entity_Id; TSS : Entity_Id);
-- This procedure is used to install a newly created TSS. The second
-- argument is the entity for such a new TSS. This entity is placed in
-- the TSS list for the type given as the first argument, replacing an
-- old entry of the same name if one was present. The tree for the body
-- of this TSS, which is not analyzed yet, is placed in the actions field
-- of the freeze node for the type. All such bodies are inserted into the
-- main tree and analyzed at the point at which the freeze node itself is
-- is expanded.
-- argument is the entity for such a new TSS. This entity is placed in the
-- TSS list for the type given as the first argument, replacing an old
-- entry of the same name if one was present. The tree for the body of this
-- TSS, which is not analyzed yet, is placed in the actions field of the
-- freeze node for the type. All such bodies are inserted into the main
-- tree and analyzed at the point at which the freeze node itself is
-- expanded.
procedure Copy_TSS (TSS : Entity_Id; Typ : Entity_Id);
-- Given an existing TSS for another type (which is already installed,
-- analyzed and expanded), install it as the corresponding TSS for Typ.
-- Note that this just copies a reference, not the tree. This can also
-- be used to initially install a TSS in the case where the subprogram
-- for the TSS has already been created and its declaration processed.
-- Note that this just copies a reference, not the tree. This can also be
-- used to initially install a TSS in the case where the subprogram for the
-- TSS has already been created and its declaration processed.
function Init_Proc (Typ : Entity_Id) return Entity_Id;
pragma Inline (Init_Proc);

2
gcc/ada/fname.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --

29
gcc/ada/gnatvsn.ads
View File

@ -45,7 +45,7 @@ package Gnatvsn is
-- Static string identifying this version, that can be used as an argument
-- to e.g. pragma Ident.
type Gnat_Build_Type is (FSF, Public, GAP);
type Gnat_Build_Type is (FSF, GPL);
-- See Get_Gnat_Build_Type below for the meaning of these values.
function Get_Gnat_Build_Type return Gnat_Build_Type;
@ -53,28 +53,25 @@ package Gnatvsn is
--
-- FSF
-- GNAT FSF version. This version of GNAT is part of a Free Software
-- Foundation release of the GNU Compiler Collection (GCC). The binder
-- will not output informational messages regarding intended use,
-- and the bug box generated by Comperr will give information on
-- how to report bugs and list the "no warranty" information.
-- Foundation release of the GNU Compiler Collection (GCC). The bug
-- box generated by Comperr gives information on how to report bugs
-- and list the "no warranty" information.
--
-- Public
-- GNAT Public version.
-- The binder will output informational messages, and the bug box
-- generated by the package Comperr will give appropriate bug
-- submission instructions.
--
-- GAP
-- GNAT Academic Program, similar to Public.
-- GPL
-- GNAT GPL Edition. This is a special version of GNAT, released by
-- Ada Core Technologies and intended for academic users, and free
-- software developers. The bug box generated by the package Comperr
-- gives appropriate bug submission instructions that do not reference
-- customer number etc.
Ver_Len_Max : constant := 32;
Ver_Len_Max : constant := 64;
-- Longest possible length for Gnat_Version_String in this or any
-- other version of GNAT. This is used by the binder to establish
-- space to store any possible version string value for checks. This
-- value should never be decreased in the future, but it would be
-- OK to increase it if absolutely necessary.
Library_Version : constant String := "4.2";
Library_Version : constant String := "4.3";
-- Library version. This value must be updated whenever any change to the
-- compiler affects the library formats in such a way as to obsolete
-- previously compiled library modules.
@ -85,7 +82,7 @@ package Gnatvsn is
Verbose_Library_Version : constant String := "GNAT Lib v" & Library_Version;
-- Version string stored in e.g. ALI files.
ASIS_Version_Number : constant := 5;
ASIS_Version_Number : constant := 6;
-- ASIS Version. This is used to check for consistency between the compiler
-- used to generate trees, and an ASIS application that is reading the
-- trees. It must be updated (incremented) whenever a change is made to

2
gcc/ada/impunit.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2005 Free Software Foundation, Inc. --
-- Copyright (C) 2000-2005, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --

2
gcc/ada/initialize.c
View File

@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
* Copyright (C) 1992-2005, Free Software Foundation, Inc. *
* Copyright (C) 1992-2006, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *

47
gcc/ada/s-dsaser.ads Normal file
View File

@ -0,0 +1,47 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- S Y S T E M . D S A _ S E R V I C E S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2006, 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, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package is for distributed system annex services, which require the
-- partition communication sub-system to be initialized before they are used.
with System.Partition_Interface;
with System.RPC;
package System.DSA_Services is
function Get_Active_Partition_ID
(Name : Partition_Interface.Unit_Name) return RPC.Partition_ID
renames Partition_Interface.Get_Active_Partition_ID;
-- Returns the partition ID of the partition in which Name resides
end System.DSA_Services;

5
gcc/ada/s-imgdec.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -39,8 +39,7 @@ package System.Img_Dec is
function Image_Decimal
(V : Integer;
Scale : Integer)
return String;
Scale : Integer) return String;
-- Compute 'Image of V, the integer value (in units of delta) of a decimal
-- type whose Scale is as given and return the result. THe image is given
-- by the rules in RM 3.5(34) for fixed-point type image functions.

28
gcc/ada/s-osinte-vms.ads
View File

@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2006, 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- --
@ -121,10 +121,10 @@ package System.OS_Interface is
procedure Sys_Assign
(Status : out Cond_Value_Type;
Devnam : in String;
Devnam : String;
Chan : out unsigned_short;
Acmode : in unsigned_short := 0;
Mbxnam : in String := String'Null_Parameter;
Mbxnam : String := String'Null_Parameter;
Flags : in unsigned_long := 0);
pragma Interface (External, Sys_Assign);
pragma Import_Valued_Procedure
@ -147,7 +147,7 @@ package System.OS_Interface is
--
procedure Sys_Cantim
(Status : out Cond_Value_Type;
Reqidt : in Address;
Reqidt : Address;
Acmode : in unsigned);
pragma Interface (External, Sys_Cantim);
pragma Import_Valued_Procedure
@ -173,13 +173,13 @@ package System.OS_Interface is
--
procedure Sys_Crembx
(Status : out Cond_Value_Type;
Prmflg : in Boolean;
Prmflg : Boolean;
Chan : out unsigned_short;
Maxmsg : in unsigned_long := 0;
Bufquo : in unsigned_long := 0;
Promsk : in unsigned_short := 0;
Acmode : in unsigned_short := 0;
Lognam : in String;
Lognam : String;
Flags : in unsigned_long := 0);
pragma Interface (External, Sys_Crembx);
pragma Import_Valued_Procedure
@ -212,8 +212,8 @@ package System.OS_Interface is
Chan : in unsigned_short;
Func : in unsigned_long := 0;
Iosb : out IO_Status_Block_Type;
Astadr : in AST_Handler := No_AST_Handler;
Astprm : in Address := Null_Address;
Astadr : AST_Handler := No_AST_Handler;
Astprm : Address := Null_Address;
P1 : in unsigned_long := 0;
P2 : in unsigned_long := 0;
P3 : in unsigned_long := 0;
@ -226,9 +226,9 @@ package System.OS_Interface is
EFN : in unsigned_long := 0;
Chan : in unsigned_short;
Func : in unsigned_long := 0;
Iosb : in Address := Null_Address;
Astadr : in AST_Handler := No_AST_Handler;
Astprm : in Address := Null_Address;
Iosb : Address := Null_Address;
Astadr : AST_Handler := No_AST_Handler;
Astprm : Address := Null_Address;
P1 : in unsigned_long := 0;
P2 : in unsigned_long := 0;
P3 : in unsigned_long := 0;
@ -275,9 +275,9 @@ package System.OS_Interface is
procedure Sys_Setimr
(Status : out Cond_Value_Type;
EFN : in unsigned_long;
Tim : in Long_Integer;
AST : in AST_Handler;
Reqidt : in Address;
Tim : Long_Integer;
AST : AST_Handler;
Reqidt : Address;
Flags : in unsigned_long);
pragma Interface (External, Sys_Setimr);
pragma Import_Valued_Procedure

2
gcc/ada/sem_ch13.ads
View File

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

17
gcc/ada/system-linux-ppc.ads
View File

@ -5,9 +5,9 @@
-- S Y S T E M --
-- --
-- S p e c --
-- (GNU-Linux/PPC Version) --
-- (GNU-Linux/PPC Version) --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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 --
@ -88,17 +88,18 @@ package System is
type Bit_Order is (High_Order_First, Low_Order_First);
Default_Bit_Order : constant Bit_Order := High_Order_First;
pragma Warnings (Off, Default_Bit_Order); -- kill constant condition warning
-- Priority-related Declarations (RM D.1)
Max_Priority : constant Positive := 30;
Max_Interrupt_Priority : constant Positive := 31;
Max_Priority : constant Positive := 97;
Max_Interrupt_Priority : constant Positive := 98;
subtype Any_Priority is Integer range 0 .. 31;
subtype Priority is Any_Priority range 0 .. 30;
subtype Interrupt_Priority is Any_Priority range 31 .. 31;
subtype Any_Priority is Integer range 0 .. 98;
subtype Priority is Any_Priority range 0 .. 97;
subtype Interrupt_Priority is Any_Priority range 98 .. 98;
Default_Priority : constant Priority := 15;
Default_Priority : constant Priority := 48;
private