aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.4.3/gcc/ada/g-sttsne-locking.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.4.3/gcc/ada/g-sttsne-locking.adb')
-rw-r--r--gcc-4.4.3/gcc/ada/g-sttsne-locking.adb450
1 files changed, 450 insertions, 0 deletions
diff --git a/gcc-4.4.3/gcc/ada/g-sttsne-locking.adb b/gcc-4.4.3/gcc/ada/g-sttsne-locking.adb
new file mode 100644
index 000000000..622587123
--- /dev/null
+++ b/gcc-4.4.3/gcc/ada/g-sttsne-locking.adb
@@ -0,0 +1,450 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- G N A T . S O C K E T S . T H I N . T A S K _ S A F E _ N E T D B --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2007, 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- --
+-- 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. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This version is used on VMS and LynxOS
+
+with GNAT.Task_Lock;
+
+with Interfaces.C; use Interfaces.C;
+
+package body GNAT.Sockets.Thin.Task_Safe_NetDB is
+
+ -- The Safe_GetXXXbyYYY routines wrap the Nonreentrant_ versions using the
+ -- task lock, and copy the relevant data structures (under the lock) into
+ -- the result. The Nonreentrant_ versions are expected to be in the parent
+ -- package GNAT.Sockets.Thin (on platforms that use this version of
+ -- Task_Safe_NetDB).
+
+ procedure Copy_Host_Entry
+ (Source_Hostent : Hostent;
+ Target_Hostent : out Hostent;
+ Target_Buffer : System.Address;
+ Target_Buffer_Length : C.int;
+ Result : out C.int);
+ -- Copy all the information from Source_Hostent into Target_Hostent,
+ -- using Target_Buffer to store associated data.
+ -- 0 is returned on success, -1 on failure (in case the provided buffer
+ -- is too small for the associated data).
+
+ procedure Copy_Service_Entry
+ (Source_Servent : Servent;
+ Target_Servent : out Servent;
+ Target_Buffer : System.Address;
+ Target_Buffer_Length : C.int;
+ Result : out C.int);
+ -- Copy all the information from Source_Servent into Target_Servent,
+ -- using Target_Buffer to store associated data.
+ -- 0 is returned on success, -1 on failure (in case the provided buffer
+ -- is too small for the associated data).
+
+ procedure Store_Name
+ (Name : char_array;
+ Storage : in out char_array;
+ Storage_Index : in out size_t;
+ Stored_Name : out C.Strings.chars_ptr);
+ -- Store the given Name at the first available location in Storage
+ -- (indicated by Storage_Index, which is updated afterwards), and return
+ -- the address of that location in Stored_Name.
+ -- (Supporting routine for the two below).
+
+ ---------------------
+ -- Copy_Host_Entry --
+ ---------------------
+
+ procedure Copy_Host_Entry
+ (Source_Hostent : Hostent;
+ Target_Hostent : out Hostent;
+ Target_Buffer : System.Address;
+ Target_Buffer_Length : C.int;
+ Result : out C.int)
+ is
+ use type C.Strings.chars_ptr;
+
+ Names_Length : size_t;
+
+ Source_Aliases : Chars_Ptr_Array
+ renames Chars_Ptr_Pointers.Value
+ (Source_Hostent.H_Aliases, Terminator => C.Strings.Null_Ptr);
+ -- Null-terminated list of aliases (last element of this array is
+ -- Null_Ptr).
+
+ Source_Addresses : In_Addr_Access_Array
+ renames In_Addr_Access_Pointers.Value
+ (Source_Hostent.H_Addr_List, Terminator => null);
+
+ begin
+ Result := -1;
+ Names_Length := C.Strings.Strlen (Source_Hostent.H_Name) + 1;
+
+ for J in Source_Aliases'Range loop
+ if Source_Aliases (J) /= C.Strings.Null_Ptr then
+ Names_Length :=
+ Names_Length + C.Strings.Strlen (Source_Aliases (J)) + 1;
+ end if;
+ end loop;
+
+ declare
+ type In_Addr_Array is array (Source_Addresses'Range)
+ of aliased In_Addr;
+
+ type Netdb_Host_Data is record
+ Aliases_List : aliased Chars_Ptr_Array (Source_Aliases'Range);
+ Names : aliased char_array (1 .. Names_Length);
+
+ Addresses_List : aliased In_Addr_Access_Array
+ (In_Addr_Array'Range);
+ Addresses : In_Addr_Array;
+ -- ??? This assumes support only for Inet family
+
+ end record;
+
+ Netdb_Data : Netdb_Host_Data;
+ pragma Import (Ada, Netdb_Data);
+ for Netdb_Data'Address use Target_Buffer;
+
+ Names_Index : size_t := Netdb_Data.Names'First;
+ -- Index of first available location in Netdb_Data.Names
+
+ begin
+ if Netdb_Data'Size / 8 > Target_Buffer_Length then
+ return;
+ end if;
+
+ -- Copy host name
+
+ Store_Name
+ (C.Strings.Value (Source_Hostent.H_Name),
+ Netdb_Data.Names, Names_Index,
+ Target_Hostent.H_Name);
+
+ -- Copy aliases (null-terminated string pointer array)
+
+ Target_Hostent.H_Aliases :=
+ Netdb_Data.Aliases_List
+ (Netdb_Data.Aliases_List'First)'Unchecked_Access;
+ for J in Netdb_Data.Aliases_List'Range loop
+ if J = Netdb_Data.Aliases_List'Last then
+ Netdb_Data.Aliases_List (J) := C.Strings.Null_Ptr;
+ else
+ Store_Name
+ (C.Strings.Value (Source_Aliases (J)),
+ Netdb_Data.Names, Names_Index,
+ Netdb_Data.Aliases_List (J));
+ end if;
+ end loop;
+
+ -- Copy address type and length
+
+ Target_Hostent.H_Addrtype := Source_Hostent.H_Addrtype;
+ Target_Hostent.H_Length := Source_Hostent.H_Length;
+
+ -- Copy addresses
+
+ Target_Hostent.H_Addr_List :=
+ Netdb_Data.Addresses_List
+ (Netdb_Data.Addresses_List'First)'Unchecked_Access;
+
+ for J in Netdb_Data.Addresses'Range loop
+ if J = Netdb_Data.Addresses'Last then
+ Netdb_Data.Addresses_List (J) := null;
+ else
+ Netdb_Data.Addresses_List (J) :=
+ Netdb_Data.Addresses (J)'Unchecked_Access;
+
+ Netdb_Data.Addresses (J) := Source_Addresses (J).all;
+ end if;
+ end loop;
+ end;
+
+ Result := 0;
+ end Copy_Host_Entry;
+
+ ------------------------
+ -- Copy_Service_Entry --
+ ------------------------
+
+ procedure Copy_Service_Entry
+ (Source_Servent : Servent;
+ Target_Servent : out Servent;
+ Target_Buffer : System.Address;
+ Target_Buffer_Length : C.int;
+ Result : out C.int)
+ is
+ use type C.Strings.chars_ptr;
+
+ Names_Length : size_t;
+
+ Source_Aliases : Chars_Ptr_Array
+ renames Chars_Ptr_Pointers.Value
+ (Source_Servent.S_Aliases, Terminator => C.Strings.Null_Ptr);
+ -- Null-terminated list of aliases (last element of this array is
+ -- Null_Ptr).
+
+ begin
+ Result := -1;
+ Names_Length := C.Strings.Strlen (Source_Servent.S_Name) + 1
+ + C.Strings.Strlen (Source_Servent.S_Proto) + 1;
+
+ for J in Source_Aliases'Range loop
+ if Source_Aliases (J) /= C.Strings.Null_Ptr then
+ Names_Length :=
+ Names_Length + C.Strings.Strlen (Source_Aliases (J)) + 1;
+ end if;
+ end loop;
+
+ declare
+ type Netdb_Service_Data is record
+ Aliases_List : aliased Chars_Ptr_Array (Source_Aliases'Range);
+ Names : aliased char_array (1 .. Names_Length);
+ end record;
+
+ Netdb_Data : Netdb_Service_Data;
+ pragma Import (Ada, Netdb_Data);
+ for Netdb_Data'Address use Target_Buffer;
+
+ Names_Index : size_t := Netdb_Data.Names'First;
+ -- Index of first available location in Netdb_Data.Names
+
+ begin
+ if Netdb_Data'Size / 8 > Target_Buffer_Length then
+ return;
+ end if;
+
+ -- Copy service name
+
+ Store_Name
+ (C.Strings.Value (Source_Servent.S_Name),
+ Netdb_Data.Names, Names_Index,
+ Target_Servent.S_Name);
+
+ -- Copy aliases (null-terminated string pointer array)
+
+ Target_Servent.S_Aliases :=
+ Netdb_Data.Aliases_List
+ (Netdb_Data.Aliases_List'First)'Unchecked_Access;
+
+ -- Copy port number
+
+ Target_Servent.S_Port := Source_Servent.S_Port;
+
+ -- Copy protocol name
+
+ Store_Name
+ (C.Strings.Value (Source_Servent.S_Proto),
+ Netdb_Data.Names, Names_Index,
+ Target_Servent.S_Proto);
+
+ for J in Netdb_Data.Aliases_List'Range loop
+ if J = Netdb_Data.Aliases_List'Last then
+ Netdb_Data.Aliases_List (J) := C.Strings.Null_Ptr;
+ else
+ Store_Name
+ (C.Strings.Value (Source_Aliases (J)),
+ Netdb_Data.Names, Names_Index,
+ Netdb_Data.Aliases_List (J));
+ end if;
+ end loop;
+ end;
+
+ Result := 0;
+ end Copy_Service_Entry;
+
+ ------------------------
+ -- Safe_Gethostbyaddr --
+ ------------------------
+
+ function Safe_Gethostbyaddr
+ (Addr : System.Address;
+ Addr_Len : C.int;
+ Addr_Type : C.int;
+ Ret : not null access Hostent;
+ Buf : System.Address;
+ Buflen : C.int;
+ H_Errnop : not null access C.int) return C.int
+ is
+ HE : Hostent_Access;
+ Result : C.int;
+ begin
+ Result := -1;
+ GNAT.Task_Lock.Lock;
+ HE := Nonreentrant_Gethostbyaddr (Addr, Addr_Len, Addr_Type);
+
+ if HE = null then
+ H_Errnop.all := C.int (Host_Errno);
+ goto Unlock_Return;
+ end if;
+
+ -- Now copy the data to the user-provided buffer
+
+ Copy_Host_Entry
+ (Source_Hostent => HE.all,
+ Target_Hostent => Ret.all,
+ Target_Buffer => Buf,
+ Target_Buffer_Length => Buflen,
+ Result => Result);
+
+ <<Unlock_Return>>
+ GNAT.Task_Lock.Unlock;
+ return Result;
+ end Safe_Gethostbyaddr;
+
+ ------------------------
+ -- Safe_Gethostbyname --
+ ------------------------
+
+ function Safe_Gethostbyname
+ (Name : C.char_array;
+ Ret : not null access Hostent;
+ Buf : System.Address;
+ Buflen : C.int;
+ H_Errnop : not null access C.int) return C.int
+ is
+ HE : Hostent_Access;
+ Result : C.int;
+ begin
+ Result := -1;
+ GNAT.Task_Lock.Lock;
+ HE := Nonreentrant_Gethostbyname (Name);
+
+ if HE = null then
+ H_Errnop.all := C.int (Host_Errno);
+ goto Unlock_Return;
+ end if;
+
+ -- Now copy the data to the user-provided buffer
+
+ Copy_Host_Entry
+ (Source_Hostent => HE.all,
+ Target_Hostent => Ret.all,
+ Target_Buffer => Buf,
+ Target_Buffer_Length => Buflen,
+ Result => Result);
+
+ <<Unlock_Return>>
+ GNAT.Task_Lock.Unlock;
+ return Result;
+ end Safe_Gethostbyname;
+
+ ------------------------
+ -- Safe_Getservbyname --
+ ------------------------
+
+ function Safe_Getservbyname
+ (Name : C.char_array;
+ Proto : C.char_array;
+ Ret : not null access Servent;
+ Buf : System.Address;
+ Buflen : C.int) return C.int
+ is
+ SE : Servent_Access;
+ Result : C.int;
+ begin
+ Result := -1;
+ GNAT.Task_Lock.Lock;
+ SE := Nonreentrant_Getservbyname (Name, Proto);
+
+ if SE = null then
+ goto Unlock_Return;
+ end if;
+
+ -- Now copy the data to the user-provided buffer
+
+ Copy_Service_Entry
+ (Source_Servent => SE.all,
+ Target_Servent => Ret.all,
+ Target_Buffer => Buf,
+ Target_Buffer_Length => Buflen,
+ Result => Result);
+
+ <<Unlock_Return>>
+ GNAT.Task_Lock.Unlock;
+ return Result;
+ end Safe_Getservbyname;
+
+ ------------------------
+ -- Safe_Getservbyport --
+ ------------------------
+
+ function Safe_Getservbyport
+ (Port : C.int;
+ Proto : C.char_array;
+ Ret : not null access Servent;
+ Buf : System.Address;
+ Buflen : C.int) return C.int
+ is
+ SE : Servent_Access;
+ Result : C.int;
+
+ begin
+ Result := -1;
+ GNAT.Task_Lock.Lock;
+ SE := Nonreentrant_Getservbyport (Port, Proto);
+
+ if SE = null then
+ goto Unlock_Return;
+ end if;
+
+ -- Now copy the data to the user-provided buffer
+
+ Copy_Service_Entry
+ (Source_Servent => SE.all,
+ Target_Servent => Ret.all,
+ Target_Buffer => Buf,
+ Target_Buffer_Length => Buflen,
+ Result => Result);
+
+ <<Unlock_Return>>
+ GNAT.Task_Lock.Unlock;
+ return Result;
+ end Safe_Getservbyport;
+
+ ----------------
+ -- Store_Name --
+ ----------------
+
+ procedure Store_Name
+ (Name : char_array;
+ Storage : in out char_array;
+ Storage_Index : in out size_t;
+ Stored_Name : out C.Strings.chars_ptr)
+ is
+ First : constant C.size_t := Storage_Index;
+ Last : constant C.size_t := Storage_Index + Name'Length - 1;
+ begin
+ Storage (First .. Last) := Name;
+ Stored_Name := C.Strings.To_Chars_Ptr
+ (Storage (First .. Last)'Unrestricted_Access);
+ Storage_Index := Last + 1;
+ end Store_Name;
+
+end GNAT.Sockets.Thin.Task_Safe_NetDB;