-- --
-- S p e c --
-- --
--- Copyright (C) 2006, Free Software Foundation, Inc. --
--- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
package Ada.Dispatching.Round_Robin is
+ pragma Unimplemented_Unit;
+
Default_Quantum : constant Ada.Real_Time.Time_Span :=
Ada.Real_Time.Milliseconds (10);
Create_Binder_Output (Filename, 's', Bfiles);
+ -- We always compile the binder file in Ada 95 mode so that we properly
+ -- handle use of Ada 2005 keywords as identifiers in Ada 95 mode. None
+ -- of the Ada 2005 constructs are needed by the binder file.
+
+ WBI ("pragma Ada_95;");
+
-- If we are operating in Restrictions (No_Exception_Handlers) mode,
-- then we need to make sure that the binder program is compiled with
-- the same restriction, so that no exception tables are generated.
Create_Binder_Output (Filename, 'b', Bfileb);
+ -- We always compile the binder file in Ada 95 mode so that we properly
+ -- handle use of Ada 2005 keywords as identifiers in Ada 95 mode. None
+ -- of the Ada 2005 constructs are needed by the binder file.
+
+ WBI ("pragma Ada_95;");
+
-- Output Source_File_Name pragmas which look like
-- pragma Source_File_Name (Ada_Main, Spec_File_Name => "sss");
Table_Name => "Elists");
type Elmt_Item is record
- Node : Node_Id;
+ Node : Node_Or_Entity_Id;
Next : Union_Id;
end record;
-- Append_Elmt --
-----------------
- procedure Append_Elmt (Node : Node_Id; To : Elist_Id) is
+ procedure Append_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is
L : constant Elmt_Id := Elists.Table (To).Last;
begin
Elmts.Increment_Last;
- Elmts.Table (Elmts.Last).Node := Node;
+ Elmts.Table (Elmts.Last).Node := N;
Elmts.Table (Elmts.Last).Next := Union_Id (To);
if L = No_Elmt then
Write_Int (Int (Elmts.Last));
Write_Str (" to list Elist_Id = ");
Write_Int (Int (To));
- Write_Str (" referencing Node_Id = ");
- Write_Int (Int (Node));
+ Write_Str (" referencing Node_Or_Entity_Id = ");
+ Write_Int (Int (N));
Write_Eol;
end if;
end Append_Elmt;
+ ------------------------
+ -- Append_Unique_Elmt --
+ ------------------------
+
+ procedure Append_Unique_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is
+ Elmt : Elmt_Id;
+ begin
+ Elmt := First_Elmt (To);
+ loop
+ if No (Elmt) then
+ Append_Elmt (N, To);
+ return;
+ elsif Node (Elmt) = N then
+ return;
+ else
+ Next_Elmt (Elmt);
+ end if;
+ end loop;
+ end Append_Unique_Elmt;
+
--------------------
-- Elists_Address --
--------------------
-- Insert_Elmt_After --
-----------------------
- procedure Insert_Elmt_After (Node : Node_Id; Elmt : Elmt_Id) is
- N : constant Union_Id := Elmts.Table (Elmt).Next;
+ procedure Insert_Elmt_After (N : Node_Or_Entity_Id; Elmt : Elmt_Id) is
+ Nxt : constant Union_Id := Elmts.Table (Elmt).Next;
begin
pragma Assert (Elmt /= No_Elmt);
Elmts.Increment_Last;
- Elmts.Table (Elmts.Last).Node := Node;
- Elmts.Table (Elmts.Last).Next := N;
+ Elmts.Table (Elmts.Last).Node := N;
+ Elmts.Table (Elmts.Last).Next := Nxt;
Elmts.Table (Elmt).Next := Union_Id (Elmts.Last);
- if N in Elist_Range then
- Elists.Table (Elist_Id (N)).Last := Elmts.Last;
+ if Nxt in Elist_Range then
+ Elists.Table (Elist_Id (Nxt)).Last := Elmts.Last;
end if;
end Insert_Elmt_After;
-- Prepend_Elmt --
------------------
- procedure Prepend_Elmt (Node : Node_Id; To : Elist_Id) is
+ procedure Prepend_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is
F : constant Elmt_Id := Elists.Table (To).First;
begin
Elmts.Increment_Last;
- Elmts.Table (Elmts.Last).Node := Node;
+ Elmts.Table (Elmts.Last).Node := N;
if F = No_Elmt then
Elists.Table (To).Last := Elmts.Last;
end if;
Elists.Table (To).First := Elmts.Last;
-
end Prepend_Elmt;
-------------
-- Replace_Elmt --
------------------
- procedure Replace_Elmt (Elmt : Elmt_Id; New_Node : Node_Id) is
+ procedure Replace_Elmt (Elmt : Elmt_Id; New_Node : Node_Or_Entity_Id) is
begin
Elmts.Table (Elmt).Node := New_Node;
end Replace_Elmt;
-- This function determines if a given tree id references an element list
-- that contains no items.
- procedure Append_Elmt (Node : Node_Id; To : Elist_Id);
- -- Appends Node at the end of To, allocating a new element
+ procedure Append_Elmt (N : Node_Or_Entity_Id; To : Elist_Id);
+ -- Appends N at the end of To, allocating a new element. N must be a
+ -- non-empty node or entity Id, and To must be an Elist (not No_Elist).
- procedure Prepend_Elmt (Node : Node_Id; To : Elist_Id);
- -- Appends Node at the beginning of To, allocating a new element
+ procedure Append_Unique_Elmt (N : Node_Or_Entity_Id; To : Elist_Id);
+ -- Like Append_Elmt, except that a check is made to see if To already
+ -- contains N and if so the call has no effect.
- procedure Insert_Elmt_After (Node : Node_Id; Elmt : Elmt_Id);
- -- Add a new element (Node) right after the pre-existing element Elmt
+ procedure Prepend_Elmt (N : Node_Or_Entity_Id; To : Elist_Id);
+ -- Appends N at the beginning of To, allocating a new element
+
+ procedure Insert_Elmt_After (N : Node_Or_Entity_Id; Elmt : Elmt_Id);
+ -- Add a new element (N) right after the pre-existing element Elmt
-- It is invalid to call this subprogram with Elmt = No_Elmt.
- procedure Replace_Elmt (Elmt : Elmt_Id; New_Node : Node_Id);
+ procedure Replace_Elmt (Elmt : Elmt_Id; New_Node : Node_Or_Entity_Id);
pragma Inline (Replace_Elmt);
-- Causes the given element of the list to refer to New_Node, the node
-- which was previously referred to by Elmt is effectively removed from
-- --
-- S p e c --
-- --
--- 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- --
Subunit : Boolean;
May_Fail : Boolean := False) return File_Name_Type;
-- This function returns the file name that corresponds to a given unit
- -- name, Uname. The Subunit parameter is set True for subunits, and
- -- false for all other kinds of units. The caller is responsible for
- -- ensuring that the unit name meets the requirements given in package
- -- Uname and described above.
+ -- name, Uname. The Subunit parameter is set True for subunits, and false
+ -- for all other kinds of units. The caller must ensure that the unit name
+ -- meets the requirements given in package Uname.
--
-- When May_Fail is True, if the file cannot be found, this function
-- returns No_File. When it is False, if the file cannot be found,
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2006 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
with System; use System;
with Types; use Types;
-pragma Elaborate (GNAT.OS_Lib);
+pragma Elaborate_All (GNAT.OS_Lib);
+-- For the call to function Get_Target_Object_Suffix in the private part
package Osint is
-- Unit number of loaded unit
Limited_With_Found : Boolean := False;
- -- Set True if a limited WITH is found, used to ???
+ -- We load the context items in two rounds: the first round handles normal
+ -- withed units and the second round handles Ada 2005 limited-withed units.
+ -- This is required to allow the low-level circuitry that detects circular
+ -- dependencies of units the correct notification of errors (see comment
+ -- bellow). This variable is used to indicate that the second round is
+ -- required.
function Same_File_Name_Except_For_Case
(Expected_File_Name : File_Name_Type;
-- --
-- S p e c --
-- --
--- 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- --
-- unit has has the same version than the caller's one.
function Same_Partition
- (Left : access RACW_Stub_Type;
- Right : access RACW_Stub_Type) return Boolean;
+ (Left : not null access RACW_Stub_Type;
+ Right : not null access RACW_Stub_Type) return Boolean;
-- Determine whether Left and Right correspond to objects instantiated
-- on the same partition, for enforcement of E.4(19).
generic
RCI_Name : String;
+ Version : String;
package RCI_Locator is
+ pragma Unreferenced (Version);
+
function Get_RCI_Package_Receiver return Interfaces.Unsigned_64;
function Get_Active_Partition_ID return RPC.Partition_ID;
end RCI_Locator;
-- --
-- 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- --
Default_Secondary_Stack_Size : Natural := 10 * 1024;
-- Default size of a secondary stack. May be modified by binder -D switch
+ -- which causes the binder to generate an appropriate assignment in the
+ -- binder generated file.
procedure SS_Init
(Stk : in out Address;
-- --
-- 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- --
------------------------------------------------------------------------------
-- This package contains a set of subprogram access variables that access
--- some low-level primitives that are called different depending whether
--- tasking is involved or not (e.g. the Get/Set_Jmpbuf_Address that needs
--- to provide a different value for each task). To avoid dragging in the
--- tasking all the time, we use a system of soft links where the links are
--- initialized to non-tasking versions, and then if the tasking is
--- initialized, they are reset to the real tasking versions.
+-- some low-level primitives that are different depending whether tasking is
+-- involved or not (e.g. the Get/Set_Jmpbuf_Address that needs to provide a
+-- different value for each task). To avoid dragging in the tasking runtimes
+-- all the time, we use a system of soft links where the links are
+-- initialized to non-tasking versions, and then if the tasking support is
+-- initialized, they are set to the real tasking versions.
with Ada.Exceptions;
with System.Stack_Checking;
-- First we have the access subprogram types used to establish the links.
-- The approach is to establish variables containing access subprogram
- -- values which by default point to dummy no tasking versions of routines.
+ -- values, which by default point to dummy no tasking versions of routines.
type No_Param_Proc is access procedure;
type Addr_Param_Proc is access procedure (Addr : Address);
type Task_Name_Call is access
function return String;
- -- Suppress checks on all these types, since we know corrresponding
+ -- Suppress checks on all these types, since we know the corrresponding
-- values can never be null (the soft links are always initialized).
pragma Suppress (Access_Check, No_Param_Proc);
-- uses this.
procedure Update_Exception_NT (X : EO := Current_Target_Exception);
- -- Handle exception setting. This routine is provided for targets which
+ -- Handle exception setting. This routine is provided for targets that
-- have built-in exception handling such as the Java Virtual Machine.
-- Currently, only JGNAT uses this. See 4jexcept.ads for an explanation on
-- how this routine is used.
-- Master_Id Soft-Links --
--------------------------
- -- Soft-Links are used for procedures that manipulate Master_Ids because
+ -- Soft-Links are used for procedures that manipulate Master_Ids because
-- a Master_Id must be generated for access to limited class-wide types,
-- whose root may be extended with task components.
procedure W_U (Stream : not null access RST; Item : UST.Unsigned);
procedure W_WC (Stream : not null access RST; Item : Wide_Character);
- ----------------------------
- -- Composite Input/Output --
- ----------------------------
-
- -- The following Boolean constant is defined and set to True only if the
- -- stream representation of a series of elementary items of the same
- -- type (one of the types handled by the above procedures) has the same
- -- representation as an array of such items in memory. This allows such
- -- a series of items to be read or written as a block, instead of
- -- element by element.
-
- -- If the stream representation does not have this property for all the
- -- above types, then this constant can be omitted or set to False,
- -- and the front end will generate element-by-element operations.
-
- -- This interface assumes that a Stream_Element has the same size as
- -- a Storage_Unit. If that is not the case, then this flag should
- -- also be omitted (or set to False).
-
- Block_Stream_Ops_OK : constant Boolean := True;
- -- Set to False if block stream operations not permitted
-
private
pragma Inline (I_AD);
pragma Inline (I_AS);
-- 4. Adjust definition of WC_Longest_Sequence if necessary
-- 5. Add an entry in WC_Encoding_Letters for the new method
-- 6. Add proper code to s-wchstw.adb, s-wchwts.adb, s-widwch.adb
+ -- 7. Update documentation (remember section on form strings)
-- Note that the WC_Encoding_Method values must be kept ordered so that
-- the definitions of the subtypes WC_Upper_Half_Encoding_Method and
if Ekind (E) in Subprogram_Kind then
Declaration := Unit_Declaration_Node (E);
- if False
- or else Nkind (Declaration) = N_Subprogram_Body
- or else Nkind (Declaration) = N_Subprogram_Renaming_Declaration
+ if Nkind (Declaration) = N_Subprogram_Body
+ or else
+ Nkind (Declaration) = N_Subprogram_Renaming_Declaration
then
Specification := Corresponding_Spec (Declaration);
end if;
-- Enforce constraints on primitive operations of the designated type of
-- an RACW. Note that since the complete set of primitive operations of the
-- designated type needs to be known, we must defer these checks until the
- -- desgianted type is frozen.
+ -- designated type is frozen.
end Sem_Cat;
elsif N = Error_Name then
Print_Str ("<Error_Name>");
- else
+ elsif Is_Valid_Name (N) then
Get_Name_String (N);
Print_Char ('"');
Write_Name (N);
Print_Char ('"');
+
+ else
+ Print_Str ("<invalid name ???>");
end if;
end if;
end Print_Name;
Notes := False;
+ if N not in
+ Atree_Private_Part.Nodes.First .. Atree_Private_Part.Nodes.Last then
+ Print_Str (" (no such node)");
+ Print_Eol;
+ return;
+ end if;
+
if Comes_From_Source (N) then
Notes := True;
Print_Str (" (source");
projects / gcc.git / commitdiff