From b094d6c4bf572654a031ecc4afe675154c886dc5 Mon Sep 17 00:00:00 2001 From: Jing Yu Date: Thu, 22 Jul 2010 14:03:48 -0700 Subject: commit gcc-4.4.3 which is used to build gcc-4.4.3 Android toolchain in master. The source is based on fsf gcc-4.4.3 and contains local patches which are recorded in gcc-4.4.3/README.google. Change-Id: Id8c6d6927df274ae9749196a1cc24dbd9abc9887 --- gcc-4.4.3/gcc/ada/g-sttsne-locking.adb | 450 +++++++++++++++++++++++++++++++++ 1 file changed, 450 insertions(+) create mode 100644 gcc-4.4.3/gcc/ada/g-sttsne-locking.adb (limited to 'gcc-4.4.3/gcc/ada/g-sttsne-locking.adb') 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); + + <> + 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); + + <> + 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); + + <> + 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); + + <> + 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; -- cgit v1.2.3