-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
--------------------------
procedure Delete_Key_Sans_Free
- (HT : in out Hash_Table_Type;
- Key : Key_Type;
- X : out Node_Access)
+ (HT : in out Hash_Table_Type;
+ Key : Key_Type;
+ X : out Node_Access)
is
Indx : Hash_Type;
Prev : Node_Access;
if Equivalent_Keys (Key, X) then
if HT.Busy > 0 then
- raise Program_Error;
+ raise Program_Error with
+ "attempt to tamper with elements (container is busy)";
end if;
HT.Buckets (Indx) := Next (X);
HT.Length := HT.Length - 1;
if Equivalent_Keys (Key, X) then
if HT.Busy > 0 then
- raise Program_Error;
+ raise Program_Error with
+ "attempt to tamper with elements (container is busy)";
end if;
Set_Next (Node => Prev, Next => Next (X));
HT.Length := HT.Length - 1;
begin
if B = null then
if HT.Busy > 0 then
- raise Program_Error;
+ raise Program_Error with
+ "attempt to tamper with elements (container is busy)";
end if;
if HT.Length = Count_Type'Last then
end loop;
if HT.Busy > 0 then
- raise Program_Error;
+ raise Program_Error with
+ "attempt to tamper with elements (container is busy)";
end if;
if HT.Length = Count_Type'Last then
return Hash (Key) mod HT.Buckets'Length;
end Index;
- ---------------------
- -- Replace_Element --
- ---------------------
+ -----------------------------
+ -- Generic_Replace_Element --
+ -----------------------------
procedure Generic_Replace_Element
(HT : in out Hash_Table_Type;
Node : Node_Access;
Key : Key_Type)
is
- begin
pragma Assert (HT.Length > 0);
+ pragma Assert (Node /= null);
+
+ Old_Hash : constant Hash_Type := Hash (Node);
+ Old_Indx : constant Hash_Type := Old_Hash mod HT.Buckets'Length;
+
+ New_Hash : constant Hash_Type := Hash (Key);
+ New_Indx : constant Hash_Type := New_Hash mod HT.Buckets'Length;
+ New_Bucket : Node_Access renames HT.Buckets (New_Indx);
+ N, M : Node_Access;
+
+ begin
if Equivalent_Keys (Key, Node) then
- pragma Assert (Hash (Key) = Hash (Node));
+ pragma Assert (New_Hash = Old_Hash);
if HT.Lock > 0 then
raise Program_Error with
"attempt to tamper with cursors (container is locked)";
end if;
+ -- We can change a node's key to Key (that's what Assign is for), but
+ -- only if Key is not already in the hash table. (In a unique-key
+ -- hash table as this one a key is mapped to exactly one node only.)
+ -- The exception is when Key is mapped to Node, in which case the
+ -- change is allowed.
+
Assign (Node, Key);
+ pragma Assert (Hash (Node) = New_Hash);
+ pragma Assert (Equivalent_Keys (Key, Node));
return;
end if;
- declare
- J : Hash_Type;
- K : constant Hash_Type := Index (HT, Key);
- B : Node_Access renames HT.Buckets (K);
- N : Node_Access := B;
- M : Node_Access;
+ -- Key is not equivalent to Node, so we now have to determine if it's
+ -- equivalent to some other node in the hash table. This is the case
+ -- irrespective of whether Key is in the same or a different bucket from
+ -- Node.
- begin
- while N /= null loop
- if Equivalent_Keys (Key, N) then
- raise Program_Error with
- "attempt to replace existing element";
- end if;
-
- N := Next (N);
- end loop;
+ N := New_Bucket;
+ while N /= null loop
+ if Equivalent_Keys (Key, N) then
+ pragma Assert (N /= Node);
+ raise Program_Error with
+ "attempt to replace existing element";
+ end if;
- J := Hash (Node);
+ N := Next (N);
+ end loop;
- if J = K then
- if HT.Lock > 0 then
- raise Program_Error with
- "attempt to tamper with cursors (container is locked)";
- end if;
+ -- We have determined that Key is not already in the hash table, so
+ -- the change is tenatively allowed. We now perform the standard
+ -- checks to determine whether the hash table is locked (because you
+ -- cannot change an element while it's in use by Query_Element or
+ -- Update_Element), or if the container is busy (because moving a
+ -- node to a different bucket would interfere with iteration).
- Assign (Node, Key);
- return;
- end if;
+ if Old_Indx = New_Indx then
+ -- The node is already in the bucket implied by Key. In this case
+ -- we merely change its value without moving it.
- if HT.Busy > 0 then
+ if HT.Lock > 0 then
raise Program_Error with
- "attempt to tamper with elements (container is busy)";
+ "attempt to tamper with cursors (container is locked)";
end if;
Assign (Node, Key);
+ pragma Assert (Hash (Node) = New_Hash);
+ pragma Assert (Equivalent_Keys (Key, Node));
+ return;
+ end if;
- N := HT.Buckets (J);
- pragma Assert (N /= null);
+ -- The node is a bucket different from the bucket implied by Key.
- if N = Node then
- HT.Buckets (J) := Next (Node);
+ if HT.Busy > 0 then
+ raise Program_Error with
+ "attempt to tamper with elements (container is busy)";
+ end if;
- else
- pragma Assert (HT.Length > 1);
+ -- Do the assignment first, before moving the node, so that if Assign
+ -- propagates an exception, then the hash table will not have been
+ -- modified (except for any possible side-effect Assign had on Node).
- loop
- M := Next (N);
- pragma Assert (M /= null);
+ Assign (Node, Key);
+ pragma Assert (Hash (Node) = New_Hash);
+ pragma Assert (Equivalent_Keys (Key, Node));
- if M = Node then
- Set_Next (Node => N, Next => Next (Node));
- exit;
- end if;
+ -- Now we can safely remove the node from its current bucket
- N := M;
- end loop;
- end if;
+ N := HT.Buckets (Old_Indx);
+ pragma Assert (N /= null);
- Set_Next (Node => Node, Next => B);
- B := Node;
- end;
+ if N = Node then
+ HT.Buckets (Old_Indx) := Next (Node);
+
+ else
+ pragma Assert (HT.Length > 1);
+
+ loop
+ M := Next (N);
+ pragma Assert (M /= null);
+
+ if M = Node then
+ Set_Next (Node => N, Next => Next (Node));
+ exit;
+ end if;
+
+ N := M;
+ end loop;
+ end if;
+
+ -- Now we link the node into its new bucket (corresponding to Key)
+
+ Set_Next (Node => Node, Next => New_Bucket);
+ New_Bucket := Node;
end Generic_Replace_Element;
end Ada.Containers.Hash_Tables.Generic_Keys;
-- --
-- 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- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
+-- Hash_Table_Type is used to implement hashed containers. This package
+-- declares hash-table operations that depend on keys.
+
generic
with package HT_Types is
new Generic_Hash_Table_Types (<>);
(HT : Hash_Table_Type;
Key : Key_Type) return Hash_Type;
pragma Inline (Index);
+ -- Returns the bucket number (array index value) for the given key
procedure Delete_Key_Sans_Free
- (HT : in out Hash_Table_Type;
- Key : Key_Type;
- X : out Node_Access);
+ (HT : in out Hash_Table_Type;
+ Key : Key_Type;
+ X : out Node_Access);
+ -- Removes the node (if any) with the given key from the hash table,
+ -- without deallocating it. Program_Error is raised if the hash
+ -- table is busy.
function Find (HT : Hash_Table_Type; Key : Key_Type) return Node_Access;
+ -- Returns the node (if any) corresponding to the given key
generic
with function New_Node (Next : Node_Access) return Node_Access;
Key : Key_Type;
Node : out Node_Access;
Inserted : out Boolean);
+ -- Attempts to insert a new node with the given key into the hash table.
+ -- If a node with that key already exists in the table, then that node
+ -- is returned and Inserted returns False. Otherwise New_Node is called
+ -- to allocate a new node, and Inserted returns True. Program_Error is
+ -- raised if the hash table is busy.
generic
with function Hash (Node : Node_Access) return Hash_Type;
(HT : in out Hash_Table_Type;
Node : Node_Access;
Key : Key_Type);
+ -- Assigns Key to Node, possibly changing its equivalence class. If Node
+ -- is in the same equivalence class as Key (that is, it's already in the
+ -- bucket implied by Key), then if the hash table is locked then
+ -- Program_Error is raised; otherwise Assign is called to assign Key to
+ -- Node. If Node is in a different bucket from Key, then Program_Error is
+ -- raised if the hash table is busy. Otherwise it Assigns Key to Node and
+ -- moves the Node from its current bucket to the bucket implied by Key.
+ -- Note that it is never proper to assign to Node a key value already
+ -- in the map, and so if Key is equivalent to some other node then
+ -- Program_Error is raised.
end Ada.Containers.Hash_Tables.Generic_Keys;
-- --
-- S p e c --
-- --
--- 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. --
+-- Copyright (C) 2004-2006, Free Software Foundation, Inc. --
-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- 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. --
------------------------------------------------------------------------------
+-- Hash_Table_Type is used to implement hashed containers. This package
+-- declares hash-table operations that do not depend on keys.
+
with Ada.Streams;
generic
pragma Preelaborate;
procedure Free_Hash_Table (Buckets : in out Buckets_Access);
+ -- First frees the nodes in all non-null buckets of Buckets, and then frees
+ -- the Buckets array itself.
function Index
(Buckets : Buckets_Type;
Node : Node_Access) return Hash_Type;
pragma Inline (Index);
+ -- Uses the hash value of Node to compute its Buckets array index
function Index
(Hash_Table : Hash_Table_Type;
Node : Node_Access) return Hash_Type;
pragma Inline (Index);
+ -- Uses the hash value of Node to compute its Hash_Table buckets array
+ -- index.
procedure Adjust (HT : in out Hash_Table_Type);
+ -- Used to implement controlled Adjust. It is assumed that HT has the value
+ -- of the bit-wise copy that immediately follows controlled Finalize.
+ -- Adjust first allocates a new buckets array for HT (having the same
+ -- length as the source), and then allocates a copy of each node of source.
procedure Finalize (HT : in out Hash_Table_Type);
+ -- Used to implement controlled Finalize. It first calls Clear to
+ -- deallocate any remaining nodes, and then deallocates the buckets array.
generic
with function Find
Key : Node_Access) return Boolean;
function Generic_Equal
(L, R : Hash_Table_Type) return Boolean;
+ -- Used to implement hashed container equality. For each node in hash table
+ -- L, it calls Find to search for an equivalent item in hash table R. If
+ -- Find returns False for any node then Generic_Equal terminates
+ -- immediately and returns False. Otherwise if Find returns True for every
+ -- node then Generic_Equal returns True.
procedure Clear (HT : in out Hash_Table_Type);
+ -- Deallocates each node in hash table HT. (Note that it only deallocates
+ -- the nodes, not the buckets array.) Program_Error is raised if the hash
+ -- table is busy.
procedure Move (Target, Source : in out Hash_Table_Type);
+ -- Moves (not copies) the buckets array and nodes from Source to
+ -- Target. Program_Error is raised if Source is busy. The Target is first
+ -- cleared to deallocate its nodes (implying that Program_Error is also
+ -- raised if Target is busy). Source is empty following the move.
function Capacity (HT : Hash_Table_Type) return Count_Type;
+ -- Returns the length of the buckets array
procedure Reserve_Capacity
(HT : in out Hash_Table_Type;
N : Count_Type);
+ -- If N is greater than the current capacity, then it expands the buckets
+ -- array to at least the value N. If N is less than the current capacity,
+ -- then it contracts the buckets array. In either case existing nodes are
+ -- rehashed onto the new buckets array, and the old buckets array is
+ -- deallocated. Program_Error is raised if the hash table is busy.
procedure Delete_Node_Sans_Free
(HT : in out Hash_Table_Type;
X : Node_Access);
+ -- Removes node X from the hash table without deallocating the node
function First (HT : Hash_Table_Type) return Node_Access;
+ -- Returns the head of the list in the first (lowest-index) non-empty
+ -- bucket.
function Next
(HT : Hash_Table_Type;
Node : Node_Access) return Node_Access;
+ -- Returns the node that immediately follows Node. This corresponds to
+ -- either the next node in the same bucket, or (if Node is the last node in
+ -- its bucket) the head of the list in the first non-empty bucket that
+ -- follows.
generic
with procedure Process (Node : Node_Access);
procedure Generic_Iteration (HT : Hash_Table_Type);
+ -- Calls Process for each node in hash table HT
generic
use Ada.Streams;
with procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Node : Node_Access);
procedure Generic_Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
HT : Hash_Table_Type);
+ -- Used to implement the streaming attribute for hashed containers. It
+ -- calls Write for each node to write its value into Stream.
generic
use Ada.Streams;
- with function New_Node (Stream : access Root_Stream_Type'Class)
+ with function New_Node (Stream : not null access Root_Stream_Type'Class)
return Node_Access;
procedure Generic_Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
HT : out Hash_Table_Type);
+ -- Used to implement the streaming attribute for hashed containers. It
+ -- first clears hash table HT, then populates the hash table by calling
+ -- New_Node for each item in Stream.
end Ada.Containers.Hash_Tables.Generic_Operations;
pragma Inline (Next);
function Read_Node
- (Stream : access Root_Stream_Type'Class) return Node_Access;
+ (Stream : not null access Root_Stream_Type'Class) return Node_Access;
procedure Set_Next (Node : Node_Access; Next : Node_Access);
pragma Inline (Set_Next);
function Vet (Position : Cursor) return Boolean;
procedure Write_Node
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Node : Node_Access);
--------------------------
procedure Read_Nodes is new HT_Ops.Generic_Read (Read_Node);
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : out Map)
is
begin
end Read;
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : out Cursor)
is
begin
---------------
function Read_Node
- (Stream : access Root_Stream_Type'Class) return Node_Access
+ (Stream : not null access Root_Stream_Type'Class) return Node_Access
is
Node : Node_Access := new Node_Type;
procedure Write_Nodes is new HT_Ops.Generic_Write (Write_Node);
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : Map)
is
begin
end Write;
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : Cursor)
is
begin
----------------
procedure Write_Node
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Node : Node_Access)
is
begin
end record;
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : Cursor);
for Cursor'Write use Write;
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : out Cursor);
for Cursor'Read use Read;
Node => null);
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : Map);
for Map'Write use Write;
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : out Map);
for Map'Read use Read;
function Next (Node : Node_Access) return Node_Access;
pragma Inline (Next);
- function Read_Node (Stream : access Root_Stream_Type'Class)
+ function Read_Node (Stream : not null access Root_Stream_Type'Class)
return Node_Access;
pragma Inline (Read_Node);
function Vet (Position : Cursor) return Boolean;
procedure Write_Node
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Node : Node_Access);
pragma Inline (Write_Node);
----------
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : out Set)
is
begin
end Read;
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : out Cursor)
is
begin
---------------
function Read_Node
- (Stream : access Root_Stream_Type'Class) return Node_Access
+ (Stream : not null access Root_Stream_Type'Class) return Node_Access
is
X : Element_Access := new Element_Type'(Element_Type'Input (Stream));
-----------
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : Set)
is
begin
end Write;
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : Cursor)
is
begin
----------------
procedure Write_Node
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Node : Node_Access)
is
begin
end record;
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : Cursor);
for Cursor'Write use Write;
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : out Cursor);
for Cursor'Read use Read;
Node => null);
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : Set);
for Set'Write use Write;
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : out Set);
for Set'Read use Read;
Container : out Map)
is
function Read_Node
- (Stream : access Root_Stream_Type'Class) return Node_Access;
+ (Stream : not null access Root_Stream_Type'Class) return Node_Access;
pragma Inline (Read_Node);
procedure Read is
---------------
function Read_Node
- (Stream : access Root_Stream_Type'Class) return Node_Access
+ (Stream : not null access Root_Stream_Type'Class) return Node_Access
is
Node : Node_Access := new Node_Type;
begin
Container : Map)
is
procedure Write_Node
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Node : Node_Access);
pragma Inline (Write_Node);
----------------
procedure Write_Node
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Node : Node_Access)
is
begin
----------
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : out Set)
is
function Read_Node
- (Stream : access Root_Stream_Type'Class) return Node_Access;
+ (Stream : not null access Root_Stream_Type'Class) return Node_Access;
pragma Inline (Read_Node);
procedure Read is
---------------
function Read_Node
- (Stream : access Root_Stream_Type'Class) return Node_Access
+ (Stream : not null access Root_Stream_Type'Class) return Node_Access
is
Node : Node_Access := new Node_Type;
begin
end Read;
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : out Cursor)
is
begin
-----------
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : Set)
is
procedure Write_Node
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Node : Node_Access);
pragma Inline (Write_Node);
----------------
procedure Write_Node
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Node : Node_Access)
is
begin
end Write;
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : Cursor)
is
begin
end record;
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : Cursor);
for Cursor'Write use Write;
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : out Cursor);
for Cursor'Read use Read;
No_Element : constant Cursor := Cursor'(null, null);
- procedure Write (Stream : access Root_Stream_Type'Class; Container : Set);
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Container : Set);
for Set'Write use Write;
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : out Set);
for Set'Read use Read;
----------
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : out Set)
is
function Read_Node
- (Stream : access Root_Stream_Type'Class) return Node_Access;
+ (Stream : not null access Root_Stream_Type'Class) return Node_Access;
pragma Inline (Read_Node);
procedure Read is
---------------
function Read_Node
- (Stream : access Root_Stream_Type'Class) return Node_Access
+ (Stream : not null access Root_Stream_Type'Class) return Node_Access
is
Node : Node_Access := new Node_Type;
end Read;
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : out Cursor)
is
begin
-----------
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : Set)
is
procedure Write_Node
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Node : Node_Access);
pragma Inline (Write_Node);
----------------
procedure Write_Node
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Node : Node_Access)
is
begin
end Write;
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : Cursor)
is
begin
end record;
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : Cursor);
for Cursor'Write use Write;
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : out Cursor);
for Cursor'Read use Read;
No_Element : constant Cursor := Cursor'(null, null);
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : Set);
for Set'Write use Write;
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : out Set);
for Set'Read use Read;
pragma Inline (Next);
function Read_Node
- (Stream : access Root_Stream_Type'Class) return Node_Access;
+ (Stream : not null access Root_Stream_Type'Class) return Node_Access;
pragma Inline (Read_Node);
procedure Set_Next (Node : Node_Access; Next : Node_Access);
function Vet (Position : Cursor) return Boolean;
procedure Write_Node
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Node : Node_Access);
pragma Inline (Write_Node);
----------
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : out Map)
is
begin
end Read;
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : out Cursor)
is
begin
---------------
function Read_Node
- (Stream : access Root_Stream_Type'Class) return Node_Access
+ (Stream : not null access Root_Stream_Type'Class) return Node_Access
is
Node : Node_Access := new Node_Type;
-----------
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : Map)
is
begin
end Write;
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : Cursor)
is
begin
----------------
procedure Write_Node
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Node : Node_Access)
is
begin
use Ada.Streams;
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : Map);
for Map'Write use Write;
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : out Map);
for Map'Read use Read;
end record;
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : out Cursor);
for Cursor'Read use Read;
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : Cursor);
for Cursor'Write use Write;
function Next (Node : Node_Access) return Node_Access;
pragma Inline (Next);
- function Read_Node (Stream : access Root_Stream_Type'Class)
+ function Read_Node (Stream : not null access Root_Stream_Type'Class)
return Node_Access;
pragma Inline (Read_Node);
function Vet (Position : Cursor) return Boolean;
procedure Write_Node
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Node : Node_Access);
pragma Inline (Write_Node);
----------
procedure Read
- (Stream : access Root_Stream_Type'Class;
- Container : out Set)
+ (Stream : not null access Root_Stream_Type'Class;
+ Container : out Set)
is
begin
Read_Nodes (Stream, Container.HT);
end Read;
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : out Cursor)
is
begin
-- Read_Node --
---------------
- function Read_Node (Stream : access Root_Stream_Type'Class)
+ function Read_Node (Stream : not null access Root_Stream_Type'Class)
return Node_Access
is
Node : Node_Access := new Node_Type;
-----------
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : Set)
is
begin
end Write;
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : Cursor)
is
begin
----------------
procedure Write_Node
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Node : Node_Access)
is
begin
end record;
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : Cursor);
for Cursor'Write use Write;
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : out Cursor);
for Cursor'Read use Read;
No_Element : constant Cursor := (Container => null, Node => null);
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : Set);
for Set'Write use Write;
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : out Set);
for Set'Read use Read;
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
Container : out Map)
is
function Read_Node
- (Stream : access Root_Stream_Type'Class) return Node_Access;
+ (Stream : not null access Root_Stream_Type'Class) return Node_Access;
pragma Inline (Read_Node);
procedure Read is
---------------
function Read_Node
- (Stream : access Root_Stream_Type'Class) return Node_Access
+ (Stream : not null access Root_Stream_Type'Class) return Node_Access
is
Node : Node_Access := new Node_Type;
begin
Container : Map)
is
procedure Write_Node
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Node : Node_Access);
pragma Inline (Write_Node);
----------------
procedure Write_Node
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Node : Node_Access)
is
begin
----------
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : out Set)
is
function Read_Node
- (Stream : access Root_Stream_Type'Class) return Node_Access;
+ (Stream : not null access Root_Stream_Type'Class) return Node_Access;
pragma Inline (Read_Node);
procedure Read is
---------------
function Read_Node
- (Stream : access Root_Stream_Type'Class) return Node_Access
+ (Stream : not null access Root_Stream_Type'Class) return Node_Access
is
Node : Node_Access := new Node_Type;
begin
end Read;
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : out Cursor)
is
begin
-----------
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : Set)
is
procedure Write_Node
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Node : Node_Access);
pragma Inline (Write_Node);
----------------
procedure Write_Node
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Node : Node_Access)
is
begin
end Write;
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : Cursor)
is
begin
end record;
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : Cursor);
for Cursor'Write use Write;
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : out Cursor);
for Cursor'Read use Read;
No_Element : constant Cursor := Cursor'(null, null);
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : Set);
for Set'Write use Write;
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : out Set);
for Set'Read use Read;
----------
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : out Set)
is
function Read_Node
- (Stream : access Root_Stream_Type'Class) return Node_Access;
+ (Stream : not null access Root_Stream_Type'Class) return Node_Access;
pragma Inline (Read_Node);
procedure Read is
---------------
function Read_Node
- (Stream : access Root_Stream_Type'Class) return Node_Access
+ (Stream : not null access Root_Stream_Type'Class) return Node_Access
is
Node : Node_Access := new Node_Type;
end Read;
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : out Cursor)
is
begin
-----------
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : Set)
is
procedure Write_Node
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Node : Node_Access);
pragma Inline (Write_Node);
----------------
procedure Write_Node
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Node : Node_Access)
is
begin
end Write;
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : Cursor)
is
begin
end record;
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : Cursor);
for Cursor'Write use Write;
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Item : out Cursor);
for Cursor'Read use Read;
No_Element : constant Cursor := Cursor'(null, null);
procedure Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : Set);
for Set'Write use Write;
procedure Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Container : out Set);
for Set'Read use Read;
-- --
-- S p e c --
-- --
--- 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. --
+-- Copyright (C) 2004-2006, Free Software Foundation, Inc. --
-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- 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. --
------------------------------------------------------------------------------
+-- This package declares the prime numbers array used to implement hashed
+-- containers. Bucket arrays are always allocated with a prime-number
+-- length (computed using To_Prime below), as this produces better scatter
+-- when hash values are folded.
+
package Ada.Containers.Prime_Numbers is
pragma Pure;
1610612741, 3221225473, 4294967291);
function To_Prime (Length : Count_Type) return Hash_Type;
+ -- Returns the smallest value in Primes not less than Length
end Ada.Containers.Prime_Numbers;
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
------------------
procedure Generic_Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Tree : in out Tree_Type)
is
N : Count_Type'Base;
-------------------
procedure Generic_Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Tree : Tree_Type)
is
procedure Process (Node : Node_Access);
generic
with procedure Write_Node
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Node : Node_Access);
procedure Generic_Write
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Tree : Tree_Type);
-- Used to implement stream attribute T'Write. Generic_Write
-- first writes the number of nodes into Stream, then calls
generic
with procedure Clear (Tree : in out Tree_Type);
with function Read_Node
- (Stream : access Root_Stream_Type'Class) return Node_Access;
+ (Stream : not null access Root_Stream_Type'Class) return Node_Access;
procedure Generic_Read
- (Stream : access Root_Stream_Type'Class;
+ (Stream : not null access Root_Stream_Type'Class;
Tree : in out Tree_Type);
-- Used to implement stream attribute T'Read. Generic_Read
-- first clears Tree. It then reads the number of nodes out of
-- --
-- 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. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- Copyright (C) 2005-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.Environment_Variables is
(UW_Version : Integer;
UW_Phases : Unwind_Action;
UW_Eclass : Exception_Class;
- UW_Exception : access GNAT_GCC_Exception;
+ UW_Exception : not null access GNAT_GCC_Exception;
UW_Context : System.Address;
UW_Argument : System.Address) return Unwind_Reason_Code;
-- Hook called at each step of the forced unwinding we perform to
-- __gnat stubs for these.
procedure Unwind_RaiseException
- (UW_Exception : access GNAT_GCC_Exception);
+ (UW_Exception : not null access GNAT_GCC_Exception);
pragma Import (C, Unwind_RaiseException, "__gnat_Unwind_RaiseException");
procedure Unwind_ForcedUnwind
- (UW_Exception : access GNAT_GCC_Exception;
+ (UW_Exception : not null access GNAT_GCC_Exception;
UW_Handler : System.Address;
UW_Argument : System.Address);
pragma Import (C, Unwind_ForcedUnwind, "__gnat_Unwind_ForcedUnwind");
(UW_Version : Integer;
UW_Phases : Unwind_Action;
UW_Eclass : Exception_Class;
- UW_Exception : access GNAT_GCC_Exception;
+ UW_Exception : not null access GNAT_GCC_Exception;
UW_Context : System.Address;
UW_Argument : System.Address) return Unwind_Reason_Code
is
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
pragma Pure;
procedure Union (Target : in out Tree_Type; Source : Tree_Type);
+ -- Attempts to insert each element of Source in Target. If Target is
+ -- busy then Program_Error is raised. We say "attempts" here because
+ -- if these are unique-element sets, then the insertion should fail
+ -- (not insert a new item) when the insertion item from Source is
+ -- equivalent to an item already in Target. If these are multisets
+ -- then of course the attempt should always succeed.
function Union (Left, Right : Tree_Type) return Tree_Type;
+ -- Makes a copy of Left, and attempts to insert each element of
+ -- Right into the copy, then returns the copy.
procedure Intersection (Target : in out Tree_Type; Source : Tree_Type);
+ -- Removes elements from Target that are not equivalent to items in
+ -- Source. If Target is busy then Program_Error is raised.
function Intersection (Left, Right : Tree_Type) return Tree_Type;
+ -- Returns a set comprising all the items in Left equivalent to items in
+ -- Right.
procedure Difference (Target : in out Tree_Type; Source : Tree_Type);
+ -- Removes elements from Target that are equivalent to items in Source. If
+ -- Target is busy then Program_Error is raised.
function Difference (Left, Right : Tree_Type) return Tree_Type;
+ -- Returns a set comprising all the items in Left not equivalent to items
+ -- in Right.
procedure Symmetric_Difference
(Target : in out Tree_Type;
Source : Tree_Type);
+ -- Removes from Target elements that are equivalent to items in Source, and
+ -- inserts into Target items from Source not equivalent elements in
+ -- Target. If Target is busy then Program_Error is raised.
function Symmetric_Difference (Left, Right : Tree_Type) return Tree_Type;
+ -- Returns a set comprising the union of the elements in Left not
+ -- equivalent to items in Right, and the elements in Right not equivalent
+ -- to items in Left.
function Is_Subset (Subset : Tree_Type; Of_Set : Tree_Type) return Boolean;
+ -- Returns False if Subset contains at least one element not equivalent to
+ -- any item in Of_Set; returns True otherwise.
function Overlap (Left, Right : Tree_Type) return Boolean;
+ -- Returns True if at least one element of Left is equivalent to an item in
+ -- Right; returns False otherwise.
end Ada.Containers.Red_Black_Trees.Generic_Set_Operations;
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- No special processing required for closing Stream_IO file
- procedure AFCB_Close (File : access Stream_AFCB) is
+ procedure AFCB_Close (File : not null access Stream_AFCB) is
pragma Warnings (Off, File);
begin
null;
-- AFCB_Free --
---------------
- procedure AFCB_Free (File : access Stream_AFCB) is
+ procedure AFCB_Free (File : not null access Stream_AFCB) is
type FCB_Ptr is access all Stream_AFCB;
FT : FCB_Ptr := FCB_Ptr (File);
function AFCB_Allocate (Control_Block : Stream_AFCB) return FCB.AFCB_Ptr;
- procedure AFCB_Close (File : access Stream_AFCB);
- procedure AFCB_Free (File : access Stream_AFCB);
+ procedure AFCB_Close (File : not null access Stream_AFCB);
+ procedure AFCB_Free (File : not null access Stream_AFCB);
procedure Read
(File : in out Stream_AFCB;
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- AFCB_Close --
----------------
- procedure AFCB_Close (File : access Text_AFCB) is
+ procedure AFCB_Close (File : not null access Text_AFCB) is
begin
-- If the file being closed is one of the current files, then close
-- the corresponding current file. It is not clear that this action
-- AFCB_Free --
---------------
- procedure AFCB_Free (File : access Text_AFCB) is
+ procedure AFCB_Free (File : not null access Text_AFCB) is
type FCB_Ptr is access all Text_AFCB;
FT : FCB_Ptr := FCB_Ptr (File);
-- --
-- S p e c --
-- --
--- 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 --
function AFCB_Allocate (Control_Block : Text_AFCB) return FCB.AFCB_Ptr;
- procedure AFCB_Close (File : access Text_AFCB);
- procedure AFCB_Free (File : access Text_AFCB);
+ procedure AFCB_Close (File : not null access Text_AFCB);
+ procedure AFCB_Free (File : not null access Text_AFCB);
procedure Read
(File : in out Text_AFCB;
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
generic
type T (<>) is abstract tagged limited private;
type Parameters (<>) is limited private;
- with function Constructor (Params : access Parameters) return T is abstract;
+ with function Constructor (Params : not null access Parameters) return T
+ is abstract;
function Ada.Tags.Generic_Dispatching_Constructor
- (The_Tag : Tag; Params : access Parameters) return T'Class;
+ (The_Tag : Tag;
+ Params : not null access Parameters) return T'Class;
pragma Preelaborate_05 (Generic_Dispatching_Constructor);
pragma Import (Intrinsic, Generic_Dispatching_Constructor);
-- Note: the reason that we use Preelaborate_05 here is so that this will
-- --
-- S p e c --
-- --
--- Copyright (C) 1997-2005, 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. --
function Gets_Dec
(From : String;
- Last : access Positive;
+ Last : not null access Positive;
Scale : Integer) return Integer
is
Pos : aliased Integer;
function Gets_LLD
(From : String;
- Last : access Positive;
+ Last : not null access Positive;
Scale : Integer) return Long_Long_Integer
is
Pos : aliased Integer;
function Gets_Dec
(From : String;
- Last : access Positive;
+ Last : not null access Positive;
Scale : Integer) return Integer;
function Gets_LLD
(From : String;
- Last : access Positive;
+ Last : not null access Positive;
Scale : Integer) return Long_Long_Integer;
procedure Puts_Dec
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- AFCB_Close --
----------------
- procedure AFCB_Close (File : access Wide_Text_AFCB) is
+ procedure AFCB_Close (File : not null access Wide_Text_AFCB) is
begin
-- If the file being closed is one of the current files, then close
-- the corresponding current file. It is not clear that this action
-- AFCB_Free --
---------------
- procedure AFCB_Free (File : access Wide_Text_AFCB) is
+ procedure AFCB_Free (File : not null access Wide_Text_AFCB) is
type FCB_Ptr is access all Wide_Text_AFCB;
FT : FCB_Ptr := FCB_Ptr (File);
-- --
-- S p e c --
-- --
--- 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 --
function AFCB_Allocate (Control_Block : Wide_Text_AFCB) return FCB.AFCB_Ptr;
- procedure AFCB_Close (File : access Wide_Text_AFCB);
- procedure AFCB_Free (File : access Wide_Text_AFCB);
+ procedure AFCB_Close (File : not null access Wide_Text_AFCB);
+ procedure AFCB_Free (File : not null access Wide_Text_AFCB);
procedure Read
(File : in out Wide_Text_AFCB;
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
function Gets_Dec
(From : String;
- Last : access Positive;
+ Last : not null access Positive;
Scale : Integer) return Integer
is
Pos : aliased Integer;
function Gets_LLD
(From : String;
- Last : access Positive;
+ Last : not null access Positive;
Scale : Integer) return Long_Long_Integer
is
Pos : aliased Integer;
function Gets_Dec
(From : String;
- Last : access Positive;
+ Last : not null access Positive;
Scale : Integer) return Integer;
function Gets_LLD
(From : String;
- Last : access Positive;
+ Last : not null access Positive;
Scale : Integer) return Long_Long_Integer;
procedure Put_Dec
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- Copyright (C) 1997-2005, 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. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- B o d y --
-- --
--- 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- --
function Gets_Dec
(From : String;
- Last : access Positive;
+ Last : not null access Positive;
Scale : Integer) return Integer
is
Pos : aliased Integer;
function Gets_LLD
(From : String;
- Last : access Positive;
+ Last : not null access Positive;
Scale : Integer) return Long_Long_Integer
is
Pos : aliased Integer;
-- --
-- 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- --
function Gets_Dec
(From : String;
- Last : access Positive;
+ Last : not null access Positive;
Scale : Integer) return Integer;
function Gets_LLD
(From : String;
- Last : access Positive;
+ Last : not null access Positive;
Scale : Integer) return Long_Long_Integer;
procedure Put_Dec
-- AFCB_Close --
----------------
- procedure AFCB_Close (File : access Wide_Wide_Text_AFCB) is
+ procedure AFCB_Close (File : not null access Wide_Wide_Text_AFCB) is
begin
-- If the file being closed is one of the current files, then close
-- the corresponding current file. It is not clear that this action
-- AFCB_Free --
---------------
- procedure AFCB_Free (File : access Wide_Wide_Text_AFCB) is
+ procedure AFCB_Free (File : not null access Wide_Wide_Text_AFCB) is
type FCB_Ptr is access all Wide_Wide_Text_AFCB;
FT : FCB_Ptr := FCB_Ptr (File);
-- --
-- S p e c --
-- --
--- 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 --
function AFCB_Allocate
(Control_Block : Wide_Wide_Text_AFCB) return FCB.AFCB_Ptr;
- procedure AFCB_Close (File : access Wide_Wide_Text_AFCB);
- procedure AFCB_Free (File : access Wide_Wide_Text_AFCB);
+ procedure AFCB_Close (File : not null access Wide_Wide_Text_AFCB);
+ procedure AFCB_Free (File : not null access Wide_Wide_Text_AFCB);
procedure Read
(File : in out Wide_Wide_Text_AFCB;
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- Copyright (C) 1997-2005, 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. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- Local Data --
----------------
- -- The following table is used to save values of the Expander_Active
- -- flag when they are saved by Expander_Mode_Save_And_Set. We use an
- -- extendible table (which is a bit of overkill) because it is easier
- -- than figuring out a maximum value or bothering with range checks!
+ -- The following table is used to save values of the Expander_Active flag
+ -- when they are saved by Expander_Mode_Save_And_Set. We use an extendible
+ -- table (which is a bit of overkill) because it is easier than figuring
+ -- out a maximum value or bothering with range checks!
package Expander_Flags is new Table.Table (
Table_Component_Type => Boolean,
procedure Expand (N : Node_Id) is
begin
- -- If we were analyzing a default expression the Full_Analysis flag
- -- must be off. If we are in expansion mode then we must be
- -- performing a full analysis. If we are analyzing a generic then
- -- Expansion must be off.
+ -- If we were analyzing a default expression the Full_Analysis flag must
+ -- be off. If we are in expansion mode then we must be performing a full
+ -- analysis. If we are analyzing a generic then Expansion must be off.
pragma Assert
(not (Full_Analysis and then In_Default_Expression)
- and then (Full_Analysis or else not Expander_Active)
- and then not (Inside_A_Generic and then Expander_Active));
+ and then (Full_Analysis or else not Expander_Active)
+ and then not (Inside_A_Generic and then Expander_Active));
- -- There are three reasons for the Expander_Active flag to be false.
+ -- There are three reasons for the Expander_Active flag to be false
--
-- The first is when are not generating code. In this mode the
-- Full_Analysis flag indicates whether we are performing a complete
-- info on this.
--
-- The second reason for the Expander_Active flag to be False is that
- -- we are performing a pre-analysis. During pre-analysis all
- -- expansion activity is turned off to make sure nodes are
- -- semantically decorated but no extra nodes are generated. This is
- -- for instance needed for the first pass of aggregate semantic
- -- processing. Note that in this case the Full_Analysis flag is set
- -- to False because the node will subsequently be re-analyzed with
- -- expansion on (see the spec of sem).
+ -- we are performing a pre-analysis. During pre-analysis all expansion
+ -- activity is turned off to make sure nodes are semantically decorated
+ -- but no extra nodes are generated. This is for instance needed for
+ -- the first pass of aggregate semantic processing. Note that in this
+ -- case the Full_Analysis flag is set to False because the node will
+ -- subsequently be re-analyzed with expansion on (see the spec of sem).
-- Finally, expansion is turned off in a regular compilation if there
-- are serious errors. In that case there will be no further expansion,
-- but one cleanup action may be required: if a transient scope was
- -- created (e.g. for a function that returns an unconstrained type)
- -- the scope may still be on the stack, and must be removed explicitly,
+ -- created (e.g. for a function that returns an unconstrained type) the
+ -- scope may still be on the stack, and must be removed explicitly,
-- given that the expansion actions that would normally process it will
-- not take place. This prevents cascaded errors due to stack mismatch.
Debug_A_Entry ("expanding ", N);
-- Processing depends on node kind. For full details on the expansion
- -- activity required in each case, see bodies of corresponding
- -- expand routines
+ -- activity required in each case, see bodies of corresponding expand
+ -- routines.
begin
case Nkind (N) is
Expander_Active := Expander_Flags.Table (Expander_Flags.Last);
Expander_Flags.Decrement_Last;
- -- Keep expander off if serious errors detected. In this case we do
- -- not need expansion, and continued expansion may cause cascaded
- -- errors or compiler bombs.
+ -- Keep expander off if serious errors detected. In this case we do not
+ -- need expansion, and continued expansion may cause cascaded errors or
+ -- compiler bombs.
if Serious_Errors_Detected /= 0 then
Expander_Active := False;
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2005, AdaCore --
+-- Copyright (C) 1999-2006, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-----------------
function Day_In_Year (Date : Time) return Day_In_Year_Number is
- Year : Year_Number;
- Month : Month_Number;
- Day : Day_Number;
- Dsecs : Day_Duration;
+ Year : Year_Number;
+ Month : Month_Number;
+ Day : Day_Number;
+ Day_Secs : Day_Duration;
begin
- Split (Date, Year, Month, Day, Dsecs);
+ Split (Date, Year, Month, Day, Day_Secs);
return Julian_Day (Year, Month, Day) - Julian_Day (Year, 1, 1) + 1;
end Day_In_Year;
-----------------
function Day_Of_Week (Date : Time) return Day_Name is
- Year : Year_Number;
- Month : Month_Number;
- Day : Day_Number;
- Dsecs : Day_Duration;
+ Year : Year_Number;
+ Month : Month_Number;
+ Day : Day_Number;
+ Day_Secs : Day_Duration;
begin
- Split (Date, Year, Month, Day, Dsecs);
+ Split (Date, Year, Month, Day, Day_Secs);
return Day_Name'Val ((Julian_Day (Year, Month, Day)) mod 7);
end Day_Of_Week;
-- Julian_Day --
----------------
- -- Julian_Day is used to by Day_Of_Week and Day_In_Year. Note
- -- that this implementation is not expensive.
+ -- Julian_Day is used to by Day_Of_Week and Day_In_Year. Note that this
+ -- implementation is not expensive.
function Julian_Day
(Year : Year_Number;
Second : out Second_Number;
Sub_Second : out Second_Duration)
is
- Dsecs : Day_Duration;
- Secs : Natural;
+ Day_Secs : Day_Duration;
+ Secs : Natural;
begin
- Split (Date, Year, Month, Day, Dsecs);
+ Split (Date, Year, Month, Day, Day_Secs);
- if Dsecs = 0.0 then
+ if Day_Secs = 0.0 then
Secs := 0;
else
- Secs := Natural (Dsecs - 0.5);
+ Secs := Natural (Day_Secs - 0.5);
end if;
- Sub_Second := Second_Duration (Dsecs - Day_Duration (Secs));
- Hour := Hour_Number (Secs / 3600);
- Secs := Secs mod 3600;
+ Sub_Second := Second_Duration (Day_Secs - Day_Duration (Secs));
+ Hour := Hour_Number (Secs / 3_600);
+ Secs := Secs mod 3_600;
Minute := Minute_Number (Secs / 60);
Second := Second_Number (Secs mod 60);
end Split;
Second : Second_Number;
Sub_Second : Second_Duration := 0.0) return Time
is
- Dsecs : constant Day_Duration :=
- Day_Duration (Hour * 3600 + Minute * 60 + Second) +
- Sub_Second;
+ Day_Secs : constant Day_Duration :=
+ Day_Duration (Hour * 3_600) +
+ Day_Duration (Minute * 60) +
+ Day_Duration (Second) +
+ Sub_Second;
begin
- return Time_Of (Year, Month, Day, Dsecs);
+ return Time_Of (Year, Month, Day, Day_Secs);
end Time_Of;
-----------------
-- To_Duration --
-----------------
- function To_Duration (T : access timeval) return Duration is
+ function To_Duration (T : not null access timeval) return Duration is
procedure timeval_to_duration
- (T : access timeval;
- sec : access C.long;
- usec : access C.long);
+ (T : not null access timeval;
+ sec : not null access C.long;
+ usec : not null access C.long);
pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
Micro : constant := 10**6;
-- To_Timeval --
----------------
- function To_Timeval (D : Duration) return timeval is
+ function To_Timeval (D : Duration) return timeval is
- procedure duration_to_timeval (Sec, Usec : C.long; T : access timeval);
+ procedure duration_to_timeval
+ (Sec : C.long;
+ Usec : C.long;
+ T : not null access timeval);
pragma Import (C, duration_to_timeval, "__gnat_duration_to_timeval");
Micro : constant := 10**6;
-- Week_In_Year --
------------------
- function Week_In_Year
- (Date : Ada.Calendar.Time) return Week_In_Year_Number
- is
+ function Week_In_Year (Date : Time) return Week_In_Year_Number is
Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
-- --
-- S p e c --
-- --
--- Copyright (C) 1999-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1999-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- --
type timeval is private;
- function To_Duration (T : access timeval) return Duration;
+ function To_Duration (T : not null access timeval) return Duration;
function To_Timeval (D : Duration) return timeval;
private
function readdir_gnat
(Directory : System.Address;
Buffer : System.Address;
- Last : access Integer) return System.Address;
+ Last : not null access Integer) return System.Address;
pragma Import (C, readdir_gnat, "__gnat_readdir");
begin
procedure Kill (Pid : Process_Id; Sig_Num : Integer);
pragma Import (C, Kill, "decc$kill");
- function Create_Pipe (Pipe : access Pipe_Type) return Integer;
+ function Create_Pipe (Pipe : not null access Pipe_Type) return Integer;
pragma Import (C, Create_Pipe, "__gnat_pipe");
function Poll
(Command : String;
Arguments : GNAT.OS_Lib.Argument_List;
Input : String;
- Status : access Integer;
+ Status : not null access Integer;
Err_To_Out : Boolean := False) return String
is
use GNAT.Expect;
procedure Set_Up_Communications
(Pid : in out Process_Descriptor;
Err_To_Out : Boolean;
- Pipe1 : access Pipe_Type;
- Pipe2 : access Pipe_Type;
- Pipe3 : access Pipe_Type)
+ Pipe1 : not null access Pipe_Type;
+ Pipe2 : not null access Pipe_Type;
+ Pipe3 : not null access Pipe_Type)
is
begin
-- Create the pipes
-- --
-- S p e c --
-- --
--- Copyright (C) 2000-2005, AdaCore --
+-- Copyright (C) 2000-2006, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
(Command : String;
Arguments : GNAT.OS_Lib.Argument_List;
Input : String;
- Status : access Integer;
+ Status : not null access Integer;
Err_To_Out : Boolean := False) return String;
-- Execute Command with the specified Arguments and Input, and return the
-- generated standard output data as a single string. If Err_To_Out is
procedure Set_Up_Communications
(Pid : in out Process_Descriptor;
Err_To_Out : Boolean;
- Pipe1 : access Pipe_Type;
- Pipe2 : access Pipe_Type;
- Pipe3 : access Pipe_Type);
+ Pipe1 : not null access Pipe_Type;
+ Pipe2 : not null access Pipe_Type;
+ Pipe3 : not null access Pipe_Type);
-- Set up all the communication pipes and file descriptors prior to
-- spawning the child process.
-- possibly in future child units providing extensions to this package.
procedure Portable_Execvp
- (Pid : access Process_Id;
+ (Pid : not null access Process_Id;
Cmd : String;
Args : System.Address);
pragma Import (C, Portable_Execvp, "__gnat_expect_portable_execvp");
type Stream_Access is access all Ada.Streams.Root_Stream_Type'Class;
-- Same interface as Ada.Streams.Stream_IO
- function Stream
- (Socket : Socket_Type) return Stream_Access;
+ function Stream (Socket : Socket_Type) return Stream_Access;
-- Create a stream associated with a stream-based socket that is
-- already connected.
-- Create a stream associated with a datagram-based socket that is already
-- bound. Send_To is the socket address to which messages are being sent.
- function Get_Address
- (Stream : Stream_Access) return Sock_Addr_Type;
+ function Get_Address (Stream : Stream_Access) return Sock_Addr_Type;
-- Return the socket address from which the last message was received
procedure Free is new Ada.Unchecked_Deallocation
-- Extract a Socket from socket set Item. Socket is set to
-- No_Socket when the set is empty.
- function Is_Empty
- (Item : Socket_Set_Type) return Boolean;
+ function Is_Empty (Item : Socket_Set_Type) return Boolean;
-- Return True iff Item is empty
function Is_Set
return (AFC with 0, new PE'(PC_Any_CS, 1, EOP, Str));
end Any;
- function Any (Str : access VString) return Pattern is
+ function Any (Str : not null access VString) return Pattern is
begin
return (AFC with 0, new PE'(PC_Any_VP, 1, EOP, VString_Ptr (Str)));
end Any;
return (AFC with 0, new PE'(PC_Break_CS, 1, EOP, Str));
end Break;
- function Break (Str : access VString) return Pattern is
+ function Break (Str : not null access VString) return Pattern is
begin
return (AFC with 0, new PE'(PC_Break_VP, 1, EOP, VString_Ptr (Str)));
end Break;
return BreakX_Make (new PE'(PC_BreakX_CS, 3, N, Str));
end BreakX;
- function BreakX (Str : access VString) return Pattern is
+ function BreakX (Str : not null access VString) return Pattern is
begin
return BreakX_Make (new PE'(PC_BreakX_VP, 3, N, VString_Ptr (Str)));
end BreakX;
return (AFC with 0, new PE'(PC_Len_NF, 1, EOP, Count));
end Len;
- function Len (Count : access Natural) return Pattern is
+ function Len (Count : not null access Natural) return Pattern is
begin
return (AFC with 0, new PE'(PC_Len_NP, 1, EOP, Natural_Ptr (Count)));
end Len;
return (AFC with 0, new PE'(PC_NotAny_CS, 1, EOP, Str));
end NotAny;
- function NotAny (Str : access VString) return Pattern is
+ function NotAny (Str : not null access VString) return Pattern is
begin
return (AFC with 0, new PE'(PC_NotAny_VP, 1, EOP, VString_Ptr (Str)));
end NotAny;
return (AFC with 0, new PE'(PC_NSpan_CS, 1, EOP, Str));
end NSpan;
- function NSpan (Str : access VString) return Pattern is
+ function NSpan (Str : not null access VString) return Pattern is
begin
return (AFC with 0, new PE'(PC_NSpan_VP, 1, EOP, VString_Ptr (Str)));
end NSpan;
return (AFC with 0, new PE'(PC_Pos_NF, 1, EOP, Count));
end Pos;
- function Pos (Count : access Natural) return Pattern is
+ function Pos (Count : not null access Natural) return Pattern is
begin
return (AFC with 0, new PE'(PC_Pos_NP, 1, EOP, Natural_Ptr (Count)));
end Pos;
return (AFC with 0, new PE'(PC_RPos_NF, 1, EOP, Count));
end Rpos;
- function Rpos (Count : access Natural) return Pattern is
+ function Rpos (Count : not null access Natural) return Pattern is
begin
return (AFC with 0, new PE'(PC_RPos_NP, 1, EOP, Natural_Ptr (Count)));
end Rpos;
return (AFC with 0, new PE'(PC_RTab_NF, 1, EOP, Count));
end Rtab;
- function Rtab (Count : access Natural) return Pattern is
+ function Rtab (Count : not null access Natural) return Pattern is
begin
return (AFC with 0, new PE'(PC_RTab_NP, 1, EOP, Natural_Ptr (Count)));
end Rtab;
-- Setcur --
------------
- function Setcur (Var : access Natural) return Pattern is
+ function Setcur (Var : not null access Natural) return Pattern is
begin
return (AFC with 0, new PE'(PC_Setcur, 1, EOP, Natural_Ptr (Var)));
end Setcur;
return (AFC with 0, new PE'(PC_Span_CS, 1, EOP, Str));
end Span;
- function Span (Str : access VString) return Pattern is
+ function Span (Str : not null access VString) return Pattern is
begin
return (AFC with 0, new PE'(PC_Span_VP, 1, EOP, VString_Ptr (Str)));
end Span;
return (AFC with 0, new PE'(PC_Tab_NF, 1, EOP, Count));
end Tab;
- function Tab (Count : access Natural) return Pattern is
+ function Tab (Count : not null access Natural) return Pattern is
begin
return (AFC with 0, new PE'(PC_Tab_NP, 1, EOP, Natural_Ptr (Count)));
end Tab;
-- --
-- S p e c --
-- --
--- Copyright (C) 1997-2005, AdaCore --
+-- Copyright (C) 1997-2006, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
function Any (Str : VString) return Pattern;
function Any (Str : Character) return Pattern;
function Any (Str : Character_Set) return Pattern;
- function Any (Str : access VString) return Pattern;
+ function Any (Str : not null access VString) return Pattern;
function Any (Str : VString_Func) return Pattern;
-- Constructs a pattern that matches a single character that is one of
-- the characters in the given argument. The pattern fails if the current
function Break (Str : VString) return Pattern;
function Break (Str : Character) return Pattern;
function Break (Str : Character_Set) return Pattern;
- function Break (Str : access VString) return Pattern;
+ function Break (Str : not null access VString) return Pattern;
function Break (Str : VString_Func) return Pattern;
-- Constructs a pattern that matches a (possibly null) string which
-- is immediately followed by a character in the given argument. This
function BreakX (Str : VString) return Pattern;
function BreakX (Str : Character) return Pattern;
function BreakX (Str : Character_Set) return Pattern;
- function BreakX (Str : access VString) return Pattern;
+ function BreakX (Str : not null access VString) return Pattern;
function BreakX (Str : VString_Func) return Pattern;
-- Like Break, but the pattern attempts to extend on a failure to find
-- the next occurrence of a character in Str, and only fails when the
-- one attempt is made to match P, without trying alternatives.
function Len (Count : Natural) return Pattern;
- function Len (Count : access Natural) return Pattern;
+ function Len (Count : not null access Natural) return Pattern;
function Len (Count : Natural_Func) return Pattern;
-- Constructs a pattern that matches exactly the given number of
-- characters. The pattern fails if fewer than this number of characters
function NotAny (Str : VString) return Pattern;
function NotAny (Str : Character) return Pattern;
function NotAny (Str : Character_Set) return Pattern;
- function NotAny (Str : access VString) return Pattern;
+ function NotAny (Str : not null access VString) return Pattern;
function NotAny (Str : VString_Func) return Pattern;
-- Constructs a pattern that matches a single character that is not
-- one of the characters in the given argument. The pattern Fails if
function NSpan (Str : VString) return Pattern;
function NSpan (Str : Character) return Pattern;
function NSpan (Str : Character_Set) return Pattern;
- function NSpan (Str : access VString) return Pattern;
+ function NSpan (Str : not null access VString) return Pattern;
function NSpan (Str : VString_Func) return Pattern;
-- Constructs a pattern that matches the longest possible string
-- consisting entirely of characters from the given argument. The
-- string may be empty, so this pattern always succeeds.
function Pos (Count : Natural) return Pattern;
- function Pos (Count : access Natural) return Pattern;
+ function Pos (Count : not null access Natural) return Pattern;
function Pos (Count : Natural_Func) return Pattern;
-- Constructs a pattern that matches the null string if exactly Count
-- characters have already been matched, and otherwise fails.
-- unmatched characters in the pattern.
function Rpos (Count : Natural) return Pattern;
- function Rpos (Count : access Natural) return Pattern;
+ function Rpos (Count : not null access Natural) return Pattern;
function Rpos (Count : Natural_Func) return Pattern;
-- Constructs a pattern that matches the null string if exactly Count
-- characters remain to be matched in the string, and otherwise fails.
function Rtab (Count : Natural) return Pattern;
- function Rtab (Count : access Natural) return Pattern;
+ function Rtab (Count : not null access Natural) return Pattern;
function Rtab (Count : Natural_Func) return Pattern;
-- Constructs a pattern that matches from the current location until
-- exactly Count characters remain to be matched in the string. The
-- pattern fails if fewer than Count characters remain to be matched.
- function Setcur (Var : access Natural) return Pattern;
+ function Setcur (Var : not null access Natural) return Pattern;
-- Constructs a pattern that matches the null string, and assigns the
-- current cursor position in the string. This value is the number of
-- characters matched so far. So it is zero at the start of the match.
function Span (Str : VString) return Pattern;
function Span (Str : Character) return Pattern;
function Span (Str : Character_Set) return Pattern;
- function Span (Str : access VString) return Pattern;
+ function Span (Str : not null access VString) return Pattern;
function Span (Str : VString_Func) return Pattern;
-- Constructs a pattern that matches the longest possible string
-- consisting entirely of characters from the given argument. The
-- infinite alternation of null strings.
function Tab (Count : Natural) return Pattern;
- function Tab (Count : access Natural) return Pattern;
+ function Tab (Count : not null access Natural) return Pattern;
function Tab (Count : Natural_Func) return Pattern;
-- Constructs a pattern that from the current location until Count
-- characters have been matched. The pattern fails if more than Count
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2005, AdaCore --
+-- Copyright (C) 1998-2006, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
end record;
function Get_EOL
- (Source : access String;
+ (Source : not null access String;
Start : Positive)
return EOL_String;
-- Return the line terminator used in the passed string
- procedure Parse_EOL (Source : access String; Ptr : in out Positive);
+ procedure Parse_EOL
+ (Source : not null access String;
+ Ptr : in out Positive);
-- On return Source (Ptr) is the first character of the next line
-- or EOF. Source.all must be terminated by EOF.
-- completes, False if some system error (e.g. failure to read the
-- offset information) occurs.
- procedure Parse_Offset_Info (Chop_File : File_Num; Source : access String);
+ procedure Parse_Offset_Info
+ (Chop_File : File_Num;
+ Source : not null access String);
-- Parses the output of the compiler indicating the offsets
-- and names of the compilation units in Chop_File.
procedure Parse_Token
- (Source : access String;
+ (Source : not null access String;
Ptr : in out Positive;
Token_Ptr : out Positive);
-- Skips any separators and stores the start of the token in Token_Ptr.
-- of line sequence to be written at the end of the pragma.
procedure Write_Unit
- (Source : access String;
+ (Source : not null access String;
Num : Unit_Num;
TS_Time : OS_Time;
Success : out Boolean);
-------------
function Get_EOL
- (Source : access String;
+ (Source : not null access String;
Start : Positive)
return EOL_String
is
-- Parse_EOL --
---------------
- procedure Parse_EOL (Source : access String; Ptr : in out Positive) is
+ procedure Parse_EOL
+ (Source : not null access String;
+ Ptr : in out Positive) is
begin
-- Skip to end of line
procedure Parse_Offset_Info
(Chop_File : File_Num;
- Source : access String)
+ Source : not null access String)
is
First_Unit : constant Unit_Num := Unit.Last + 1;
Bufferg : String_Access := null;
-----------------
procedure Parse_Token
- (Source : access String;
+ (Source : not null access String;
Ptr : in out Positive;
Token_Ptr : out Positive)
is
----------------
procedure Write_Unit
- (Source : access String;
+ (Source : not null access String;
Num : Unit_Num;
TS_Time : OS_Time;
Success : out Boolean)
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- Copyright (C) 1999-2005, AdaCore --
+-- Copyright (C) 1999-2006, AdaCore --
-- --
-- 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- --
procedure intVecGet2
(vector : Interrupt_Vector;
pFunction : out VOIDFUNCPTR;
- pIdtGate : access int;
- pIdtSelector : access int);
+ pIdtGate : not null access int;
+ pIdtSelector : not null access int);
-- Binding to the C routine intVecGet2. Use this to get the
-- existing handler for later restoral
procedure intVecSet2
(vector : Interrupt_Vector;
pFunction : VOIDFUNCPTR;
- pIdtGate : access int;
- pIdtSelector : access int);
+ pIdtGate : not null access int;
+ pIdtSelector : not null access int);
-- Binding to the C routine intVecSet2. Use this to restore a
-- handler obtained using intVecGet2
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
- with System.Machine_Code;
- package Machine_Code renames System.Machine_Code;
+with System.Machine_Code;
+
+package Machine_Code renames System.Machine_Code;
begin
Next_Label_Elmt := First_Elmt (Label_List);
-
while Present (Next_Label_Elmt) loop
Label_Node := Node (Next_Label_Elmt);
-- No special processing required for Direct_IO close
- procedure AFCB_Close (File : access Direct_AFCB) is
+ procedure AFCB_Close (File : not null access Direct_AFCB) is
pragma Unreferenced (File);
begin
-- AFCB_Free --
---------------
- procedure AFCB_Free (File : access Direct_AFCB) is
+ procedure AFCB_Free (File : not null access Direct_AFCB) is
type FCB_Ptr is access all Direct_AFCB;
function AFCB_Allocate (Control_Block : Direct_AFCB) return FCB.AFCB_Ptr;
- procedure AFCB_Close (File : access Direct_AFCB);
- procedure AFCB_Free (File : access Direct_AFCB);
+ procedure AFCB_Close (File : not null access Direct_AFCB);
+ procedure AFCB_Free (File : not null access Direct_AFCB);
procedure Read
(File : in out Direct_AFCB;
-- in Exp_Attr by using the Valid functions in Vax_Float_Operations rather
-- than the corresponding instantiation of this function.
- function Valid (X : access T) return Boolean is
+ function Valid (X : not null access T) return Boolean is
IEEE_Emin : constant Integer := T'Machine_Emin - 1;
IEEE_Emax : constant Integer := T'Machine_Emax - 1;
-- --
-- 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- --
function Unbiased_Rounding (X : T) return T;
- function Valid (X : access T) return Boolean;
+ function Valid (X : not null access T) return Boolean;
-- This function checks if the object of type T referenced by X
-- is valid, and returns True/False accordingly. The parameter is
-- passed by reference (access) here, as the object of type T may
-- --
-- S Y S T E M . O S _ P R I M I T I V E S --
-- --
--- B o d y --
+-- B o d y --
-- --
--- Copyright (C) 1998-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1998-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- --
type BOOL is new Boolean;
for BOOL'Size use Interfaces.C.unsigned_long'Size;
- procedure GetSystemTimeAsFileTime (lpFileTime : access Long_Long_Integer);
+ procedure GetSystemTimeAsFileTime
+ (lpFileTime : not null access Long_Long_Integer);
pragma Import (Stdcall, GetSystemTimeAsFileTime, "GetSystemTimeAsFileTime");
function QueryPerformanceCounter
- (lpPerformanceCount : access LARGE_INTEGER) return BOOL;
+ (lpPerformanceCount : not null access LARGE_INTEGER) return BOOL;
pragma Import
(Stdcall, QueryPerformanceCounter, "QueryPerformanceCounter");
function QueryPerformanceFrequency
- (lpFrequency : access LARGE_INTEGER) return BOOL;
+ (lpFrequency : not null access LARGE_INTEGER) return BOOL;
pragma Import
(Stdcall, QueryPerformanceFrequency, "QueryPerformanceFrequency");
-----------------
procedure Timed_Delay (Time : Duration; Mode : Integer) is
+
+ function Mode_Clock return Duration;
+ pragma Inline (Mode_Clock);
+ -- Return the current clock value using either the monotonic clock or
+ -- standard clock depending on the Mode value.
+
+ ----------------
+ -- Mode_Clock --
+ ----------------
+
+ function Mode_Clock return Duration is
+ begin
+ case Mode is
+ when Absolute_RT =>
+ return Monotonic_Clock;
+ when others =>
+ return Clock;
+ end case;
+ end Mode_Clock;
+
Rel_Time : Duration;
Abs_Time : Duration;
- Check_Time : Duration := Monotonic_Clock;
+ Check_Time : Duration := Mode_Clock;
begin
if Mode = Relative then
if Rel_Time > 0.0 then
loop
Sleep (DWORD (Rel_Time * 1000.0));
- Check_Time := Monotonic_Clock;
+ Check_Time := Mode_Clock;
exit when Abs_Time <= Check_Time;
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1998-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- --
pragma Convention (C, struct_timeval);
function gettimeofday
- (tv : access struct_timeval;
+ (tv : not null access struct_timeval;
tz : struct_timezone_ptr) return Integer;
pragma Import (C, gettimeofday, "gettimeofday");
end record;
pragma Convention (C, timespec);
- function nanosleep (rqtp, rmtp : access timespec) return Integer;
+ function nanosleep (rqtp, rmtp : not null access timespec) return Integer;
pragma Import (C, nanosleep, "nanosleep");
-----------
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1998-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- --
pragma Convention (C, struct_timeval);
procedure gettimeofday
- (tv : access struct_timeval;
+ (tv : not null access struct_timeval;
tz : Address := Null_Address);
pragma Import (C, gettimeofday, "gettimeofday");
readfds,
writefds,
exceptfds : Address := Null_Address;
- timeout : access struct_timeval);
+ timeout : not null access struct_timeval);
pragma Import (C, C_select, "select");
-----------
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1998-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- --
pragma Convention (C, struct_timeval);
procedure gettimeofday
- (tv : access struct_timeval;
+ (tv : not null access struct_timeval;
tz : Address := Null_Address);
pragma Import (C, gettimeofday, "gettimeofday");
readfds,
writefds,
exceptfds : Address := Null_Address;
- timeout : access struct_timeval);
+ timeout : not null access struct_timeval);
pragma Import (C, C_select, "select");
-----------
-- B o d y --
-- (Dummy body for non-distributed case) --
-- --
--- 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- --
--------------------
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
is
pragma Unreferenced (Left);
pragma Unreferenced (Right);
-- No special processing required for Sequential_IO close
- procedure AFCB_Close (File : access Sequential_AFCB) is
+ procedure AFCB_Close (File : not null access Sequential_AFCB) is
pragma Warnings (Off, File);
begin
-- AFCB_Free --
---------------
- procedure AFCB_Free (File : access Sequential_AFCB) is
+ procedure AFCB_Free (File : not null access Sequential_AFCB) is
type FCB_Ptr is access all Sequential_AFCB;
function AFCB_Allocate
(Control_Block : Sequential_AFCB) return FCB.AFCB_Ptr;
- procedure AFCB_Close (File : access Sequential_AFCB);
- procedure AFCB_Free (File : access Sequential_AFCB);
+ procedure AFCB_Close (File : not null access Sequential_AFCB);
+ procedure AFCB_Free (File : not null access Sequential_AFCB);
procedure Read
(File : in out Sequential_AFCB;
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2006 Free Software Foundation, Inc. --
+-- Copyright (C) 1999-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- --
------------------------------------------------------------------------------
-- This is the general implementation of this package. There is a VxWorks
--- specific version of this package (5zstchop.adb). This file should
+-- specific version of this package (s-stchop-vxworks.adb). This file should
-- be kept synchronized with it.
pragma Restrictions (No_Elaboration_Code);
Kilobyte : constant := 1024;
- function Set_Stack_Info (Stack : access Stack_Access) return Stack_Access;
+ function Set_Stack_Info
+ (Stack : not null access Stack_Access) return Stack_Access;
-- The function Set_Stack_Info is the actual function that updates
-- the cache containing a pointer to the Stack_Info. It may also
--------------------
function Set_Stack_Info
- (Stack : access Stack_Access) return Stack_Access
+ (Stack : not null access Stack_Access) return Stack_Access
is
type Frame_Mark is null record;
Frame_Location : Frame_Mark;
-- --
------------------------------------------------------------------------------
--- This package provides a implementation of stack checking operations
--- using comparison with stack base and limit.
+-- This package provides a implementation of stack checking operations using
+-- comparison with stack base and limit.
pragma Restrictions (No_Elaboration_Code);
--- We want to guarantee the absence of elaboration code because the
--- binder does not handle references to this package.
+-- We want to guarantee the absence of elaboration code because the binder
+-- does not handle references to this package.
pragma Polling (Off);
-- Turn off polling, we do not want polling to take place during stack
pragma Preelaborate;
procedure Update_Stack_Cache (Stack : Stack_Access);
- -- Set the stack cache for the current task. Note that this is only
- -- for optimization purposes, nothing can be assumed about the
- -- contents of the cache at any time, see Set_Stack_Info.
+ -- Set the stack cache for the current task. Note that this is only for
+ -- optimization purposes, nothing can be assumed about the contents of the
+ -- cache at any time, see Set_Stack_Info.
procedure Invalidate_Stack_Cache (Any_Stack : Stack_Access);
- -- Invalidate cache entries for the task T that owns Any_Stack.
- -- This causes the Set_Stack_Info function to be called during
- -- the next stack check done by T. This can be used to interrupt
- -- task T asynchronously.
+ -- Invalidate cache entries for the task T that owns Any_Stack. This causes
+ -- the Set_Stack_Info function to be called during the next stack check
+ -- done by T. This can be used to interrupt task T asynchronously.
-- Stack_Check should be called in loops for this to work reliably.
function Stack_Check (Stack_Address : System.Address) return Stack_Access;
- -- This version of Stack_Check should not be inlined.
+ -- This version of Stack_Check should not be inlined
private
-
Cache : aliased Stack_Access := Null_Stack;
pragma Export (C, Cache, "_gnat_stack_cache");
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-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- --
-- Finalize_Lock --
-------------------
- procedure Finalize_Lock (L : access Lock) is
+ procedure Finalize_Lock (L : not null access Lock) is
begin
null;
end Finalize_Lock;
- procedure Finalize_Lock (L : access RTS_Lock) is
+ procedure Finalize_Lock (L : not null access RTS_Lock) is
begin
null;
end Finalize_Lock;
procedure Initialize_Lock
(Prio : System.Any_Priority;
- L : access Lock)
+ L : not null access Lock)
is
begin
null;
end Initialize_Lock;
- procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level) is
+ procedure Initialize_Lock
+ (L : not null access RTS_Lock; Level : Lock_Level) is
begin
null;
end Initialize_Lock;
-- Read_Lock --
---------------
- procedure Read_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
+ procedure Read_Lock
+ (L : not null access Lock; Ceiling_Violation : out Boolean) is
begin
Ceiling_Violation := False;
end Read_Lock;
-- Sleep --
-----------
- procedure Sleep (Self_ID : Task_Id; Reason : System.Tasking.Task_States) is
+ procedure Sleep (Self_ID : Task_Id; Reason : System.Tasking.Task_States) is
begin
null;
end Sleep;
-- Unlock --
------------
- procedure Unlock (L : access Lock) is
+ procedure Unlock (L : not null access Lock) is
begin
null;
end Unlock;
- procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is
+ procedure Unlock
+ (L : not null access RTS_Lock; Global_Lock : Boolean := False) is
begin
null;
end Unlock;
-- Write_Lock --
----------------
- procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
+ procedure Write_Lock
+ (L : not null access Lock; Ceiling_Violation : out Boolean) is
begin
Ceiling_Violation := False;
end Write_Lock;
procedure Write_Lock
- (L : access RTS_Lock;
+ (L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
begin
procedure Initialize_Lock
(Prio : System.Any_Priority;
- L : access Lock)
+ L : not null access Lock)
is
Attributes : aliased pthread_mutexattr_t;
Result : Interfaces.C.int;
pragma Assert (Result = 0);
end Initialize_Lock;
- procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level) is
+ procedure Initialize_Lock
+ (L : not null access RTS_Lock; Level : Lock_Level) is
pragma Unreferenced (Level);
Attributes : aliased pthread_mutexattr_t;
-- Finalize_Lock --
-------------------
- procedure Finalize_Lock (L : access Lock) is
+ procedure Finalize_Lock (L : not null access Lock) is
Result : Interfaces.C.int;
begin
Result := pthread_mutex_destroy (L.L'Access);
pragma Assert (Result = 0);
end Finalize_Lock;
- procedure Finalize_Lock (L : access RTS_Lock) is
+ procedure Finalize_Lock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
Result := pthread_mutex_destroy (L);
-- Write_Lock --
----------------
- procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
+ procedure Write_Lock
+ (L : not null access Lock; Ceiling_Violation : out Boolean)
+ is
Result : Interfaces.C.int;
begin
end Write_Lock;
procedure Write_Lock
- (L : access RTS_Lock; Global_Lock : Boolean := False)
+ (L : not null access RTS_Lock; Global_Lock : Boolean := False)
is
Result : Interfaces.C.int;
begin
-- Read_Lock --
---------------
- procedure Read_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
+ procedure Read_Lock
+ (L : not null access Lock; Ceiling_Violation : out Boolean) is
begin
Write_Lock (L, Ceiling_Violation);
end Read_Lock;
-- Unlock --
------------
- procedure Unlock (L : access Lock) is
+ procedure Unlock (L : not null access Lock) is
Result : Interfaces.C.int;
begin
Result := pthread_mutex_unlock (L.L'Access);
pragma Assert (Result = 0);
end Unlock;
- procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is
+ procedure Unlock
+ (L : not null access RTS_Lock; Global_Lock : Boolean := False)
+ is
Result : Interfaces.C.int;
begin
if not Single_Lock or else Global_Lock then
procedure Initialize_Lock
(Prio : System.Any_Priority;
- L : access Lock)
+ L : not null access Lock)
is
Attributes : aliased pthread_mutexattr_t;
Result : Interfaces.C.int;
pragma Assert (Result = 0);
end Initialize_Lock;
- procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level) is
+ procedure Initialize_Lock
+ (L : not null access RTS_Lock; Level : Lock_Level)
+ is
pragma Unreferenced (Level);
Attributes : aliased pthread_mutexattr_t;
-- Finalize_Lock --
-------------------
- procedure Finalize_Lock (L : access Lock) is
+ procedure Finalize_Lock (L : not null access Lock) is
Result : Interfaces.C.int;
begin
Result := pthread_mutex_destroy (L);
pragma Assert (Result = 0);
end Finalize_Lock;
- procedure Finalize_Lock (L : access RTS_Lock) is
+ procedure Finalize_Lock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
Result := pthread_mutex_destroy (L);
-- Write_Lock --
----------------
- procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
+ procedure Write_Lock
+ (L : not null access Lock; Ceiling_Violation : out Boolean)
+ is
Result : Interfaces.C.int;
begin
Result := pthread_mutex_lock (L);
end Write_Lock;
procedure Write_Lock
- (L : access RTS_Lock;
+ (L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
Result : Interfaces.C.int;
-- Read_Lock --
---------------
- procedure Read_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
+ procedure Read_Lock
+ (L : not null access Lock; Ceiling_Violation : out Boolean) is
begin
Write_Lock (L, Ceiling_Violation);
end Read_Lock;
-- Unlock --
------------
- procedure Unlock (L : access Lock) is
+ procedure Unlock (L : not null access Lock) is
Result : Interfaces.C.int;
begin
Result := pthread_mutex_unlock (L);
pragma Assert (Result = 0);
end Unlock;
- procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is
+ procedure Unlock
+ (L : not null access RTS_Lock; Global_Lock : Boolean := False)
+ is
Result : Interfaces.C.int;
begin
procedure Initialize_Lock
(Prio : System.Any_Priority;
- L : access Lock)
+ L : not null access Lock)
is
pragma Unreferenced (Prio);
end if;
end Initialize_Lock;
- procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level) is
+ procedure Initialize_Lock
+ (L : not null access RTS_Lock; Level : Lock_Level)
+ is
pragma Unreferenced (Level);
Result : Interfaces.C.int;
-- Finalize_Lock --
-------------------
- procedure Finalize_Lock (L : access Lock) is
+ procedure Finalize_Lock (L : not null access Lock) is
Result : Interfaces.C.int;
begin
Result := pthread_mutex_destroy (L);
pragma Assert (Result = 0);
end Finalize_Lock;
- procedure Finalize_Lock (L : access RTS_Lock) is
+ procedure Finalize_Lock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
Result := pthread_mutex_destroy (L);
-- Write_Lock --
----------------
- procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
+ procedure Write_Lock
+ (L : not null access Lock; Ceiling_Violation : out Boolean)
+ is
Result : Interfaces.C.int;
begin
Result := pthread_mutex_lock (L);
end Write_Lock;
procedure Write_Lock
- (L : access RTS_Lock;
+ (L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
Result : Interfaces.C.int;
-- Read_Lock --
---------------
- procedure Read_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
+ procedure Read_Lock
+ (L : not null access Lock; Ceiling_Violation : out Boolean) is
begin
Write_Lock (L, Ceiling_Violation);
end Read_Lock;
-- Unlock --
------------
- procedure Unlock (L : access Lock) is
+ procedure Unlock (L : not null access Lock) is
Result : Interfaces.C.int;
begin
Result := pthread_mutex_unlock (L);
pragma Assert (Result = 0);
end Unlock;
- procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is
+ procedure Unlock
+ (L : not null access RTS_Lock; Global_Lock : Boolean := False)
+ is
Result : Interfaces.C.int;
begin
if not Single_Lock or else Global_Lock then
procedure Initialize_Lock
(Prio : System.Any_Priority;
- L : access Lock)
+ L : not null access Lock)
is
Attributes : aliased pthread_mutexattr_t;
Result : Interfaces.C.int;
pragma Assert (Result = 0);
end Initialize_Lock;
- procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level) is
+ procedure Initialize_Lock
+ (L : not null access RTS_Lock; Level : Lock_Level)
+ is
pragma Unreferenced (Level);
Attributes : aliased pthread_mutexattr_t;
-- Finalize_Lock --
-------------------
- procedure Finalize_Lock (L : access Lock) is
+ procedure Finalize_Lock (L : not null access Lock) is
Result : Interfaces.C.int;
begin
Result := pthread_mutex_destroy (L.Mutex'Access);
pragma Assert (Result = 0);
end Finalize_Lock;
- procedure Finalize_Lock (L : access RTS_Lock) is
+ procedure Finalize_Lock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
Result := pthread_mutex_destroy (L);
-- Write_Lock --
----------------
- procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
+ procedure Write_Lock
+ (L : not null access Lock; Ceiling_Violation : out Boolean)
+ is
Result : Interfaces.C.int;
T : constant Task_Id := Self;
-- No tricks on RTS_Locks
procedure Write_Lock
- (L : access RTS_Lock; Global_Lock : Boolean := False)
+ (L : not null access RTS_Lock; Global_Lock : Boolean := False)
is
Result : Interfaces.C.int;
begin
-- Read_Lock --
---------------
- procedure Read_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
+ procedure Read_Lock
+ (L : not null access Lock; Ceiling_Violation : out Boolean) is
begin
Write_Lock (L, Ceiling_Violation);
end Read_Lock;
-- Unlock --
------------
- procedure Unlock (L : access Lock) is
+ procedure Unlock (L : not null access Lock) is
Result : Interfaces.C.int;
T : constant Task_Id := Self;
end if;
end Unlock;
- procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is
+ procedure Unlock
+ (L : not null access RTS_Lock; Global_Lock : Boolean := False)
+ is
Result : Interfaces.C.int;
begin
if not Single_Lock or else Global_Lock then
procedure Sleep
(Self_ID : Task_Id;
- Reason : System.Tasking.Task_States)
+ Reason : System.Tasking.Task_States)
is
pragma Unreferenced (Reason);
Result : Interfaces.C.int;
-- Condition Variable Functions --
----------------------------------
- procedure Initialize_Cond (Cond : access Condition_Variable);
+ procedure Initialize_Cond (Cond : not null access Condition_Variable);
-- Initialize given condition variable Cond
- procedure Finalize_Cond (Cond : access Condition_Variable);
+ procedure Finalize_Cond (Cond : not null access Condition_Variable);
-- Finalize given condition variable Cond
- procedure Cond_Signal (Cond : access Condition_Variable);
+ procedure Cond_Signal (Cond : not null access Condition_Variable);
-- Signal condition variable Cond
procedure Cond_Wait
- (Cond : access Condition_Variable;
- L : access RTS_Lock);
+ (Cond : not null access Condition_Variable;
+ L : not null access RTS_Lock);
-- Wait on conditional variable Cond, using lock L
procedure Cond_Timed_Wait
- (Cond : access Condition_Variable;
- L : access RTS_Lock;
+ (Cond : not null access Condition_Variable;
+ L : not null access RTS_Lock;
Rel_Time : Duration;
Timed_Out : out Boolean;
Status : out Integer);
-- Initialize_Cond --
---------------------
- procedure Initialize_Cond (Cond : access Condition_Variable) is
+ procedure Initialize_Cond (Cond : not null access Condition_Variable) is
hEvent : HANDLE;
begin
-- No such problem here, DosCloseEventSem has been derived.
-- What does such refer to in above comment???
- procedure Finalize_Cond (Cond : access Condition_Variable) is
+ procedure Finalize_Cond (Cond : not null access Condition_Variable) is
Result : BOOL;
begin
Result := CloseHandle (HANDLE (Cond.all));
-- Cond_Signal --
-----------------
- procedure Cond_Signal (Cond : access Condition_Variable) is
+ procedure Cond_Signal (Cond : not null access Condition_Variable) is
Result : BOOL;
begin
Result := SetEvent (HANDLE (Cond.all));
-- L is locked.
procedure Cond_Wait
- (Cond : access Condition_Variable;
- L : access RTS_Lock)
+ (Cond : not null access Condition_Variable;
+ L : not null access RTS_Lock)
is
Result : DWORD;
Result_Bool : BOOL;
-- L is locked.
procedure Cond_Timed_Wait
- (Cond : access Condition_Variable;
- L : access RTS_Lock;
+ (Cond : not null access Condition_Variable;
+ L : not null access RTS_Lock;
Rel_Time : Duration;
Timed_Out : out Boolean;
Status : out Integer)
procedure Initialize_Lock
(Prio : System.Any_Priority;
- L : access Lock)
+ L : not null access Lock)
is
begin
InitializeCriticalSection (L.Mutex'Access);
L.Priority := Prio;
end Initialize_Lock;
- procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level) is
+ procedure Initialize_Lock
+ (L : not null access RTS_Lock; Level : Lock_Level)
+ is
pragma Unreferenced (Level);
begin
InitializeCriticalSection (CRITICAL_SECTION (L.all)'Unrestricted_Access);
-- Finalize_Lock --
-------------------
- procedure Finalize_Lock (L : access Lock) is
+ procedure Finalize_Lock (L : not null access Lock) is
begin
DeleteCriticalSection (L.Mutex'Access);
end Finalize_Lock;
- procedure Finalize_Lock (L : access RTS_Lock) is
+ procedure Finalize_Lock (L : not null access RTS_Lock) is
begin
DeleteCriticalSection (CRITICAL_SECTION (L.all)'Unrestricted_Access);
end Finalize_Lock;
-- Write_Lock --
----------------
- procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
+ procedure Write_Lock
+ (L : not null access Lock; Ceiling_Violation : out Boolean) is
begin
L.Owner_Priority := Get_Priority (Self);
end Write_Lock;
procedure Write_Lock
- (L : access RTS_Lock;
+ (L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
begin
-- Read_Lock --
---------------
- procedure Read_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
+ procedure Read_Lock
+ (L : not null access Lock; Ceiling_Violation : out Boolean) is
begin
Write_Lock (L, Ceiling_Violation);
end Read_Lock;
-- Unlock --
------------
- procedure Unlock (L : access Lock) is
+ procedure Unlock (L : not null access Lock) is
begin
LeaveCriticalSection (L.Mutex'Access);
end Unlock;
- procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is
+ procedure Unlock
+ (L : not null access RTS_Lock; Global_Lock : Boolean := False) is
begin
if not Single_Lock or else Global_Lock then
LeaveCriticalSection (CRITICAL_SECTION (L.all)'Unrestricted_Access);
procedure Initialize_Lock
(Prio : System.Any_Priority;
- L : access Lock)
+ L : not null access Lock)
is
Attributes : aliased pthread_mutexattr_t;
Result : Interfaces.C.int;
pragma Assert (Result = 0);
end Initialize_Lock;
- procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level) is
+ procedure Initialize_Lock
+ (L : not null access RTS_Lock; Level : Lock_Level)
+ is
pragma Warnings (Off, Level);
Attributes : aliased pthread_mutexattr_t;
-- Finalize_Lock --
-------------------
- procedure Finalize_Lock (L : access Lock) is
+ procedure Finalize_Lock (L : not null access Lock) is
Result : Interfaces.C.int;
begin
pragma Assert (Result = 0);
end Finalize_Lock;
- procedure Finalize_Lock (L : access RTS_Lock) is
+ procedure Finalize_Lock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
-- Write_Lock --
----------------
- procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
+ procedure Write_Lock
+ (L : not null access Lock; Ceiling_Violation : out Boolean)
+ is
Result : Interfaces.C.int;
begin
end Write_Lock;
procedure Write_Lock
- (L : access RTS_Lock;
+ (L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
Result : Interfaces.C.int;
-- Read_Lock --
---------------
- procedure Read_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
+ procedure Read_Lock
+ (L : not null access Lock; Ceiling_Violation : out Boolean) is
begin
Write_Lock (L, Ceiling_Violation);
end Read_Lock;
-- Unlock --
------------
- procedure Unlock (L : access Lock) is
+ procedure Unlock (L : not null access Lock) is
Result : Interfaces.C.int;
begin
pragma Assert (Result = 0);
end Unlock;
- procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is
+ procedure Unlock
+ (L : not null access RTS_Lock; Global_Lock : Boolean := False)
+ is
Result : Interfaces.C.int;
begin
procedure Sleep
(Self_ID : Task_Id;
- Reason : System.Tasking.Task_States)
+ Reason : System.Tasking.Task_States)
is
pragma Warnings (Off, Reason);
pragma Assert (Result = 0);
if T.Common.Task_Info /= Default_Scope then
+ case T.Common.Task_Info is
+ when System.Task_Info.Process_Scope =>
+ Result := pthread_attr_setscope
+ (Attributes'Access, PTHREAD_SCOPE_PROCESS);
+
+ when System.Task_Info.System_Scope =>
+ Result := pthread_attr_setscope
+ (Attributes'Access, PTHREAD_SCOPE_SYSTEM);
- -- We are assuming that Scope_Type has the same values than the
- -- corresponding C macros
+ when System.Task_Info.Default_Scope =>
+ Result := 0;
+ end case;
- Result := pthread_attr_setscope
- (Attributes'Access, Task_Info_Type'Pos (T.Common.Task_Info));
pragma Assert (Result = 0);
end if;
procedure Abort_Handler
(Sig : Signal;
- Code : access siginfo_t;
- Context : access ucontext_t);
+ Code : not null access siginfo_t;
+ Context : not null access ucontext_t);
-- Target-dependent binding of inter-thread Abort signal to
-- the raising of the Abort_Signal exception.
-- See also comments in 7staprop.adb
procedure Abort_Handler
(Sig : Signal;
- Code : access siginfo_t;
- Context : access ucontext_t)
+ Code : not null access siginfo_t;
+ Context : not null access ucontext_t)
is
pragma Unreferenced (Sig);
pragma Unreferenced (Code);
procedure Initialize_Lock
(Prio : System.Any_Priority;
- L : access Lock)
+ L : not null access Lock)
is
Result : Interfaces.C.int;
end Initialize_Lock;
procedure Initialize_Lock
- (L : access RTS_Lock;
+ (L : not null access RTS_Lock;
Level : Lock_Level)
is
Result : Interfaces.C.int;
-- Finalize_Lock --
-------------------
- procedure Finalize_Lock (L : access Lock) is
+ procedure Finalize_Lock (L : not null access Lock) is
Result : Interfaces.C.int;
begin
pragma Assert (Result = 0);
end Finalize_Lock;
- procedure Finalize_Lock (L : access RTS_Lock) is
+ procedure Finalize_Lock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
-- Write_Lock --
----------------
- procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
+ procedure Write_Lock
+ (L : not null access Lock; Ceiling_Violation : out Boolean)
+ is
Result : Interfaces.C.int;
begin
end Write_Lock;
procedure Write_Lock
- (L : access RTS_Lock;
+ (L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
Result : Interfaces.C.int;
-- Read_Lock --
---------------
- procedure Read_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
+ procedure Read_Lock
+ (L : not null access Lock; Ceiling_Violation : out Boolean) is
begin
Write_Lock (L, Ceiling_Violation);
end Read_Lock;
-- Unlock --
------------
- procedure Unlock (L : access Lock) is
+ procedure Unlock (L : not null access Lock) is
Result : Interfaces.C.int;
begin
end if;
end Unlock;
- procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is
+ procedure Unlock
+ (L : not null access RTS_Lock; Global_Lock : Boolean := False)
+ is
Result : Interfaces.C.int;
begin
if not Single_Lock or else Global_Lock then
procedure Initialize_Lock
(Prio : System.Any_Priority;
- L : access Lock)
+ L : not null access Lock)
is
Attributes : aliased pthread_mutexattr_t;
Result : Interfaces.C.int;
pragma Assert (Result = 0);
end Initialize_Lock;
- procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level) is
+ procedure Initialize_Lock
+ (L : not null access RTS_Lock; Level : Lock_Level)
+ is
pragma Unreferenced (Level);
Attributes : aliased pthread_mutexattr_t;
-- Finalize_Lock --
-------------------
- procedure Finalize_Lock (L : access Lock) is
+ procedure Finalize_Lock (L : not null access Lock) is
Result : Interfaces.C.int;
begin
Result := pthread_mutex_destroy (L.L'Access);
pragma Assert (Result = 0);
end Finalize_Lock;
- procedure Finalize_Lock (L : access RTS_Lock) is
+ procedure Finalize_Lock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
Result := pthread_mutex_destroy (L);
-- Write_Lock --
----------------
- procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
+ procedure Write_Lock
+ (L : not null access Lock; Ceiling_Violation : out Boolean)
+ is
Result : Interfaces.C.int;
Self_ID : Task_Id;
All_Tasks_Link : Task_Id;
end Write_Lock;
procedure Write_Lock
- (L : access RTS_Lock; Global_Lock : Boolean := False)
+ (L : not null access RTS_Lock; Global_Lock : Boolean := False)
is
Result : Interfaces.C.int;
begin
-- Read_Lock --
---------------
- procedure Read_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
+ procedure Read_Lock
+ (L : not null access Lock; Ceiling_Violation : out Boolean) is
begin
Write_Lock (L, Ceiling_Violation);
end Read_Lock;
-- Unlock --
------------
- procedure Unlock (L : access Lock) is
+ procedure Unlock (L : not null access Lock) is
Result : Interfaces.C.int;
begin
Result := pthread_mutex_unlock (L.L'Access);
pragma Assert (Result = 0);
end Unlock;
- procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is
+ procedure Unlock
+ (L : not null access RTS_Lock; Global_Lock : Boolean := False)
+ is
Result : Interfaces.C.int;
begin
if not Single_Lock or else Global_Lock then
-- Therefore rasing Storage_Error in the following routines
-- should be able to be handled safely.
- procedure Initialize_Lock (Prio : System.Any_Priority; L : access Lock) is
+ procedure Initialize_Lock
+ (Prio : System.Any_Priority; L : not null access Lock)
+ is
Attributes : aliased pthread_mutexattr_t;
Result : Interfaces.C.int;
pragma Assert (Result = 0);
end Initialize_Lock;
- procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level) is
+ procedure Initialize_Lock
+ (L : not null access RTS_Lock; Level : Lock_Level)
+ is
pragma Unreferenced (Level);
Attributes : aliased pthread_mutexattr_t;
-- Finalize_Lock --
-------------------
- procedure Finalize_Lock (L : access Lock) is
+ procedure Finalize_Lock (L : not null access Lock) is
Result : Interfaces.C.int;
begin
Result := pthread_mutex_destroy (L.L'Access);
pragma Assert (Result = 0);
end Finalize_Lock;
- procedure Finalize_Lock (L : access RTS_Lock) is
+ procedure Finalize_Lock (L : not null access RTS_Lock) is
Result : Interfaces.C.int;
begin
Result := pthread_mutex_destroy (L);
-- Write_Lock --
----------------
- procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
+ procedure Write_Lock
+ (L : not null access Lock; Ceiling_Violation : out Boolean)
+ is
Self_ID : constant Task_Id := Self;
All_Tasks_Link : constant Task_Id := Self.Common.All_Tasks_Link;
Current_Prio : System.Any_Priority;
end Write_Lock;
procedure Write_Lock
- (L : access RTS_Lock;
+ (L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
Result : Interfaces.C.int;
-- Read_Lock --
---------------
- procedure Read_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
+ procedure Read_Lock
+ (L : not null access Lock; Ceiling_Violation : out Boolean) is
begin
Write_Lock (L, Ceiling_Violation);
end Read_Lock;
-- Unlock --
------------
- procedure Unlock (L : access Lock) is
+ procedure Unlock (L : not null access Lock) is
Result : Interfaces.C.int;
begin
Result := pthread_mutex_unlock (L.L'Access);
pragma Assert (Result = 0);
end Unlock;
- procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is
+ procedure Unlock
+ (L : not null access RTS_Lock; Global_Lock : Boolean := False)
+ is
Result : Interfaces.C.int;
begin
if not Single_Lock or else Global_Lock then
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-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- --
-- call specified below. See locking rules in System.Tasking (spec) for
-- more details.
- procedure Initialize_Lock (Prio : System.Any_Priority; L : access Lock);
- procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level);
+ procedure Initialize_Lock
+ (Prio : System.Any_Priority; L : not null access Lock);
+ procedure Initialize_Lock
+ (L : not null access RTS_Lock; Level : Lock_Level);
pragma Inline (Initialize_Lock);
-- Initialize a lock object.
--
--
-- These operations raise Storage_Error if a lack of storage is detected.
- procedure Finalize_Lock (L : access Lock);
- procedure Finalize_Lock (L : access RTS_Lock);
+ procedure Finalize_Lock (L : not null access Lock);
+ procedure Finalize_Lock (L : not null access RTS_Lock);
pragma Inline (Finalize_Lock);
-- Finalize a lock object, freeing any resources allocated by the
-- corresponding Initialize_Lock operation.
- procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean);
- procedure Write_Lock (L : access RTS_Lock; Global_Lock : Boolean := False);
- procedure Write_Lock (T : ST.Task_Id);
+ procedure Write_Lock
+ (L : not null access Lock; Ceiling_Violation : out Boolean);
+ procedure Write_Lock
+ (L : not null access RTS_Lock; Global_Lock : Boolean := False);
+ procedure Write_Lock
+ (T : ST.Task_Id);
pragma Inline (Write_Lock);
-- Lock a lock object for write access. After this operation returns,
-- the calling task holds write permission for the lock object. No other
-- holds T's lock, or has interrupt-level priority. Finalization of the
-- per-task lock is implicit in Exit_Task.
- procedure Read_Lock (L : access Lock; Ceiling_Violation : out Boolean);
+ procedure Read_Lock
+ (L : not null access Lock; Ceiling_Violation : out Boolean);
pragma Inline (Read_Lock);
-- Lock a lock object for read access. After this operation returns,
-- the calling task has non-exclusive read permission for the logical
-- potential write access, and (3) implementations of priority ceiling
-- locking that make a reader-writer distinction have higher overhead.
- procedure Unlock (L : access Lock);
- procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False);
- procedure Unlock (T : ST.Task_Id);
+ procedure Unlock
+ (L : not null access Lock);
+ procedure Unlock
+ (L : not null access RTS_Lock; Global_Lock : Boolean := False);
+ procedure Unlock
+ (T : ST.Task_Id);
pragma Inline (Unlock);
-- Unlock a locked lock object.
--
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-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- --
-- Priority is the task's priority (assumed to be in the
-- System.Any_Priority'Range)
--
- -- Stack_Address is the start address of the stack associated to the
- -- task, in case it has been preallocated by the compiler; it is equal
- -- to Null_Address when the stack needs to be allocated by the
- -- underlying operating system.
+ -- Stack_Address is the start address of the stack associated to the task,
+ -- in case it has been preallocated by the compiler; it is equal to
+ -- Null_Address when the stack needs to be allocated by the underlying
+ -- operating system.
--
-- Size is the stack size of the task to create
--
--
-- State is the compiler generated task's procedure body
--
- -- Discriminants is a pointer to a limited record whose discriminants
- -- are those of the task to create. This parameter should be passed as
- -- the single argument to State.
+ -- Discriminants is a pointer to a limited record whose discriminants are
+ -- those of the task to create. This parameter should be passed as the
+ -- single argument to State.
--
-- Elaborated is a pointer to a Boolean that must be set to true on exit
-- if the task could be sucessfully elaborated.
--
-- Chain is a linked list of task that needs to be created. On exit,
- -- Created_Task.Activation_Link will be Chain.T_ID, and Chain.T_ID
- -- will be Created_Task (e.g the created task will be linked at the front
- -- of Chain).
+ -- Created_Task.Activation_Link will be Chain.T_ID, and Chain.T_ID will be
+ -- Created_Task (the created task will be linked at the front of Chain).
--
- -- Task_Image is a string created by the compiler that the
- -- run time can store to ease the debugging and the
- -- Ada.Task_Identification facility.
+ -- Task_Image is a string created by the compiler that the run time can
+ -- store to ease the debugging and the Ada.Task_Identification facility.
--
-- Created_Task is the resulting task.
--
-- version of this procedure had code to reverse the chain, so as to
-- activate the tasks in the order of declaration. This might be nice, but
-- it is not needed if priority-based scheduling is supported, since all
- -- the activated tasks synchronize on the activators lock before they
- -- start activating and so they should start activating in priority order.
+ -- the activated tasks synchronize on the activators lock before they start
+ -- activating and so they should start activating in priority order.
procedure Complete_Restricted_Activation;
- -- Compiler interface only. Do not call from within the RTS.
- -- This should be called from the task body at the end of
- -- the elaboration code for its declarative part.
- -- Decrement the count of tasks to be activated by the activator and
- -- wake it up so it can check to see if all tasks have been activated.
- -- Except for the environment task, which should never call this procedure,
- -- T.Activator should only be null iff T has completed activation.
+ -- Compiler interface only. Do not call from within the RTS. This should be
+ -- called from the task body at the end of the elaboration code for its
+ -- declarative part. Decrement the count of tasks to be activated by the
+ -- activator and wake it up so it can check to see if all tasks have been
+ -- activated. Except for the environment task, which should never call this
+ -- procedure, T.Activator should only be null iff T has completed
+ -- activation.
procedure Complete_Restricted_Task;
- -- Compiler interface only. Do not call from within the RTS.
- -- This should be called from an implicit at-end handler
- -- associated with the task body, when it completes.
- -- From this point, the current task will become not callable.
- -- If the current task have not completed activation, this should be done
- -- now in order to wake up the activator (the environment task).
+ -- Compiler interface only. Do not call from within the RTS. This should be
+ -- called from an implicit at-end handler associated with the task body,
+ -- when it completes. From this point, the current task will become not
+ -- callable. If the current task have not completed activation, this should
+ -- be done now in order to wake up the activator (the environment task).
function Restricted_Terminated (T : Task_Id) return Boolean;
- -- Compiler interface only. Do not call from within the RTS.
- -- This is called by the compiler to implement the 'Terminated attribute.
+ -- Compiler interface only. Do not call from within the RTS. This is called
+ -- by the compiler to implement the 'Terminated attribute.
--
-- source code:
-- T1'Terminated
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2005, AdaCore --
+-- Copyright (C) 1999-2006, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- of shared library code, the offset from the beginning of the library
-- is expected as Pc.
- procedure U_init_frame_record (Frame : access CFD);
+ procedure U_init_frame_record (Frame : not null access CFD);
pragma Import (C, U_init_frame_record, "U_init_frame_record");
- procedure U_prep_frame_rec_for_unwind (Frame : access CFD);
+ procedure U_prep_frame_rec_for_unwind (Frame : not null access CFD);
pragma Import (C, U_prep_frame_rec_for_unwind,
"U_prep_frame_rec_for_unwind");
-- Fetch the description data of the frame in which these two procedures
-- are called.
- function U_get_u_rlo (Cur : access CFD; Prev : access PFD) return Integer;
+ function U_get_u_rlo
+ (Cur : not null access CFD; Prev : not null access PFD) return Integer;
pragma Import (C, U_get_u_rlo, "U_IS_STUB_OR_CALLX");
-- From a complete current frame with a return location possibly located
-- into a linker generated stub, and basic information about the previous
-- in a shared library, or something non null otherwise.
function U_get_previous_frame_x
- (current_frame : access CFD;
- previous_frame : access PFD;
+ (current_frame : not null access CFD;
+ previous_frame : not null access PFD;
previous_size : Integer) return Integer;
pragma Import (C, U_get_previous_frame_x, "U_get_previous_frame_x");
-- Fetch the data describing the "previous" frame relatively to the
-- The backtracing process needs a set of subprograms :
- function UWD_For_RLO_Of (Frame : access CFD) return UWD_Ptr;
+ function UWD_For_RLO_Of (Frame : not null access CFD) return UWD_Ptr;
-- Return an access to the unwind descriptor for the caller of
-- a given frame, using only the provided return location.
- function UWD_For_Caller_Of (Frame : access CFD) return UWD_Ptr;
+ function UWD_For_Caller_Of (Frame : not null access CFD) return UWD_Ptr;
-- Return an access to the unwind descriptor for the user code caller
-- of a given frame, or null if the information is not available.
- function Pop_Frame (Frame : access CFD) return Boolean;
+ function Pop_Frame (Frame : not null access CFD) return Boolean;
-- Update the provided machine state structure so that it reflects
-- the state one call frame "above" the initial one.
--
-- Failure typically occurs when the top of the call stack has been
-- reached.
- function Prepare_For_Unwind_Of (Frame : access CFD) return Boolean;
+ function Prepare_For_Unwind_Of
+ (Frame : not null access CFD) return Boolean;
-- Perform the necessary adaptations to the machine state before
-- calling the unwinder. Currently used for the specific case of
-- dynamically sized previous frames.
-- Pop_Frame --
---------------
- function Pop_Frame (Frame : access CFD) return Boolean is
+ function Pop_Frame (Frame : not null access CFD) return Boolean is
Up_Frame : aliased PFD;
State_Ready : Boolean;
-- Prepare_State_For_Unwind_Of --
---------------------------------
- function Prepare_For_Unwind_Of (Frame : access CFD) return Boolean
+ function Prepare_For_Unwind_Of
+ (Frame : not null access CFD) return Boolean
is
Caller_UWD : UWD_Ptr;
FP_Adjustment : Integer;
-- UWD_For_Caller_Of --
-----------------------
- function UWD_For_Caller_Of (Frame : access CFD) return UWD_Ptr
+ function UWD_For_Caller_Of (Frame : not null access CFD) return UWD_Ptr
is
UWD_Access : UWD_Ptr;
-- UWD_For_RLO_Of --
--------------------
- function UWD_For_RLO_Of (Frame : access CFD) return UWD_Ptr
+ function UWD_For_RLO_Of (Frame : not null access CFD) return UWD_Ptr
is
UWD_Address : Address;
-- --
-- B o d y --
-- --
--- 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- --
function Scan_Decimal
(Str : String;
- Ptr : access Integer;
+ Ptr : not null access Integer;
Max : Integer;
Scale : Integer) return Integer
is
-- --
-- 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- --
function Scan_Decimal
(Str : String;
- Ptr : access Integer;
+ Ptr : not null access Integer;
Max : Integer;
Scale : Integer) return Integer;
-- This function scans the string starting at Str (Ptr.all) for a valid
function Scan_Integer
(Str : String;
- Ptr : access Integer;
+ Ptr : not null access Integer;
Max : Integer) return Integer
is
Uval : Unsigned;
-- --
-- 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- --
function Scan_Integer
(Str : String;
- Ptr : access Integer;
+ Ptr : not null access Integer;
Max : Integer) return Integer;
-- This function scans the string starting at Str (Ptr.all) for a valid
-- integer according to the syntax described in (RM 3.5(43)). The substring
-- --
-- B o d y --
-- --
--- 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- --
function Scan_Long_Long_Decimal
(Str : String;
- Ptr : access Integer;
+ Ptr : not null access Integer;
Max : Integer;
Scale : Integer) return Long_Long_Integer
is
-- --
-- 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- --
function Scan_Long_Long_Decimal
(Str : String;
- Ptr : access Integer;
+ Ptr : not null access Integer;
Max : Integer;
Scale : Integer) return Long_Long_Integer;
-- This function scans the string starting at Str (Ptr.all) for a valid
function Scan_Long_Long_Integer
(Str : String;
- Ptr : access Integer;
+ Ptr : not null access Integer;
Max : Integer) return Long_Long_Integer
is
Uval : Long_Long_Unsigned;
-- --
-- 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- --
function Scan_Long_Long_Integer
(Str : String;
- Ptr : access Integer;
+ Ptr : not null access Integer;
Max : Integer) return Long_Long_Integer;
-- This function scans the string starting at Str (Ptr.all) for a valid
-- integer according to the syntax described in (RM 3.5(43)). The substring
function Scan_Raw_Long_Long_Unsigned
(Str : String;
- Ptr : access Integer;
+ Ptr : not null access Integer;
Max : Integer) return Long_Long_Unsigned
is
P : Integer;
function Scan_Long_Long_Unsigned
(Str : String;
- Ptr : access Integer;
+ Ptr : not null access Integer;
Max : Integer) return Long_Long_Unsigned
is
Start : Positive;
function Scan_Raw_Long_Long_Unsigned
(Str : String;
- Ptr : access Integer;
+ Ptr : not null access Integer;
Max : Integer) return System.Unsigned_Types.Long_Long_Unsigned;
-- This function scans the string starting at Str (Ptr.all) for a valid
-- integer according to the syntax described in (RM 3.5(43)). The substring
function Scan_Long_Long_Unsigned
(Str : String;
- Ptr : access Integer;
+ Ptr : not null access Integer;
Max : Integer) return System.Unsigned_Types.Long_Long_Unsigned;
-- Same as Scan_Raw_Long_Long_Unsigned, except scans optional leading
-- blanks, and an optional leading plus sign.
-- --
-- B o d y --
-- --
--- 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- --
function Scan_Real
(Str : String;
- Ptr : access Integer;
+ Ptr : not null access Integer;
Max : Integer) return Long_Long_Float
is
procedure Reset;
-- --
-- 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- --
function Scan_Real
(Str : String;
- Ptr : access Integer;
+ Ptr : not null access Integer;
Max : Integer) return Long_Long_Float;
-- This function scans the string starting at Str (Ptr.all) for a valid
-- real literal according to the syntax described in (RM 3.5(43)). The
function Scan_Raw_Unsigned
(Str : String;
- Ptr : access Integer;
+ Ptr : not null access Integer;
Max : Integer) return Unsigned
is
P : Integer;
function Scan_Unsigned
(Str : String;
- Ptr : access Integer;
+ Ptr : not null access Integer;
Max : Integer) return Unsigned
is
Start : Positive;
function Scan_Raw_Unsigned
(Str : String;
- Ptr : access Integer;
+ Ptr : not null access Integer;
Max : Integer) return System.Unsigned_Types.Unsigned;
-- This function scans the string starting at Str (Ptr.all) for a valid
-- integer according to the syntax described in (RM 3.5(43)). The substring
function Scan_Unsigned
(Str : String;
- Ptr : access Integer;
+ Ptr : not null access Integer;
Max : Integer) return System.Unsigned_Types.Unsigned;
-- Same as Scan_Raw_Unsigned, except scans optional leading
-- blanks, and an optional leading plus sign.
function Scan_Exponent
(Str : String;
- Ptr : access Integer;
+ Ptr : not null access Integer;
Max : Integer;
Real : Boolean := False) return Integer
is
procedure Scan_Plus_Sign
(Str : String;
- Ptr : access Integer;
+ Ptr : not null access Integer;
Max : Integer;
Start : out Positive)
is
procedure Scan_Sign
(Str : String;
- Ptr : access Integer;
+ Ptr : not null access Integer;
Max : Integer;
Minus : out Boolean;
Start : out Positive)
procedure Scan_Underscore
(Str : String;
P : in out Natural;
- Ptr : access Integer;
+ Ptr : not null access Integer;
Max : Integer;
Ext : Boolean)
is
procedure Scan_Sign
(Str : String;
- Ptr : access Integer;
+ Ptr : not null access Integer;
Max : Integer;
Minus : out Boolean;
Start : out Positive);
procedure Scan_Plus_Sign
(Str : String;
- Ptr : access Integer;
+ Ptr : not null access Integer;
Max : Integer;
Start : out Positive);
-- Same as Scan_Sign, but allows only plus, not minus.
function Scan_Exponent
(Str : String;
- Ptr : access Integer;
+ Ptr : not null access Integer;
Max : Integer;
Real : Boolean := False) return Integer;
-- Called to scan a possible exponent. Str, Ptr, Max are as described above
procedure Scan_Underscore
(Str : String;
P : in out Natural;
- Ptr : access Integer;
+ Ptr : not null access Integer;
Max : Integer;
Ext : Boolean);
-- Called if an underscore is encountered while scanning digits. Str (P)
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
+with Namet; use Namet;
+with Opt; use Opt;
+with System; use System;
+
with Ada.Unchecked_Conversion;
with GNAT.OS_Lib; use GNAT.OS_Lib;
-with Namet; use Namet;
-with Opt; use Opt;
-with System; use System;
package body Sinput.C is
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
-- S p e c --
-- --
--- This specification is adapted from the Ada Reference Manual for use with --
+-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- the .ali files
procedure Parse_EOL
- (Source : access String;
+ (Source : not null access String;
Ptr : in out Positive;
Skip_Continuation_Line : Boolean := False);
-- On return Source (Ptr) is the first character of the next line
-- The entity will never be reported as unreferenced by gnatxref -u
procedure Parse_Token
- (Source : access String;
+ (Source : not null access String;
Ptr : in out Positive;
Token_Ptr : out Positive);
-- Skips any separators and stores the start of the token in Token_Ptr.
-- and ASCII.HT. Parse_Token will never skip to the next line.
procedure Parse_Number
- (Source : access String;
+ (Source : not null access String;
Ptr : in out Positive;
Number : out Natural);
-- Skips any separators and parses Source upto the first character that
---------------
procedure Parse_EOL
- (Source : access String;
+ (Source : not null access String;
Ptr : in out Positive;
Skip_Continuation_Line : Boolean := False)
is
------------------
procedure Parse_Number
- (Source : access String;
+ (Source : not null access String;
Ptr : in out Positive;
Number : out Natural)
is
-----------------
procedure Parse_Token
- (Source : access String;
+ (Source : not null access String;
Ptr : in out Positive;
Token_Ptr : out Positive)
is
OSDN Git Service
