Skip to content

R
riscv-gcc-1
Commit 4a214958 by Arnaud Charlet
Options

[multiple changes] 

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.

From-SVN: r160731
parent 5bca794b
Showing with 579 additions and 1187 deletions
gcc/ada/ChangeLog
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.
......
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 : 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.
Aliases_Count, Addresses_Count : Natural;
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);
Aliases_Count := 0;
while Hostent_H_Alias (E, C.int (Aliases_Count)) /= Null_Ptr loop
Aliases_Count := Aliases_Count + 1;
end loop;
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;
Addresses_Count := 0;
while Hostent_H_Addr (E, C.int (Addresses_Count)) /= Null_Ptr loop
Addresses_Count := Addresses_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;
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;
return Result;
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);
Aliases_Count := 0;
while Servent_S_Alias (E, C.int (Aliases_Count)) /= Null_Ptr loop
Aliases_Count := Aliases_Count + 1;
end loop;
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;
return Result : Service_Entry_Type (Aliases_Length => Aliases_Count) do
Result.Official := To_Name (Value (Servent_S_Name (E)));
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 (C.unsigned_short (Servent_S_Port (E))));
Result.Protocol := To_Name (Protocol);
return Result;
Port_Type (Network_To_Short (Servent_S_Port (E)));
end return;
end To_Service_Entry;
---------------
......
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, 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_Aliases, "__gnat_servent_s_aliases");
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;
gcc/ada/g-sttsne-dummy.ads deleted 100644 → 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;
gcc/ada/g-sttsne-locking.adb deleted 100644 → 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);
<<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;
gcc/ada/g-sttsne-locking.ads deleted 100644 → 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;
gcc/ada/g-sttsne-vxworks.adb deleted 100644 → 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;
gcc/ada/g-sttsne.ads deleted 100644 → 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;
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 \
......
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<g-socket-dummy.adb \
......@@ -388,8 +388,7 @@ DUMMY_SOCKETS_TARGET_PAIRS = \
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.
......@@ -440,8 +439,6 @@ ifeq ($(strip $(filter-out m68k% wrs vx%,$(targ))),)
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
......@@ -485,8 +482,6 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
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)
......@@ -606,9 +601,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(targ))),)
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))),)
......@@ -724,9 +717,7 @@ ifeq ($(strip $(filter-out %86 wrs vxworksae vxworksmils,$(targ))),)
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))),)
......@@ -762,8 +753,6 @@ ifeq ($(strip $(filter-out sparc% wrs vx%,$(targ))),)
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 \
......@@ -803,8 +792,6 @@ ifeq ($(strip $(filter-out %86 wrs vxworks,$(targ))),)
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
......@@ -896,8 +883,6 @@ ifeq ($(strip $(filter-out arm% coff wrs vx%,$(targ))),)
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
......@@ -936,8 +921,6 @@ ifeq ($(strip $(filter-out mips% wrs vx%,$(targ))),)
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
......@@ -1398,8 +1381,6 @@ ifeq ($(strip $(filter-out lynxos,$(osys))),)
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 \
......@@ -1416,8 +1397,6 @@ ifeq ($(strip $(filter-out lynxos,$(osys))),)
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 \
......@@ -1543,8 +1522,6 @@ ifeq ($(strip $(filter-out alpha64 ia64 dec hp vms% openvms% alphavms%,$(targ)))
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 \
......
gcc/ada/gnatcmd.adb
......@@ -232,6 +232,11 @@ procedure GNATCmd is
-- 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.
......@@ -890,6 +895,22 @@ procedure GNATCmd is
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 --
------------------
......@@ -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;
......
gcc/ada/gsocket.h
......@@ -194,34 +194,37 @@
#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__)
......
gcc/ada/s-oscons-tmplt.c
......@@ -1231,26 +1231,13 @@ 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")
/**
......
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));
......@@ -12815,8 +12816,7 @@ package body Sem_Ch3 is
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,7 +12840,8 @@ 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,
and then Type_Conformant
(Subp, Act_Subp,
Skip_Controlling_Formals => True)
and then No (Interface_Alias (Act_Subp));
......
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));
......
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);
......
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
#ifdef HAVE_GETxxxBYyyy_R
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;
}
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
......@@ -510,6 +616,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.
*
* These are needed because servent has different representations on different
......@@ -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) */
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment