From 4a214958d18269588e382f1a39c6d5612f37365c Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 14 Jun 2010 14:39:55 +0200 Subject: [PATCH] [multiple changes] 2010-06-14 Ed Schonberg * sem_ch8.adb (End_Use_Type): Before indicating that an operator is not use-visible, check whether it is a primitive for more than one type. 2010-06-14 Robert Dewar * sem_ch3.adb (Copy_And_Swap): Copy Has_Pragma_Unmodified flag. * sem_ch7.adb (Preserve_Full_Attributes): Preserve Has_Pragma_Unmodified flag. 2010-06-14 Thomas Quinot * g-sttsne-locking.adb, g-sttsne-locking.ads, g-sttsne.ads, g-sttsne-vxworks.adb, g-sttsne-dummy.ads: Removed. Mutual exclusion is now done in GNAT.Sockets if necessary. * gsocket.h, g-socket.adb, g-sothco.ads (GNAT.Sockets.Get_XXX_By_YYY): Ensure mutual exclusion for netdb operations if the target platform requires it. (GNAT.Sockets.Thin_Common): New binding for getXXXbyYYY, treating struct hostent as an opaque type to improve portability. * s-oscons-tmplt.c, socket.c: For the case of Vxworks, emulate gethostbyYYY using proprietary VxWorks API so that a uniform interface is available for the Ada side. * gcc-interface/Makefile.in: Remove g-sttsne-* * gcc-interface/Make-lang.in: Update dependencies. 2010-06-14 Vincent Celier * gnatcmd.adb (Mapping_File): New function. From-SVN: r160731 --- gcc/ada/ChangeLog | 32 ++ gcc/ada/g-socket.adb | 192 +++++++----- gcc/ada/g-sothco.ads | 138 ++++++--- gcc/ada/g-sttsne-dummy.ads | 39 --- gcc/ada/g-sttsne-locking.adb | 460 ----------------------------- gcc/ada/g-sttsne-locking.ads | 75 ----- gcc/ada/g-sttsne-vxworks.adb | 204 ------------- gcc/ada/g-sttsne.ads | 83 ------ gcc/ada/gcc-interface/Make-lang.in | 25 +- gcc/ada/gcc-interface/Makefile.in | 31 +- gcc/ada/gnatcmd.adb | 27 ++ gcc/ada/gsocket.h | 45 +-- gcc/ada/s-oscons-tmplt.c | 20 +- gcc/ada/sem_ch3.adb | 23 +- gcc/ada/sem_ch7.adb | 2 + gcc/ada/sem_ch8.adb | 58 +++- gcc/ada/socket.c | 328 +++++++++++++------- 17 files changed, 587 insertions(+), 1195 deletions(-) delete mode 100644 gcc/ada/g-sttsne-dummy.ads delete mode 100644 gcc/ada/g-sttsne-locking.adb delete mode 100644 gcc/ada/g-sttsne-locking.ads delete mode 100644 gcc/ada/g-sttsne-vxworks.adb delete mode 100644 gcc/ada/g-sttsne.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0bd3c49157e..484541e9d6e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,35 @@ +2010-06-14 Ed Schonberg + + * sem_ch8.adb (End_Use_Type): Before indicating that an operator is not + use-visible, check whether it is a primitive for more than one type. + +2010-06-14 Robert Dewar + + * sem_ch3.adb (Copy_And_Swap): Copy Has_Pragma_Unmodified flag. + + * sem_ch7.adb (Preserve_Full_Attributes): Preserve + Has_Pragma_Unmodified flag. + +2010-06-14 Thomas Quinot + + * g-sttsne-locking.adb, g-sttsne-locking.ads, g-sttsne.ads, + g-sttsne-vxworks.adb, g-sttsne-dummy.ads: Removed. Mutual exclusion is + now done in GNAT.Sockets if necessary. + * gsocket.h, g-socket.adb, g-sothco.ads (GNAT.Sockets.Get_XXX_By_YYY): + Ensure mutual exclusion for netdb operations if the target platform + requires it. + (GNAT.Sockets.Thin_Common): New binding for getXXXbyYYY, treating struct + hostent as an opaque type to improve portability. + * s-oscons-tmplt.c, socket.c: For the case of Vxworks, emulate + gethostbyYYY using proprietary VxWorks API so that a uniform interface + is available for the Ada side. + * gcc-interface/Makefile.in: Remove g-sttsne-* + * gcc-interface/Make-lang.in: Update dependencies. + +2010-06-14 Vincent Celier + + * gnatcmd.adb (Mapping_File): New function. + 2010-06-14 Javier Miranda * sem_ch3.adb (Derive_Subprograms): Remove over-restrictive assertion. diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb index bbfaecf89c3..0122c5a7e8c 100644 --- a/gcc/ada/g-socket.adb +++ b/gcc/ada/g-socket.adb @@ -40,7 +40,6 @@ with Interfaces.C.Strings; with GNAT.Sockets.Thin_Common; use GNAT.Sockets.Thin_Common; with GNAT.Sockets.Thin; use GNAT.Sockets.Thin; -with GNAT.Sockets.Thin.Task_Safe_NetDB; use GNAT.Sockets.Thin.Task_Safe_NetDB; with GNAT.Sockets.Linker_Options; pragma Warnings (Off, GNAT.Sockets.Linker_Options); @@ -49,6 +48,7 @@ pragma Warnings (Off, GNAT.Sockets.Linker_Options); with System; use System; with System.Communication; use System.Communication; with System.CRTL; use System.CRTL; +with System.Task_Lock; package body GNAT.Sockets is @@ -59,6 +59,7 @@ package body GNAT.Sockets is ENOERROR : constant := 0; Netdb_Buffer_Size : constant := SOSC.Need_Netdb_Buffer * 1024; + Need_Netdb_Lock : constant Boolean := SOSC.Need_Netdb_Lock /= 0; -- The network database functions gethostbyname, gethostbyaddr, -- getservbyname and getservbyport can either be guaranteed task safe by -- the operating system, or else return data through a user-provided buffer @@ -155,13 +156,20 @@ package body GNAT.Sockets is function Is_IP_Address (Name : String) return Boolean; -- Return true when Name is an IP address in standard dot notation + procedure Netdb_Lock; + pragma Inline (Netdb_Lock); + procedure Netdb_Unlock; + pragma Inline (Netdb_Unlock); + -- Lock/unlock operation used to protect netdb access for platforms that + -- require such protection. + function To_In_Addr (Addr : Inet_Addr_Type) return In_Addr; procedure To_Inet_Addr (Addr : In_Addr; Result : out Inet_Addr_Type); -- Conversion functions - function To_Host_Entry (E : Hostent) return Host_Entry_Type; + function To_Host_Entry (E : Hostent_Access) return Host_Entry_Type; -- Conversion function function To_Service_Entry (E : Servent_Access) return Service_Entry_Type; @@ -891,13 +899,19 @@ package body GNAT.Sockets is Err : aliased C.int; begin - if Safe_Gethostbyaddr (HA'Address, HA'Size / 8, SOSC.AF_INET, + Netdb_Lock; + if C_Gethostbyaddr (HA'Address, HA'Size / 8, SOSC.AF_INET, Res'Access, Buf'Address, Buflen, Err'Access) /= 0 then + Netdb_Unlock; Raise_Host_Error (Integer (Err)); end if; - return To_Host_Entry (Res); + return H : constant Host_Entry_Type := + To_Host_Entry (Res'Unchecked_Access) + do + Netdb_Unlock; + end return; end Get_Host_By_Address; ---------------------- @@ -920,13 +934,19 @@ package body GNAT.Sockets is Err : aliased C.int; begin - if Safe_Gethostbyname + Netdb_Lock; + if C_Gethostbyname (HN, Res'Access, Buf'Address, Buflen, Err'Access) /= 0 then + Netdb_Unlock; Raise_Host_Error (Integer (Err)); end if; - return To_Host_Entry (Res); + return H : constant Host_Entry_Type := + To_Host_Entry (Res'Unchecked_Access) + do + Netdb_Unlock; + end return; end; end Get_Host_By_Name; @@ -965,13 +985,19 @@ package body GNAT.Sockets is Res : aliased Servent; begin - if Safe_Getservbyname (SN, SP, Res'Access, Buf'Address, Buflen) /= 0 then + Netdb_Lock; + if C_Getservbyname (SN, SP, Res'Access, Buf'Address, Buflen) /= 0 then + Netdb_Unlock; raise Service_Error with "Service not found"; end if; -- Translate from the C format to the API format - return To_Service_Entry (Res'Unchecked_Access); + return S : constant Service_Entry_Type := + To_Service_Entry (Res'Unchecked_Access) + do + Netdb_Unlock; + end return; end Get_Service_By_Name; ------------------------- @@ -988,16 +1014,22 @@ package body GNAT.Sockets is Res : aliased Servent; begin - if Safe_Getservbyport + Netdb_Lock; + if C_Getservbyport (C.int (Short_To_Network (C.unsigned_short (Port))), SP, Res'Access, Buf'Address, Buflen) /= 0 then + Netdb_Unlock; raise Service_Error with "Service not found"; end if; -- Translate from the C format to the API format - return To_Service_Entry (Res'Unchecked_Access); + return S : constant Service_Entry_Type := + To_Service_Entry (Res'Unchecked_Access) + do + Netdb_Unlock; + end return; end Get_Service_By_Port; --------------------- @@ -1438,6 +1470,28 @@ package body GNAT.Sockets is end if; end Narrow; + ---------------- + -- Netdb_Lock -- + ---------------- + + procedure Netdb_Lock is + begin + if Need_Netdb_Lock then + System.Task_Lock.Lock; + end if; + end Netdb_Lock; + + ------------------ + -- Netdb_Unlock -- + ------------------ + + procedure Netdb_Unlock is + begin + if Need_Netdb_Lock then + System.Task_Lock.Unlock; + end if; + end Netdb_Unlock; + -------------------------------- -- Normalize_Empty_Socket_Set -- -------------------------------- @@ -2273,54 +2327,52 @@ package body GNAT.Sockets is -- To_Host_Entry -- ------------------- - function To_Host_Entry (E : Hostent) return Host_Entry_Type is + function To_Host_Entry (E : Hostent_Access) return Host_Entry_Type is use type C.size_t; + use C.Strings; - Official : constant String := - C.Strings.Value (E.H_Name); + Aliases_Count, Addresses_Count : Natural; - Aliases : constant Chars_Ptr_Array := - Chars_Ptr_Pointers.Value (E.H_Aliases); - -- H_Aliases points to a list of name aliases. The list is terminated by - -- a NULL pointer. - - Addresses : constant In_Addr_Access_Array := - In_Addr_Access_Pointers.Value (E.H_Addr_List); - -- H_Addr_List points to a list of binary addresses (in network byte - -- order). The list is terminated by a NULL pointer. - -- - -- H_Length is not used because it is currently only set to 4. + -- H_Length is not used because it is currently only set to 4 -- H_Addrtype is always AF_INET - Result : Host_Entry_Type - (Aliases_Length => Aliases'Length - 1, - Addresses_Length => Addresses'Length - 1); - -- The last element is a null pointer - - Source : C.size_t; - Target : Natural; - begin - Result.Official := To_Name (Official); - - Source := Aliases'First; - Target := Result.Aliases'First; - while Target <= Result.Aliases_Length loop - Result.Aliases (Target) := - To_Name (C.Strings.Value (Aliases (Source))); - Source := Source + 1; - Target := Target + 1; + Aliases_Count := 0; + while Hostent_H_Alias (E, C.int (Aliases_Count)) /= Null_Ptr loop + Aliases_Count := Aliases_Count + 1; end loop; - Source := Addresses'First; - Target := Result.Addresses'First; - while Target <= Result.Addresses_Length loop - To_Inet_Addr (Addresses (Source).all, Result.Addresses (Target)); - Source := Source + 1; - Target := Target + 1; + Addresses_Count := 0; + while Hostent_H_Addr (E, C.int (Addresses_Count)) /= Null_Ptr loop + Addresses_Count := Addresses_Count + 1; end loop; - return Result; + return Result : Host_Entry_Type + (Aliases_Length => Aliases_Count, + Addresses_Length => Addresses_Count) + do + Result.Official := To_Name (Value (Hostent_H_Name (E))); + + for J in Result.Aliases'Range loop + Result.Aliases (J) := + To_Name (Value (Hostent_H_Alias + (E, C.int (J - Result.Aliases'First)))); + end loop; + + for J in Result.Addresses'Range loop + declare + Addr : In_Addr; + function To_Address is + new Ada.Unchecked_Conversion (chars_ptr, System.Address); + for Addr'Address use + To_Address (Hostent_H_Addr + (E, C.int (J - Result.Addresses'First))); + pragma Import (Ada, Addr); + begin + To_Inet_Addr (Addr, Result.Addresses (J)); + end; + end loop; + end return; end To_Host_Entry; ---------------- @@ -2394,40 +2446,30 @@ package body GNAT.Sockets is ---------------------- function To_Service_Entry (E : Servent_Access) return Service_Entry_Type is + use C.Strings; use type C.size_t; - Official : constant String := C.Strings.Value (Servent_S_Name (E)); - - Aliases : constant Chars_Ptr_Array := - Chars_Ptr_Pointers.Value (Servent_S_Aliases (E)); - -- S_Aliases points to a list of name aliases. The list is - -- terminated by a NULL pointer. - - Protocol : constant String := C.Strings.Value (Servent_S_Proto (E)); - - Result : Service_Entry_Type (Aliases_Length => Aliases'Length - 1); - -- The last element is a null pointer - - Source : C.size_t; - Target : Natural; + Aliases_Count : Natural; begin - Result.Official := To_Name (Official); - - Source := Aliases'First; - Target := Result.Aliases'First; - while Target <= Result.Aliases_Length loop - Result.Aliases (Target) := - To_Name (C.Strings.Value (Aliases (Source))); - Source := Source + 1; - Target := Target + 1; + Aliases_Count := 0; + while Servent_S_Alias (E, C.int (Aliases_Count)) /= Null_Ptr loop + Aliases_Count := Aliases_Count + 1; end loop; - Result.Port := - Port_Type (Network_To_Short (C.unsigned_short (Servent_S_Port (E)))); + return Result : Service_Entry_Type (Aliases_Length => Aliases_Count) do + Result.Official := To_Name (Value (Servent_S_Name (E))); - Result.Protocol := To_Name (Protocol); - return Result; + for J in Result.Aliases'Range loop + Result.Aliases (J) := + To_Name (Value (Servent_S_Alias + (E, C.int (J - Result.Aliases'First)))); + end loop; + + Result.Protocol := To_Name (Value (Servent_S_Proto (E))); + Result.Port := + Port_Type (Network_To_Short (Servent_S_Port (E))); + end return; end To_Service_Entry; --------------- diff --git a/gcc/ada/g-sothco.ads b/gcc/ada/g-sothco.ads index 82003e2ffd5..168061d482c 100644 --- a/gcc/ada/g-sothco.ads +++ b/gcc/ada/g-sothco.ads @@ -200,18 +200,40 @@ package GNAT.Sockets.Thin_Common is pragma Inline (Set_Address); -- Set Sin.Sin_Addr to Address + ------------------ + -- Host entries -- + ------------------ + + type Hostent is new + System.Storage_Elements.Storage_Array (1 .. SOSC.SIZEOF_struct_hostent); + for Hostent'Alignment use 8; + -- Host entry. This is an opaque type used only via the following + -- accessor functions, because 'struct hostent' has different layouts on + -- different platforms. + + type Hostent_Access is access all Hostent; + pragma Convention (C, Hostent_Access); + -- Access to host entry + + function Hostent_H_Name + (E : Hostent_Access) return C.Strings.chars_ptr; + + function Hostent_H_Alias + (E : Hostent_Access; I : C.int) return C.Strings.chars_ptr; + + function Hostent_H_Addrtype + (E : Hostent_Access) return C.int; + + function Hostent_H_Length + (E : Hostent_Access) return C.int; + + function Hostent_H_Addr + (E : Hostent_Access; Index : C.int) return C.Strings.chars_ptr; + --------------------- -- Service entries -- --------------------- - type Chars_Ptr_Array is array (C.size_t range <>) of - aliased C.Strings.chars_ptr; - - package Chars_Ptr_Pointers is - new C.Pointers (C.size_t, C.Strings.chars_ptr, Chars_Ptr_Array, - C.Strings.Null_Ptr); - -- Arrays of C (char *) - type Servent is new System.Storage_Elements.Storage_Array (1 .. SOSC.SIZEOF_struct_servent); for Servent'Alignment use 8; @@ -226,48 +248,60 @@ package GNAT.Sockets.Thin_Common is function Servent_S_Name (E : Servent_Access) return C.Strings.chars_ptr; - function Servent_S_Aliases - (E : Servent_Access) return Chars_Ptr_Pointers.Pointer; + function Servent_S_Alias + (E : Servent_Access; Index : C.int) return C.Strings.chars_ptr; function Servent_S_Port - (E : Servent_Access) return C.int; + (E : Servent_Access) return C.unsigned_short; function Servent_S_Proto (E : Servent_Access) return C.Strings.chars_ptr; - procedure Servent_Set_S_Name - (E : Servent_Access; - S_Name : C.Strings.chars_ptr); - - procedure Servent_Set_S_Aliases - (E : Servent_Access; - S_Aliases : Chars_Ptr_Pointers.Pointer); - - procedure Servent_Set_S_Port - (E : Servent_Access; - S_Port : C.int); - - procedure Servent_Set_S_Proto - (E : Servent_Access; - S_Proto : C.Strings.chars_ptr); - ------------------ - -- Host entries -- + -- NetDB access -- ------------------ - type Hostent is record - H_Name : C.Strings.chars_ptr; - H_Aliases : Chars_Ptr_Pointers.Pointer; - H_Addrtype : SOSC.H_Addrtype_T; - H_Length : SOSC.H_Length_T; - H_Addr_List : In_Addr_Access_Pointers.Pointer; - end record; - pragma Convention (C, Hostent); - -- Host entry - - type Hostent_Access is access all Hostent; - pragma Convention (C, Hostent_Access); - -- Access to host entry + -- There are three possible situations for the following NetDB access + -- functions: + -- - inherently thread safe (case of data returned in a thread specific + -- buffer); + -- - thread safe using user-provided buffer; + -- - thread unsafe. + -- + -- In the first and third cases, the Buf and Buflen are ignored. In the + -- second case, the caller must provide a buffer large enough to accomodate + -- the returned data. In the third case, the caller must ensure that these + -- functions are called within a critical section. + + function C_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; + + function C_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; + + function C_Getservbyname + (Name : C.char_array; + Proto : C.char_array; + Ret : not null access Servent; + Buf : System.Address; + Buflen : C.int) return C.int; + + function C_Getservbyport + (Port : C.int; + Proto : C.char_array; + Ret : not null access Servent; + Buf : System.Address; + Buflen : C.int) return C.int; ------------------------------------ -- Scatter/gather vector handling -- @@ -362,12 +396,20 @@ private pragma Import (C, C_Ioctl, "__gnat_socket_ioctl"); pragma Import (C, Inet_Pton, SOSC.Inet_Pton_Linkname); - pragma Import (C, Servent_S_Name, "__gnat_servent_s_name"); - pragma Import (C, Servent_S_Aliases, "__gnat_servent_s_aliases"); - pragma Import (C, Servent_S_Port, "__gnat_servent_s_port"); + pragma Import (C, C_Gethostbyname, "__gnat_gethostbyname"); + pragma Import (C, C_Gethostbyaddr, "__gnat_gethostbyaddr"); + pragma Import (C, C_Getservbyname, "__gnat_getservbyname"); + pragma Import (C, C_Getservbyport, "__gnat_getservbyport"); + + pragma Import (C, Servent_S_Name, "__gnat_servent_s_name"); + pragma Import (C, Servent_S_Alias, "__gnat_servent_s_alias"); + pragma Import (C, Servent_S_Port, "__gnat_servent_s_port"); pragma Import (C, Servent_S_Proto, "__gnat_servent_s_proto"); - pragma Import (C, Servent_Set_S_Name, "__gnat_servent_set_s_name"); - pragma Import (C, Servent_Set_S_Aliases, "__gnat_servent_set_s_aliases"); - pragma Import (C, Servent_Set_S_Port, "__gnat_servent_set_s_port"); - pragma Import (C, Servent_Set_S_Proto, "__gnat_servent_set_s_proto"); + + pragma Import (C, Hostent_H_Name, "__gnat_hostent_h_name"); + pragma Import (C, Hostent_H_Alias, "__gnat_hostent_h_alias"); + pragma Import (C, Hostent_H_Addrtype, "__gnat_hostent_h_addrtype"); + pragma Import (C, Hostent_H_Length, "__gnat_hostent_h_length"); + pragma Import (C, Hostent_H_Addr, "__gnat_hostent_h_addr"); + end GNAT.Sockets.Thin_Common; diff --git a/gcc/ada/g-sttsne-dummy.ads b/gcc/ada/g-sttsne-dummy.ads deleted file mode 100644 index 9cb25898dfa..00000000000 --- a/gcc/ada/g-sttsne-dummy.ads +++ /dev/null @@ -1,39 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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 -- --- -- --- S p e c -- --- -- --- Copyright (C) 2007-2008, 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 package is a placeholder for the sockets binding for platforms where --- it is not implemented. - -package GNAT.Sockets.Thin.Task_Safe_NetDB is - pragma Unimplemented_Unit; -end GNAT.Sockets.Thin.Task_Safe_NetDB; diff --git a/gcc/ada/g-sttsne-locking.adb b/gcc/ada/g-sttsne-locking.adb deleted file mode 100644 index c5e39b734b9..00000000000 --- a/gcc/ada/g-sttsne-locking.adb +++ /dev/null @@ -1,460 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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-2009, 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_Access; - Target_Servent : Servent_Access; - 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_Access; - Target_Servent : Servent_Access; - 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 - (Servent_S_Aliases (Source_Servent), - 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 (Servent_S_Name (Source_Servent)) + 1 + - C.Strings.Strlen (Servent_S_Proto (Source_Servent)) + 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 - - Stored_Name : C.Strings.chars_ptr; - - begin - if Netdb_Data'Size / 8 > Target_Buffer_Length then - return; - end if; - - -- Copy service name - - Store_Name - (C.Strings.Value (Servent_S_Name (Source_Servent)), - Netdb_Data.Names, Names_Index, - Stored_Name); - Servent_Set_S_Name (Target_Servent, Stored_Name); - - -- Copy aliases (null-terminated string pointer array) - - Servent_Set_S_Aliases - (Target_Servent, - Netdb_Data.Aliases_List - (Netdb_Data.Aliases_List'First)'Unchecked_Access); - - -- Copy port number - - Servent_Set_S_Port (Target_Servent, Servent_S_Port (Source_Servent)); - - -- Copy protocol name - - Store_Name - (C.Strings.Value (Servent_S_Proto (Source_Servent)), - Netdb_Data.Names, Names_Index, - Stored_Name); - Servent_Set_S_Proto (Target_Servent, Stored_Name); - - 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. We convert Ret to - -- type Servent_Access using the .all'Unchecked_Access trick to avoid - -- an accessibility check. Ret could be pointing to a nested variable, - -- and we don't want to raise an exception in that case. - - Copy_Service_Entry - (Source_Servent => SE, - Target_Servent => Ret.all'Unchecked_Access, - 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. See Safe_Getservbyname - -- for comment regarding .all'Unchecked_Access. - - Copy_Service_Entry - (Source_Servent => SE, - Target_Servent => Ret.all'Unchecked_Access, - 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; diff --git a/gcc/ada/g-sttsne-locking.ads b/gcc/ada/g-sttsne-locking.ads deleted file mode 100644 index 0032d8066a1..00000000000 --- a/gcc/ada/g-sttsne-locking.ads +++ /dev/null @@ -1,75 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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 -- --- -- --- S p e c -- --- -- --- 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, LynxOS, and VxWorks. There are two versions of --- the body: one for VMS and LynxOS, the other for VxWorks. - --- This package should not be directly with'ed by an application - -package GNAT.Sockets.Thin.Task_Safe_NetDB is - - ---------------------------------------- - -- Reentrant network databases access -- - ---------------------------------------- - - 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; - - 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; - - 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; - - function Safe_Getservbyport - (Port : C.int; - Proto : C.char_array; - Ret : not null access Servent; - Buf : System.Address; - Buflen : C.int) return C.int; - -end GNAT.Sockets.Thin.Task_Safe_NetDB; diff --git a/gcc/ada/g-sttsne-vxworks.adb b/gcc/ada/g-sttsne-vxworks.adb deleted file mode 100644 index a91cd873c3b..00000000000 --- a/gcc/ada/g-sttsne-vxworks.adb +++ /dev/null @@ -1,204 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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-2008, 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 VxWorks. Note that the corresponding spec is in --- g-sttsne-locking.ads. - -with Ada.Unchecked_Conversion; -with Interfaces.C; use Interfaces.C; - -package body GNAT.Sockets.Thin.Task_Safe_NetDB is - - -- The following additional data is returned by Safe_Gethostbyname - -- and Safe_Getostbyaddr in the user provided buffer. - - type Netdb_Host_Data (Name_Length : C.size_t) is record - Address : aliased In_Addr; - Addr_List : aliased In_Addr_Access_Array (0 .. 1); - Name : aliased C.char_array (0 .. Name_Length); - end record; - - Alias_Access : constant Chars_Ptr_Pointers.Pointer := - new C.Strings.chars_ptr'(C.Strings.Null_Ptr); - -- Constant used to create a Hostent record manually - - ------------------------ - -- 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 - type int_Access is access int; - function To_Pointer is - new Ada.Unchecked_Conversion (System.Address, int_Access); - - function VxWorks_hostGetByAddr - (Addr : C.int; Buf : System.Address) return C.int; - pragma Import (C, VxWorks_hostGetByAddr, "hostGetByAddr"); - - Netdb_Data : Netdb_Host_Data (Name_Length => Max_Name_Length); - pragma Import (Ada, Netdb_Data); - for Netdb_Data'Address use Buf; - - begin - pragma Assert (Addr_Type = SOSC.AF_INET); - pragma Assert (Addr_Len = In_Addr'Size / 8); - - -- Check that provided buffer is sufficiently large to hold the - -- data we want to return. - - if Netdb_Data'Size / 8 > Buflen then - H_Errnop.all := SOSC.ERANGE; - return -1; - end if; - - if VxWorks_hostGetByAddr (To_Pointer (Addr).all, - Netdb_Data.Name'Address) - /= SOSC.OK - then - H_Errnop.all := C.int (Host_Errno); - return -1; - end if; - - Netdb_Data.Address := To_In_Addr (To_Pointer (Addr).all); - Netdb_Data.Addr_List := - (0 => Netdb_Data.Address'Unchecked_Access, - 1 => null); - - Ret.H_Name := C.Strings.To_Chars_Ptr - (Netdb_Data.Name'Unrestricted_Access); - Ret.H_Aliases := Alias_Access; - Ret.H_Addrtype := SOSC.AF_INET; - Ret.H_Length := 4; - Ret.H_Addr_List := - Netdb_Data.Addr_List (Netdb_Data.Addr_List'First)'Unchecked_Access; - return 0; - 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 - function VxWorks_hostGetByName - (Name : C.char_array) return C.int; - pragma Import (C, VxWorks_hostGetByName, "hostGetByName"); - - Addr : C.int; - - begin - Addr := VxWorks_hostGetByName (Name); - if Addr = SOSC.ERROR then - H_Errnop.all := C.int (Host_Errno); - return -1; - end if; - - declare - Netdb_Data : Netdb_Host_Data (Name_Length => Name'Length); - pragma Import (Ada, Netdb_Data); - for Netdb_Data'Address use Buf; - - begin - -- Check that provided buffer is sufficiently large to hold the - -- data we want to return. - - if Netdb_Data'Size / 8 > Buflen then - H_Errnop.all := SOSC.ERANGE; - return -1; - end if; - - Netdb_Data.Address := To_In_Addr (Addr); - Netdb_Data.Addr_List := - (0 => Netdb_Data.Address'Unchecked_Access, - 1 => null); - Netdb_Data.Name (Netdb_Data.Name'First .. Name'Length - 1) := Name; - - Ret.H_Name := C.Strings.To_Chars_Ptr - (Netdb_Data.Name'Unrestricted_Access); - Ret.H_Aliases := Alias_Access; - Ret.H_Addrtype := SOSC.AF_INET; - Ret.H_Length := 4; - Ret.H_Addr_List := - Netdb_Data.Addr_List (Netdb_Data.Addr_List'First)'Unchecked_Access; - end; - return 0; - 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 - pragma Unreferenced (Name, Proto, Ret, Buf, Buflen); - begin - -- Not available under VxWorks - return -1; - 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 - pragma Unreferenced (Port, Proto, Ret, Buf, Buflen); - begin - -- Not available under VxWorks - return -1; - end Safe_Getservbyport; - -end GNAT.Sockets.Thin.Task_Safe_NetDB; diff --git a/gcc/ada/g-sttsne.ads b/gcc/ada/g-sttsne.ads deleted file mode 100644 index f438a0aea47..00000000000 --- a/gcc/ada/g-sttsne.ads +++ /dev/null @@ -1,83 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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 -- --- -- --- S p e c -- --- -- --- 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 package exports reentrant NetDB subprograms. This is the default --- version, used on most platforms. The routines are implemented by importing --- from C; see gsocket.h for details. Different versions are provided on --- platforms where this functionality is implemented in Ada. - --- This package should not be directly with'ed by an application - -package GNAT.Sockets.Thin.Task_Safe_NetDB is - - ---------------------------------------- - -- Reentrant network databases access -- - ---------------------------------------- - - 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; - - 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; - - 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; - - function Safe_Getservbyport - (Port : C.int; - Proto : C.char_array; - Ret : not null access Servent; - Buf : System.Address; - Buflen : C.int) return C.int; - -private - pragma Import (C, Safe_Gethostbyname, "__gnat_safe_gethostbyname"); - pragma Import (C, Safe_Gethostbyaddr, "__gnat_safe_gethostbyaddr"); - pragma Import (C, Safe_Getservbyname, "__gnat_safe_getservbyname"); - pragma Import (C, Safe_Getservbyport, "__gnat_safe_getservbyport"); - -end GNAT.Sockets.Thin.Task_Safe_NetDB; diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index 6f42a0eb486..fcdb83fc816 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -3385,18 +3385,19 @@ ada/sem_ch12.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/sem_elab.ads ada/sem_elim.ads ada/sem_eval.ads ada/sem_res.ads \ ada/sem_scil.ads ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \ ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinfo-cn.ads \ - ada/sinput.ads ada/sinput-l.ads ada/snames.ads ada/stand.ads \ - ada/stringt.ads ada/style.ads ada/styleg.ads ada/styleg.adb \ - ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \ - ada/s-exctab.adb ada/s-htable.ads ada/s-htable.adb ada/s-imenne.ads \ - ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \ - ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \ - ada/s-stoele.ads ada/s-stoele.adb ada/s-strhas.ads ada/s-string.ads \ - ada/s-traent.ads ada/s-unstyp.ads ada/s-utf_32.ads ada/s-wchcon.ads \ - ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \ - ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \ - ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \ - ada/unchdeal.ads ada/urealp.ads ada/urealp.adb ada/widechar.ads + ada/sinput.ads ada/sinput.adb ada/sinput-l.ads ada/snames.ads \ + ada/stand.ads ada/stringt.ads ada/style.ads ada/styleg.ads \ + ada/styleg.adb ada/stylesw.ads ada/system.ads ada/s-crc32.ads \ + ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads ada/s-htable.adb \ + ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \ + ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \ + ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-strhas.ads \ + ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-utf_32.ads \ + ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \ + ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \ + ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \ + ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb \ + ada/widechar.ads ada/sem_ch13.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \ diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index 0e5692ee0b2..2740d351dbb 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -380,7 +380,7 @@ MLIB_TGT = mlib-tgt # to LIBGNAT_TARGET_PAIRS. GNATRTL_SOCKETS_OBJS = g-soccon$(objext) g-socket$(objext) g-socthi$(objext) \ - g-soliop$(objext) g-sothco$(objext) g-sttsne$(objext) + g-soliop$(objext) g-sothco$(objext) DUMMY_SOCKETS_TARGET_PAIRS = \ g-socket.adb Project, + Language => Name_Ada, + In_Tree => Project_Tree, + Name => Result); + return Result; + end Mapping_File; + ------------------ -- Process_Link -- ------------------ @@ -2156,6 +2177,7 @@ begin declare CP_File : constant Path_Name_Type := Configuration_Pragmas_File; + M_File : constant Path_Name_Type := Mapping_File; begin if CP_File /= No_Path then @@ -2169,6 +2191,11 @@ begin (new String'("-gnatec=" & Get_Name_String (CP_File))); end if; end if; + + if M_File /= No_Path then + Add_To_Carg_Switches + (new String'("-gnatem=" & Get_Name_String (M_File))); + end if; end; end if; diff --git a/gcc/ada/gsocket.h b/gcc/ada/gsocket.h index a8e6faa2467..7763b1801de 100644 --- a/gcc/ada/gsocket.h +++ b/gcc/ada/gsocket.h @@ -194,34 +194,37 @@ #include #endif -/* - * Handling of gethostbyname, gethostbyaddr, getservbyname and getservbyport - * ========================================================================= - * - * The default implementation of GNAT.Sockets.Thin requires that these - * operations be either thread safe, or that a reentrant version getXXXbyYYY_r - * be provided. In both cases, socket.c provides a __gnat_safe_getXXXbyYYY - * function with the same signature as getXXXbyYYY_r. If the operating - * system version of getXXXbyYYY is thread safe, the provided auxiliary - * buffer argument is unused and ignored. - * - * Target specific versions of GNAT.Sockets.Thin for platforms that can't - * fulfill these requirements must provide their own protection mechanism - * in Safe_GetXXXbyYYY, and if they require GNAT.Sockets to provide a buffer - * to this effect, then we need to set Need_Netdb_Buffer here (case of - * VxWorks and VMS). - */ - -#if defined (_AIX) || defined (__FreeBSD__) || defined (__hpux__) || defined (__osf__) || defined (_WIN32) || defined (__APPLE__) +#if defined (_AIX) || defined (__FreeBSD__) || defined (__hpux__) || \ + defined (__osf__) || defined (_WIN32) || defined (__APPLE__) # define HAVE_THREAD_SAFE_GETxxxBYyyy 1 -#elif defined (sgi) || defined (linux) || defined (__GLIBC__) || (defined (sun) && defined (__SVR4) && !defined (__vxworks)) || defined(__rtems__) + +#elif defined (sgi) || defined (linux) || defined (__GLIBC__) || \ + (defined (sun) && defined (__SVR4) && !defined (__vxworks)) || \ + defined(__rtems__) # define HAVE_GETxxxBYyyy_R 1 #endif -#if defined (HAVE_GETxxxBYyyy_R) || !defined (HAVE_THREAD_SAFE_GETxxxBYyyy) +/* + * Properties of the unerlying NetDB library: + * Need_Netdb_Buffer __gnat_getXXXbyYYY expects a caller-supplied buffer + * Need_Netdb_Lock __gnat_getXXXbyYYY expects the caller to ensure + * mutual exclusion + * + * See "Handling of gethostbyname, gethostbyaddr, getservbyname and + * getservbyport" in socket.c for details. + */ + +#if defined (HAVE_GETxxxBYyyy_R) # define Need_Netdb_Buffer 1 +# define Need_Netdb_Lock 0 + #else # define Need_Netdb_Buffer 0 +# if !defined (HAVE_THREAD_SAFE_GETxxxBYyyy) +# define Need_Netdb_Lock 1 +# else +# define Need_Netdb_Lock 0 +# endif #endif #if defined (__FreeBSD__) || defined (__vxworks) || defined(__rtems__) diff --git a/gcc/ada/s-oscons-tmplt.c b/gcc/ada/s-oscons-tmplt.c index a7ca809bf94..7e34a74b611 100644 --- a/gcc/ada/s-oscons-tmplt.c +++ b/gcc/ada/s-oscons-tmplt.c @@ -1231,24 +1231,11 @@ CND(SIZEOF_sockaddr_in6, "struct sockaddr_in6") #define SIZEOF_fd_set (sizeof (fd_set)) CND(SIZEOF_fd_set, "fd_set"); +#define SIZEOF_struct_hostent (sizeof (struct hostent)) +CND(SIZEOF_struct_hostent, "struct hostent"); + #define SIZEOF_struct_servent (sizeof (struct servent)) CND(SIZEOF_struct_servent, "struct servent"); -/* - - -- Fields of struct hostent -*/ - -#ifdef __MINGW32__ -# define h_addrtype_t "short" -# define h_length_t "short" -#else -# define h_addrtype_t "int" -# define h_length_t "int" -#endif - -TXT(" subtype H_Addrtype_T is Interfaces.C." h_addrtype_t ";") -TXT(" subtype H_Length_T is Interfaces.C." h_length_t ";") - /* -- Fields of struct msghdr @@ -1271,6 +1258,7 @@ TXT(" subtype Msg_Iovlen_T is Interfaces.C." msg_iovlen_t ";") */ CND(Need_Netdb_Buffer, "Need buffer for Netdb ops") +CND(Need_Netdb_Lock, "Need lock for Netdb ops") CND(Has_Sockaddr_Len, "Sockaddr has sa_len field") /** diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index eb22cb1a8bd..d1a69740379 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -11283,6 +11283,7 @@ package body Sem_Ch3 is Set_Is_Public (Full, Is_Public (Priv)); Set_Is_Pure (Full, Is_Pure (Priv)); Set_Is_Tagged_Type (Full, Is_Tagged_Type (Priv)); + Set_Has_Pragma_Unmodified (Full, Has_Pragma_Unmodified (Priv)); Set_Has_Pragma_Unreferenced (Full, Has_Pragma_Unreferenced (Priv)); Set_Has_Pragma_Unreferenced_Objects (Full, Has_Pragma_Unreferenced_Objects @@ -11318,10 +11319,10 @@ package body Sem_Ch3 is Access_Types_To_Process (Freeze_Node (Priv))); end if; - -- Swap the two entities. Now Privat is the full type entity and - -- Full is the private one. They will be swapped back at the end - -- of the private part. This swapping ensures that the entity that - -- is visible in the private part is the full declaration. + -- Swap the two entities. Now Privat is the full type entity and Full is + -- the private one. They will be swapped back at the end of the private + -- part. This swapping ensures that the entity that is visible in the + -- private part is the full declaration. Exchange_Entities (Priv, Full); Append_Entity (Full, Scope (Full)); @@ -12810,13 +12811,12 @@ package body Sem_Ch3 is if Need_Search or else (Present (Generic_Actual) - and then Present (Act_Subp) - and then not Primitive_Names_Match (Subp, Act_Subp)) + and then Present (Act_Subp) + and then not Primitive_Names_Match (Subp, Act_Subp)) then pragma Assert (not Is_Ancestor (Parent_Base, Generic_Actual)); - -- Remember that we need searching for all the pending - -- primitives + -- Remember that we need searching for all pending primitives Need_Search := True; @@ -12840,8 +12840,9 @@ package body Sem_Ch3 is Act_Subp := Node (Act_Elmt); exit when Primitive_Names_Match (Subp, Act_Subp) - and then Type_Conformant (Subp, Act_Subp, - Skip_Controlling_Formals => True) + and then Type_Conformant + (Subp, Act_Subp, + Skip_Controlling_Formals => True) and then No (Interface_Alias (Act_Subp)); Next_Elmt (Act_Elmt); @@ -12870,7 +12871,7 @@ package body Sem_Ch3 is and then Is_Interface (Find_Dispatching_Type (Alias_Subp)) and then not (Nkind (Parent (Alias_Subp)) = N_Procedure_Specification - and then Null_Present (Parent (Alias_Subp))) + and then Null_Present (Parent (Alias_Subp))) then Derive_Subprogram (New_Subp => New_Subp, diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index c4310cd35f9..ca5b18ad77c 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -1954,6 +1954,7 @@ package body Sem_Ch7 is Set_Is_Volatile (Priv, Is_Volatile (Full)); Set_Treat_As_Volatile (Priv, Treat_As_Volatile (Full)); Set_Is_Ada_2005_Only (Priv, Is_Ada_2005_Only (Full)); + Set_Has_Pragma_Unmodified (Priv, Has_Pragma_Unmodified (Full)); Set_Has_Pragma_Unreferenced (Priv, Has_Pragma_Unreferenced (Full)); Set_Has_Pragma_Unreferenced_Objects (Priv, Has_Pragma_Unreferenced_Objects @@ -2032,6 +2033,7 @@ package body Sem_Ch7 is end if; Set_Has_Discriminants (Priv, Has_Discriminants (Full)); + if Has_Discriminants (Full) then Set_Discriminant_Constraint (Priv, Discriminant_Constraint (Full)); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 25f45a2cf27..ad722430890 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -3426,33 +3426,47 @@ package body Sem_Ch8 is ------------------ procedure End_Use_Type (N : Node_Id) is + Elmt : Elmt_Id; Id : Entity_Id; Op_List : Elist_Id; - Elmt : Elmt_Id; + Op : Entity_Id; T : Entity_Id; + function May_Be_Used_Primitive_Of (T : Entity_Id) return Boolean; + -- An operator may be primitive in several types, if they are declared + -- in the same scope as the operator. To determine the use-visiblity of + -- the operator in such cases we must examine all types in the profile. + + ------------------------------ + -- May_Be_Used_Primitive_Of -- + ------------------------------ + + function May_Be_Used_Primitive_Of (T : Entity_Id) return Boolean is + begin + return Scope (Op) = Scope (T) + and then (In_Use (T) or else Is_Potentially_Use_Visible (T)); + end May_Be_Used_Primitive_Of; + + -- Start of processing for End_Use_Type + begin Id := First (Subtype_Marks (N)); while Present (Id) loop - -- A call to rtsfind may occur while analyzing a use_type clause, + -- A call to Rtsfind may occur while analyzing a use_type clause, -- in which case the type marks are not resolved yet, and there is -- nothing to remove. - if not Is_Entity_Name (Id) - or else No (Entity (Id)) - then + if not Is_Entity_Name (Id) or else No (Entity (Id)) then goto Continue; end if; T := Entity (Id); - if T = Any_Type - or else From_With_Type (T) - then + if T = Any_Type or else From_With_Type (T) then null; - -- Note that the use_Type clause may mention a subtype of the type + -- Note that the use_type clause may mention a subtype of the type -- whose primitive operations have been made visible. Here as -- elsewhere, it is the base type that matters for visibility. @@ -3468,8 +3482,30 @@ package body Sem_Ch8 is Elmt := First_Elmt (Op_List); while Present (Elmt) loop - if Nkind (Node (Elmt)) = N_Defining_Operator_Symbol then - Set_Is_Potentially_Use_Visible (Node (Elmt), False); + Op := Node (Elmt); + + if Nkind (Op) = N_Defining_Operator_Symbol then + declare + T_First : constant Entity_Id := + Base_Type (Etype (First_Formal (Op))); + T_Res : constant Entity_Id := Base_Type (Etype (Op)); + T_Next : Entity_Id; + + begin + if Present (Next_Formal (First_Formal (Op))) then + T_Next := + Base_Type (Etype (Next_Formal (First_Formal (Op)))); + else + T_Next := T_First; + end if; + + if not May_Be_Used_Primitive_Of (T_First) + and then not May_Be_Used_Primitive_Of (T_Next) + and then not May_Be_Used_Primitive_Of (T_Res) + then + Set_Is_Potentially_Use_Visible (Op, False); + end if; + end; end if; Next_Elmt (Elmt); diff --git a/gcc/ada/socket.c b/gcc/ada/socket.c index 76755643161..d03ddea8164 100644 --- a/gcc/ada/socket.c +++ b/gcc/ada/socket.c @@ -32,6 +32,7 @@ /* This file provides a portable binding to the sockets API */ #include "gsocket.h" + #ifdef VMS /* * For VMS, gsocket.h can't include sockets-related DEC C header files @@ -42,16 +43,41 @@ # include "s-oscons.h" /* - * We also need the declaration of struct servent, which s-oscons can't - * provide, so we copy it manually here. This needs to be kept in synch + * We also need the declaration of struct hostent/servent, which s-oscons + * can't provide, so we copy it manually here. This needs to be kept in synch * with the definition of that structure in the DEC C headers, which * hopefully won't change frequently. */ +typedef char *__netdb_char_ptr __attribute__ (( mode (SI) )); +typedef __netdb_char_ptr *__netdb_char_ptr_ptr __attribute__ (( mode (SI) )); +# define NEED_STRUCT_xxxENT + +#elif defined (__vxworks) +/* + * For VxWorks we emulate getXXXbyYYY using the proprietary VxWorks API. + */ +typedef char *__netdb_char_ptr; +typedef __netdb_char_ptr *__netdb_char_ptr_ptr; +# define NEED_STRUCT_xxxENT + +#else +# undef NEED_STRUCT_xxxENT +#endif + +#ifdef NEED_STRUCT_xxxENT +struct hostent { + __netdb_char_ptr h_name; + __netdb_char_ptr_ptr h_aliases; + int h_addrtype; + int h_length; + __netdb_char_ptr_ptr h_addr_list; +}; + struct servent { - char *s_name; /* official service name */ - char **s_aliases; /* alias list */ - int s_port; /* port # */ - char *s_proto; /* protocol to use */ + __netdb_char_ptr s_name; + __netdb_char_ptr_ptr s_aliases; + int s_port; + __netdb_char_ptr s_proto; }; #endif @@ -87,14 +113,18 @@ extern void __gnat_remove_socket_from_set (fd_set *, int); extern void __gnat_reset_socket_set (fd_set *); extern int __gnat_get_h_errno (void); extern int __gnat_socket_ioctl (int, int, int *); + extern char * __gnat_servent_s_name (struct servent *); -extern char ** __gnat_servent_s_aliases (struct servent *); -extern int __gnat_servent_s_port (struct servent *); +extern char * __gnat_servent_s_alias (struct servent *, int index); +extern unsigned short __gnat_servent_s_port (struct servent *); extern char * __gnat_servent_s_proto (struct servent *); -extern void __gnat_servent_set_s_name (struct servent *, char *); -extern void __gnat_servent_set_s_aliases (struct servent *, char **); -extern void __gnat_servent_set_s_port (struct servent *, int); -extern void __gnat_servent_set_s_proto (struct servent *, char *); + +extern char * __gnat_hostent_h_name (struct hostent *); +extern char * __gnat_hostent_h_alias (struct hostent *, int); +extern int __gnat_hostent_h_addrtype (struct hostent *); +extern int __gnat_hostent_h_length (struct hostent *); +extern char * __gnat_hostent_h_addr (struct hostent *, int); + #if defined (__vxworks) || defined (_WIN32) extern int __gnat_inet_pton (int, const char *, void *); #endif @@ -164,76 +194,28 @@ __gnat_close_signalling_fd (int sig) { #endif /* - * GetXXXbyYYY wrappers - * These functions are used by the default implementation of g-socthi, - * and also by the Windows version. + * Handling of gethostbyname, gethostbyaddr, getservbyname and getservbyport + * ========================================================================= + * + * This module exposes __gnat_getXXXbyYYY operations with the same signature + * as the reentrant variant getXXXbyYYY_r. + * + * On platforms where getXXXbyYYY is intrinsically reentrant, the provided user + * buffer argument is ignored. * - * They can be used for any platform that either provides an intrinsically - * task safe implementation of getXXXbyYYY, or a reentrant variant - * getXXXbyYYY_r. Otherwise, a task safe wrapper, including proper mutual - * exclusion if appropriate, must be implemented in the target specific - * version of g-socthi. + * When getXXXbyYYY is not reentrant but getXXXbyYYY_r exists, the latter is + * used, and the provided buffer argument must point to a valid, thread-local + * buffer (usually on the caller's stack). + * + * When getXXXbyYYY is not reentrant and no reentrant getXXXbyYYY_r variant + * is available, the non-reentrant getXXXbyYYY is called, the provided user + * buffer is ignored, and the caller is expected to take care of mutual + * exclusion. */ -#ifdef HAVE_THREAD_SAFE_GETxxxBYyyy -int -__gnat_safe_gethostbyname (const char *name, - struct hostent *ret, char *buf, size_t buflen, - int *h_errnop) -{ - struct hostent *rh; - rh = gethostbyname (name); - if (rh == NULL) { - *h_errnop = h_errno; - return -1; - } - *ret = *rh; - *h_errnop = 0; - return 0; -} - -int -__gnat_safe_gethostbyaddr (const char *addr, int len, int type, - struct hostent *ret, char *buf, size_t buflen, - int *h_errnop) -{ - struct hostent *rh; - rh = gethostbyaddr (addr, len, type); - if (rh == NULL) { - *h_errnop = h_errno; - return -1; - } - *ret = *rh; - *h_errnop = 0; - return 0; -} - -int -__gnat_safe_getservbyname (const char *name, const char *proto, - struct servent *ret, char *buf, size_t buflen) -{ - struct servent *rh; - rh = getservbyname (name, proto); - if (rh == NULL) - return -1; - *ret = *rh; - return 0; -} - +#ifdef HAVE_GETxxxBYyyy_R int -__gnat_safe_getservbyport (int port, const char *proto, - struct servent *ret, char *buf, size_t buflen) -{ - struct servent *rh; - rh = getservbyport (port, proto); - if (rh == NULL) - return -1; - *ret = *rh; - return 0; -} -#elif HAVE_GETxxxBYyyy_R -int -__gnat_safe_gethostbyname (const char *name, +__gnat_gethostbyname (const char *name, struct hostent *ret, char *buf, size_t buflen, int *h_errnop) { @@ -250,7 +232,7 @@ __gnat_safe_gethostbyname (const char *name, } int -__gnat_safe_gethostbyaddr (const char *addr, int len, int type, +__gnat_gethostbyaddr (const char *addr, int len, int type, struct hostent *ret, char *buf, size_t buflen, int *h_errnop) { @@ -267,7 +249,7 @@ __gnat_safe_gethostbyaddr (const char *addr, int len, int type, } int -__gnat_safe_getservbyname (const char *name, const char *proto, +__gnat_getservbyname (const char *name, const char *proto, struct servent *ret, char *buf, size_t buflen) { struct servent *rh; @@ -283,7 +265,7 @@ __gnat_safe_getservbyname (const char *name, const char *proto, } int -__gnat_safe_getservbyport (int port, const char *proto, +__gnat_getservbyport (int port, const char *proto, struct servent *ret, char *buf, size_t buflen) { struct servent *rh; @@ -297,6 +279,130 @@ __gnat_safe_getservbyport (int port, const char *proto, ri = (rh == NULL) ? -1 : 0; return ri; } +#elif defined (__vxworks) +static char vxw_h_name[MAXHOSTNAMELEN + 1]; +static char *vxw_h_aliases[1] = { NULL }; +static int vxw_h_addr; +static char *vxw_h_addr_list[2] = { (char*) &vxw_h_addr, NULL }; + +int +__gnat_gethostbyname (const char *name, + struct hostent *ret, char *buf, size_t buflen, + int *h_errnop) +{ + vxw_h_addr = hostGetByName (name); + if (vxw_h_addr == ERROR) { + *h_errnop = __gnat_get_h_errno (); + return -1; + } + ret->h_name = name; + ret->h_aliases = &vxw_h_aliases; + ret->h_addrtype = AF_INET; + ret->h_length = 4; + ret->h_addr_list = &vxw_h_addr_list; + return 0; +} + +int +__gnat_gethostbyaddr (const char *addr, int len, int type, + struct hostent *ret, char *buf, size_t buflen, + int *h_errnop) +{ + if (type != AF_INET) { + *h_errnop = EAFNOSUPPORT; + return -1; + } + + if (addr == NULL || len != 4) { + *h_errnop = EINVAL; + return -1; + } + + if (hostGetByAddr (*(int*)addr, &vxw_h_name) != OK) { + *h_errnop = __gnat_get_h_errno (); + return -1; + } + + vxw_h_addr = addr; + + ret->h_name = &vxw_h_name; + ret->h_aliases = &vxw_h_aliases; + ret->h_addrtype = AF_INET; + ret->h_length = 4; + ret->h_addr_list = &vxw_h_addr_list; +} + +int +__gnat_getservbyname (const char *name, const char *proto, + struct servent *ret, char *buf, size_t buflen) +{ + /* Not available under VxWorks */ + return -1; +} + +int +__gnat_getservbyport (int port, const char *proto, + struct servent *ret, char *buf, size_t buflen) +{ + /* Not available under VxWorks */ + return -1; +} +#else +int +__gnat_gethostbyname (const char *name, + struct hostent *ret, char *buf, size_t buflen, + int *h_errnop) +{ + struct hostent *rh; + rh = gethostbyname (name); + if (rh == NULL) { + *h_errnop = __gnat_get_h_errno (); + return -1; + } + *ret = *rh; + *h_errnop = 0; + return 0; +} + +int +__gnat_gethostbyaddr (const char *addr, int len, int type, + struct hostent *ret, char *buf, size_t buflen, + int *h_errnop) +{ + struct hostent *rh; + rh = gethostbyaddr (addr, len, type); + if (rh == NULL) { + *h_errnop = __gnat_get_h_errno (); + return -1; + } + *ret = *rh; + *h_errnop = 0; + return 0; +} + +int +__gnat_getservbyname (const char *name, const char *proto, + struct servent *ret, char *buf, size_t buflen) +{ + struct servent *rh; + rh = getservbyname (name, proto); + if (rh == NULL) + return -1; + *ret = *rh; + return 0; +} + +int +__gnat_getservbyport (int port, const char *proto, + struct servent *ret, char *buf, size_t buflen) +{ + struct servent *rh; + rh = getservbyport (port, proto); + if (rh == NULL) + return -1; + *ret = *rh; + return 0; +} #endif /* Find the largest socket in the socket set SET. This is needed for @@ -509,6 +615,30 @@ __gnat_inet_pton (int af, const char *src, void *dst) { } #endif +/* + * Accessor functions for struct hostent. + */ + +char * __gnat_hostent_h_name (struct hostent * h) { + return h->h_name; +} + +char * __gnat_hostent_h_alias (struct hostent * h, int index) { + return h->h_aliases[index]; +} + +int __gnat_hostent_h_addrtype (struct hostent * h) { + return h->h_addrtype; +} + +int __gnat_hostent_h_length (struct hostent * h) { + return h->h_length; +} + +char * __gnat_hostent_h_addr (struct hostent * h, int index) { + return h->h_addr_list[index]; +} + /* * Accessor functions for struct servent. * @@ -539,21 +669,19 @@ __gnat_inet_pton (int af, const char *src, void *dst) { * }; */ -/* Getters */ - char * __gnat_servent_s_name (struct servent * s) { return s->s_name; } -char ** -__gnat_servent_s_aliases (struct servent * s) +char * +__gnat_servent_s_alias (struct servent * s, int index) { - return s->s_aliases; + return s->s_aliases[index]; } -int +unsigned short __gnat_servent_s_port (struct servent * s) { return s->s_port; @@ -565,32 +693,6 @@ __gnat_servent_s_proto (struct servent * s) return s->s_proto; } -/* Setters */ - -void -__gnat_servent_set_s_name (struct servent * s, char * s_name) -{ - s->s_name = s_name; -} - -void -__gnat_servent_set_s_aliases (struct servent * s, char ** s_aliases) -{ - s->s_aliases = s_aliases; -} - -void -__gnat_servent_set_s_port (struct servent * s, int s_port) -{ - s->s_port = s_port; -} - -void -__gnat_servent_set_s_proto (struct servent * s, char * s_proto) -{ - s->s_proto = s_proto; -} - #else # warning Sockets are not supported on this platform #endif /* defined(HAVE_SOCKETS) */ -- 2.30.2