+2010-06-14 Ed Schonberg <schonberg@adacore.com>
+
+ * 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 <dewar@adacore.com>
+
+ * 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 <quinot@adacore.com>
+
+ * 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 <celier@adacore.com>
+
+ * gnatcmd.adb (Mapping_File): New function.
+
2010-06-14 Javier Miranda <miranda@adacore.com>
* sem_ch3.adb (Derive_Subprograms): Remove over-restrictive assertion.
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);
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
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
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;
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;
----------------------
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;
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;
-------------------------
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;
---------------------
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 --
--------------------------------
-- 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;
----------------
----------------------
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;
---------------
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;
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 --
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;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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);
-
- <<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. 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);
-
- <<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. 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);
-
- <<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;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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;
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 \
# 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<g-socket-dummy.adb \
g-socthi.adb<g-socthi-dummy.adb \
g-socthi.ads<g-socthi-dummy.ads \
g-sothco.adb<g-sothco-dummy.adb \
- g-sothco.ads<g-sothco-dummy.ads \
- g-sttsne.ads<g-sttsne-dummy.ads
+ g-sothco.ads<g-sothco-dummy.ads
# On platform where atomic increment/decrement operations are supported
# special version of Ada.Strings.Unbounded package can be used.
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
- g-sttsne.adb<g-sttsne-vxworks.adb \
- g-sttsne.ads<g-sttsne-locking.ads \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
system.ads<system-vxworks-m68k.ads
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
- g-sttsne.adb<g-sttsne-vxworks.adb \
- g-sttsne.ads<g-sttsne-locking.ads \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
$(ATOMICS_TARGET_PAIRS)
LIBGNAT_TARGET_PAIRS += \
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
- g-stsifd.adb<g-stsifd-sockets.adb \
- g-sttsne.adb<g-sttsne-vxworks.adb \
- g-sttsne.ads<g-sttsne-locking.ads
+ g-stsifd.adb<g-stsifd-sockets.adb
endif
ifeq ($(strip $(filter-out yes,$(TRACE))),)
LIBGNAT_TARGET_PAIRS += \
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
- g-stsifd.adb<g-stsifd-sockets.adb \
- g-sttsne.adb<g-sttsne-vxworks.adb \
- g-sttsne.ads<g-sttsne-locking.ads
+ g-stsifd.adb<g-stsifd-sockets.adb
endif
ifeq ($(strip $(filter-out yes,$(TRACE))),)
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
- g-sttsne.adb<g-sttsne-vxworks.adb \
- g-sttsne.ads<g-sttsne-locking.ads \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
system.ads<system-vxworks-sparcv9.ads \
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
- g-sttsne.adb<g-sttsne-vxworks.adb \
- g-sttsne.ads<g-sttsne-locking.ads \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
- g-sttsne.adb<g-sttsne-vxworks.adb \
- g-sttsne.ads<g-sttsne-locking.ads \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
system.ads<system-vxworks-arm.ads
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
- g-sttsne.adb<g-sttsne-vxworks.adb \
- g-sttsne.ads<g-sttsne-locking.ads \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
system.ads<system-vxworks-mips.ads
a-numaux.ads<a-numaux-x86.ads \
a-intnam.ads<a-intnam-lynxos.ads \
g-bytswa.adb<g-bytswa-x86.adb \
- g-sttsne.adb<g-sttsne-locking.adb \
- g-sttsne.ads<g-sttsne-locking.ads \
s-inmaop.adb<s-inmaop-posix.adb \
s-intman.adb<s-intman-posix.adb \
s-osinte.adb<s-osinte-lynxos.adb \
else
LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<a-intnam-lynxos.ads \
- g-sttsne.adb<g-sttsne-locking.adb \
- g-sttsne.ads<g-sttsne-locking.ads \
s-inmaop.adb<s-inmaop-posix.adb \
s-intman.adb<s-intman-posix.adb \
s-osinte.adb<s-osinte-lynxos.adb \
g-socthi.ads<g-socthi-vms.ads \
g-socthi.adb<g-socthi-vms.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
- g-sttsne.adb<g-sttsne-locking.adb \
- g-sttsne.ads<g-sttsne-locking.ads \
i-c.ads<i-c-vms_64.ads \
i-cstrin.ads<i-cstrin-vms_64.ads \
i-cstrin.adb<i-cstrin-vms_64.adb \
-- STUB), gnatpp (GNAT PRETTY), gnatelim (GNAT ELIM), and gnatmetric (GNAT
-- METRIC).
+ function Mapping_File return Path_Name_Type;
+ -- Create and return the path name of a mapping file. Used for gnatstub
+ -- (GNAT STUB), gnatpp (GNAT PRETTY), gnatelim (GNAT ELIM), and gnatmetric
+ -- (GNAT METRIC).
+
procedure Delete_Temp_Config_Files;
-- Delete all temporary config files. The caller is responsible for
-- ensuring that Keep_Temporary_Files is False.
end Index;
------------------
+ -- Mapping_File --
+ ------------------
+
+ function Mapping_File return Path_Name_Type is
+ Result : Path_Name_Type;
+
+ begin
+ Prj.Env.Create_Mapping_File
+ (Project => Project,
+ Language => Name_Ada,
+ In_Tree => Project_Tree,
+ Name => Result);
+ return Result;
+ end Mapping_File;
+
+ ------------------
-- Process_Link --
------------------
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
(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;
#include <netdb.h>
#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__)
#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
*/
*/
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")
/**
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
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));
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;
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);
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,
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
end if;
Set_Has_Discriminants (Priv, Has_Discriminants (Full));
+
if Has_Discriminants (Full) then
Set_Discriminant_Constraint (Priv,
Discriminant_Constraint (Full));
------------------
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.
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);
/* 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
# 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
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
#endif
\f
/*
- * 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)
{
}
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)
{
}
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;
}
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;
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
\f
/* Find the largest socket in the socket set SET. This is needed for
#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.
*
* These are needed because servent has different representations on different
* };
*/
-/* 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;
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) */
OSDN Git Service
