-- --
-- B o d y --
-- --
--- --
--- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, 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- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- Or FITNESS FOr A PARTICULAR PURPOSE. See the GNU General Public License --
--- fOr mOre details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
-- --
--- 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. --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
-- --
--- GNAT was Originally developed by the GNAT team at New YOrk University. --
--- It is now maintained by Ada COre Technologies Inc (http://www.gnat.com). --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
type LIU is mod 2 ** Largest_Integer'Size;
-- Unsigned type of same length as Largest_Integer
- function To_LI is new Unchecked_Conversion (LIU, Largest_Integer);
- function From_LI is new Unchecked_Conversion (Largest_Integer, LIU);
+ function To_LI is new Ada.Unchecked_Conversion (LIU, Largest_Integer);
+ function From_LI is new Ada.Unchecked_Conversion (Largest_Integer, LIU);
function "not" (Left : Largest_Integer) return Largest_Integer is
begin
type SA is range -(2 ** Asiz) .. 2 ** Asiz - 1;
-- Signed type of same size as Address
- function To_A is new Unchecked_Conversion (SA, Address);
- function From_A is new Unchecked_Conversion (Address, SA);
+ function To_A is new Ada.Unchecked_Conversion (SA, Address);
+ function From_A is new Ada.Unchecked_Conversion (Address, SA);
function "+" (Left : Address; Right : Integer) return Address is
begin
function "-" (Left : Address; Right : Address) return Integer is
pragma Unsuppress (All_Checks);
-- Because this can raise Constraint_Error for 64-bit addresses
-
begin
- return Integer (From_A (Left - Right));
+ return Integer (From_A (Left) - From_A (Right));
end "-";
function "-" (Left : Address; Right : Integer) return Address is
function Fetch_From_Address (A : Address) return Target is
type T_Ptr is access all Target;
- function To_T_Ptr is new Unchecked_Conversion (Address, T_Ptr);
+ function To_T_Ptr is new Ada.Unchecked_Conversion (Address, T_Ptr);
Ptr : constant T_Ptr := To_T_Ptr (A);
-
begin
return Ptr.all;
end Fetch_From_Address;
procedure Assign_To_Address (A : Address; T : Target) is
type T_Ptr is access all Target;
- function To_T_Ptr is new Unchecked_Conversion (Address, T_Ptr);
+ function To_T_Ptr is new Ada.Unchecked_Conversion (Address, T_Ptr);
Ptr : constant T_Ptr := To_T_Ptr (A);
-
begin
Ptr.all := T;
end Assign_To_Address;
type BU is mod 2 ** Unsigned_Byte'Size;
-- Unsigned type of same length as Unsigned_Byte
- function To_B is new Unchecked_Conversion (BU, Unsigned_Byte);
- function From_B is new Unchecked_Conversion (Unsigned_Byte, BU);
+ function To_B is new Ada.Unchecked_Conversion (BU, Unsigned_Byte);
+ function From_B is new Ada.Unchecked_Conversion (Unsigned_Byte, BU);
function "not" (Left : Unsigned_Byte) return Unsigned_Byte is
begin
type WU is mod 2 ** Unsigned_Word'Size;
-- Unsigned type of same length as Unsigned_Word
- function To_W is new Unchecked_Conversion (WU, Unsigned_Word);
- function From_W is new Unchecked_Conversion (Unsigned_Word, WU);
+ function To_W is new Ada.Unchecked_Conversion (WU, Unsigned_Word);
+ function From_W is new Ada.Unchecked_Conversion (Unsigned_Word, WU);
function "not" (Left : Unsigned_Word) return Unsigned_Word is
begin
type LWU is mod 2 ** Unsigned_Longword'Size;
-- Unsigned type of same length as Unsigned_Longword
- function To_LW is new Unchecked_Conversion (LWU, Unsigned_Longword);
- function From_LW is new Unchecked_Conversion (Unsigned_Longword, LWU);
+ function To_LW is new Ada.Unchecked_Conversion (LWU, Unsigned_Longword);
+ function From_LW is new Ada.Unchecked_Conversion (Unsigned_Longword, LWU);
function "not" (Left : Unsigned_Longword) return Unsigned_Longword is
begin
type U32 is mod 2 ** Unsigned_32'Size;
-- Unsigned type of same length as Unsigned_32
- function To_U32 is new Unchecked_Conversion (U32, Unsigned_32);
- function From_U32 is new Unchecked_Conversion (Unsigned_32, U32);
+ function To_U32 is new Ada.Unchecked_Conversion (U32, Unsigned_32);
+ function From_U32 is new Ada.Unchecked_Conversion (Unsigned_32, U32);
function "not" (Left : Unsigned_32) return Unsigned_32 is
begin
type QWU is mod 2 ** 64; -- 64 = Unsigned_Quadword'Size
-- Unsigned type of same length as Unsigned_Quadword
- function To_QW is new Unchecked_Conversion (QWU, Unsigned_Quadword);
- function From_QW is new Unchecked_Conversion (Unsigned_Quadword, QWU);
+ function To_QW is new Ada.Unchecked_Conversion (QWU, Unsigned_Quadword);
+ function From_QW is new Ada.Unchecked_Conversion (Unsigned_Quadword, QWU);
function "not" (Left : Unsigned_Quadword) return Unsigned_Quadword is
begin
procedure Clear_Interlocked
(Bit : in out Boolean;
Old_Value : out Boolean;
- Retry_Count : in Natural;
+ Retry_Count : Natural;
Success_Flag : out Boolean)
is
pragma Warnings (Off, Retry_Count);
procedure Set_Interlocked
(Bit : in out Boolean;
Old_Value : out Boolean;
- Retry_Count : in Natural;
+ Retry_Count : Natural;
Success_Flag : out Boolean)
is
pragma Warnings (Off, Retry_Count);
---------------------
procedure Add_Interlocked
- (Addend : in Short_Integer;
- Augend : in out Aligned_Word;
- Sign : out Integer)
+ (Addend : Short_Integer;
+ Augend : in out Aligned_Word;
+ Sign : out Integer)
is
begin
SSL.Lock_Task.all;
----------------
procedure Add_Atomic
- (To : in out Aligned_Integer;
- Amount : in Integer)
+ (To : in out Aligned_Integer;
+ Amount : Integer)
is
begin
SSL.Lock_Task.all;
procedure Add_Atomic
(To : in out Aligned_Integer;
- Amount : in Integer;
- Retry_Count : in Natural;
+ Amount : Integer;
+ Retry_Count : Natural;
Old_Value : out Integer;
Success_Flag : out Boolean)
is
end Add_Atomic;
procedure Add_Atomic
- (To : in out Aligned_Long_Integer;
- Amount : in Long_Integer)
+ (To : in out Aligned_Long_Integer;
+ Amount : Long_Integer)
is
begin
SSL.Lock_Task.all;
procedure Add_Atomic
(To : in out Aligned_Long_Integer;
- Amount : in Long_Integer;
- Retry_Count : in Natural;
+ Amount : Long_Integer;
+ Retry_Count : Natural;
Old_Value : out Long_Integer;
Success_Flag : out Boolean)
is
type IU is mod 2 ** Integer'Size;
type LU is mod 2 ** Long_Integer'Size;
- function To_IU is new Unchecked_Conversion (Integer, IU);
- function From_IU is new Unchecked_Conversion (IU, Integer);
+ function To_IU is new Ada.Unchecked_Conversion (Integer, IU);
+ function From_IU is new Ada.Unchecked_Conversion (IU, Integer);
- function To_LU is new Unchecked_Conversion (Long_Integer, LU);
- function From_LU is new Unchecked_Conversion (LU, Long_Integer);
+ function To_LU is new Ada.Unchecked_Conversion (Long_Integer, LU);
+ function From_LU is new Ada.Unchecked_Conversion (LU, Long_Integer);
procedure And_Atomic
- (To : in out Aligned_Integer;
- From : in Integer)
+ (To : in out Aligned_Integer;
+ From : Integer)
is
begin
SSL.Lock_Task.all;
procedure And_Atomic
(To : in out Aligned_Integer;
- From : in Integer;
- Retry_Count : in Natural;
+ From : Integer;
+ Retry_Count : Natural;
Old_Value : out Integer;
Success_Flag : out Boolean)
is
end And_Atomic;
procedure And_Atomic
- (To : in out Aligned_Long_Integer;
- From : in Long_Integer)
+ (To : in out Aligned_Long_Integer;
+ From : Long_Integer)
is
begin
SSL.Lock_Task.all;
procedure And_Atomic
(To : in out Aligned_Long_Integer;
- From : in Long_Integer;
- Retry_Count : in Natural;
+ From : Long_Integer;
+ Retry_Count : Natural;
Old_Value : out Long_Integer;
Success_Flag : out Boolean)
is
---------------
procedure Or_Atomic
- (To : in out Aligned_Integer;
- From : in Integer)
+ (To : in out Aligned_Integer;
+ From : Integer)
is
begin
SSL.Lock_Task.all;
procedure Or_Atomic
(To : in out Aligned_Integer;
- From : in Integer;
- Retry_Count : in Natural;
+ From : Integer;
+ Retry_Count : Natural;
Old_Value : out Integer;
Success_Flag : out Boolean)
is
end Or_Atomic;
procedure Or_Atomic
- (To : in out Aligned_Long_Integer;
- From : in Long_Integer)
+ (To : in out Aligned_Long_Integer;
+ From : Long_Integer)
is
begin
SSL.Lock_Task.all;
procedure Or_Atomic
(To : in out Aligned_Long_Integer;
- From : in Long_Integer;
- Retry_Count : in Natural;
+ From : Long_Integer;
+ Retry_Count : Natural;
Old_Value : out Long_Integer;
Success_Flag : out Boolean)
is
Backward : QR_Ptr;
end record;
- function To_QR_Ptr is new Unchecked_Conversion (Address, QR_Ptr);
- function From_QR_Ptr is new Unchecked_Conversion (QR_Ptr, Address);
+ function To_QR_Ptr is new Ada.Unchecked_Conversion (Address, QR_Ptr);
+ function From_QR_Ptr is new Ada.Unchecked_Conversion (QR_Ptr, Address);
------------
-- Insqhi --
------------
procedure Insqhi
- (Item : in Address;
- Header : in Address;
+ (Item : Address;
+ Header : Address;
Status : out Insq_Status)
is
Hedr : constant QR_Ptr := To_QR_Ptr (Header);
------------
procedure Remqhi
- (Header : in Address;
+ (Header : Address;
Item : out Address;
Status : out Remq_Status)
is
------------
procedure Insqti
- (Item : in Address;
- Header : in Address;
+ (Item : Address;
+ Header : Address;
Status : out Insq_Status)
is
Hedr : constant QR_Ptr := To_QR_Ptr (Header);
------------
procedure Remqti
- (Header : in Address;
+ (Header : Address;
Item : out Address;
Status : out Remq_Status)
is
OSDN Git Service
