OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

g-soccon.ads: New file.

Browse Source 
2008-08-08  Thomas Quinot  <quinot@adacore.com>

	* g-soccon.ads: New file.

	* g-stheme.adb, g-socthi-vms.adb, g-socthi-vxworks.adb,
	g-socthi-mingw.adb, g-sttsne-vxworks.adb, g-socthi.adb,
	g-stsifd-sockets.adb, g-socket.adb, g-socket.ads,
	g-sothco.adb, g-sothco.ads: Add back GNAT.Sockets.Constants as a child
	unit, to allow building software that depends on this internal unit
	with both older and newer compilers.

From-SVN: r138877
This commit is contained in:
Thomas Quinot 2008-08-08 14:59:28 +02:00 committed by Arnaud Charlet
parent d65251b83d
commit 62b7afe926
12 changed files with 188 additions and 147 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
gcc/ada/g-soccon.ads Normal file
View File

@ -0,0 +1,42 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- G N A T . S O C K E T S . C O N S T A N T S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2008, Free Software Foundation, Inc. --
-- --
-- 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 provides a temporary compatibility renaming for deprecated
-- internal package GNAT.Sockets.Constants.
-- This package should not be directly used by an applications program.
-- It is a compatibility artefact to help building legacy code with newer
-- compilers, and will be removed at some point in the future.
with System.OS_Constants;
package GNAT.Sockets.Constants renames System.OS_Constants;

94
gcc/ada/g-socket.adb
View File

@ -58,7 +58,7 @@ package body GNAT.Sockets is
ENOERROR : constant := 0;
Netdb_Buffer_Size : constant := Constants.Need_Netdb_Buffer * 1024;
Netdb_Buffer_Size : constant := SOSC.Need_Netdb_Buffer * 1024;
-- 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
@ -67,49 +67,49 @@ package body GNAT.Sockets is
-- Correspondence tables
Levels : constant array (Level_Type) of C.int :=
(Socket_Level => Constants.SOL_SOCKET,
IP_Protocol_For_IP_Level => Constants.IPPROTO_IP,
IP_Protocol_For_UDP_Level => Constants.IPPROTO_UDP,
IP_Protocol_For_TCP_Level => Constants.IPPROTO_TCP);
(Socket_Level => SOSC.SOL_SOCKET,
IP_Protocol_For_IP_Level => SOSC.IPPROTO_IP,
IP_Protocol_For_UDP_Level => SOSC.IPPROTO_UDP,
IP_Protocol_For_TCP_Level => SOSC.IPPROTO_TCP);
Modes : constant array (Mode_Type) of C.int :=
(Socket_Stream => Constants.SOCK_STREAM,
Socket_Datagram => Constants.SOCK_DGRAM);
(Socket_Stream => SOSC.SOCK_STREAM,
Socket_Datagram => SOSC.SOCK_DGRAM);
Shutmodes : constant array (Shutmode_Type) of C.int :=
(Shut_Read => Constants.SHUT_RD,
Shut_Write => Constants.SHUT_WR,
Shut_Read_Write => Constants.SHUT_RDWR);
(Shut_Read => SOSC.SHUT_RD,
Shut_Write => SOSC.SHUT_WR,
Shut_Read_Write => SOSC.SHUT_RDWR);
Requests : constant array (Request_Name) of C.int :=
(Non_Blocking_IO => Constants.FIONBIO,
N_Bytes_To_Read => Constants.FIONREAD);
(Non_Blocking_IO => SOSC.FIONBIO,
N_Bytes_To_Read => SOSC.FIONREAD);
Options : constant array (Option_Name) of C.int :=
(Keep_Alive => Constants.SO_KEEPALIVE,
Reuse_Address => Constants.SO_REUSEADDR,
Broadcast => Constants.SO_BROADCAST,
Send_Buffer => Constants.SO_SNDBUF,
Receive_Buffer => Constants.SO_RCVBUF,
Linger => Constants.SO_LINGER,
Error => Constants.SO_ERROR,
No_Delay => Constants.TCP_NODELAY,
Add_Membership => Constants.IP_ADD_MEMBERSHIP,
Drop_Membership => Constants.IP_DROP_MEMBERSHIP,
Multicast_If => Constants.IP_MULTICAST_IF,
Multicast_TTL => Constants.IP_MULTICAST_TTL,
Multicast_Loop => Constants.IP_MULTICAST_LOOP,
Receive_Packet_Info => Constants.IP_PKTINFO,
Send_Timeout => Constants.SO_SNDTIMEO,
Receive_Timeout => Constants.SO_RCVTIMEO);
(Keep_Alive => SOSC.SO_KEEPALIVE,
Reuse_Address => SOSC.SO_REUSEADDR,
Broadcast => SOSC.SO_BROADCAST,
Send_Buffer => SOSC.SO_SNDBUF,
Receive_Buffer => SOSC.SO_RCVBUF,
Linger => SOSC.SO_LINGER,
Error => SOSC.SO_ERROR,
No_Delay => SOSC.TCP_NODELAY,
Add_Membership => SOSC.IP_ADD_MEMBERSHIP,
Drop_Membership => SOSC.IP_DROP_MEMBERSHIP,
Multicast_If => SOSC.IP_MULTICAST_IF,
Multicast_TTL => SOSC.IP_MULTICAST_TTL,
Multicast_Loop => SOSC.IP_MULTICAST_LOOP,
Receive_Packet_Info => SOSC.IP_PKTINFO,
Send_Timeout => SOSC.SO_SNDTIMEO,
Receive_Timeout => SOSC.SO_RCVTIMEO);
-- ??? Note: for OpenSolaris, Receive_Packet_Info should be IP_RECVPKTINFO,
-- but for Linux compatibility this constant is the same as IP_PKTINFO.
Flags : constant array (0 .. 3) of C.int :=
(0 => Constants.MSG_OOB, -- Process_Out_Of_Band_Data
1 => Constants.MSG_PEEK, -- Peek_At_Incoming_Data
2 => Constants.MSG_WAITALL, -- Wait_For_A_Full_Reception
3 => Constants.MSG_EOR); -- Send_End_Of_Record
(0 => SOSC.MSG_OOB, -- Process_Out_Of_Band_Data
1 => SOSC.MSG_PEEK, -- Peek_At_Incoming_Data
2 => SOSC.MSG_WAITALL, -- Wait_For_A_Full_Reception
3 => SOSC.MSG_EOR); -- Send_End_Of_Record
Socket_Error_Id : constant Exception_Id := Socket_Error'Identity;
Host_Error_Id : constant Exception_Id := Host_Error'Identity;
@ -138,7 +138,7 @@ package body GNAT.Sockets is
-- Return the int value corresponding to the specified flags combination
function Set_Forced_Flags (F : C.int) return C.int;
-- Return F with the bits from Constants.MSG_Forced_Flags forced set
-- Return F with the bits from SOSC.MSG_Forced_Flags forced set
function Short_To_Network
(S : C.unsigned_short) return C.unsigned_short;
@ -882,7 +882,7 @@ package body GNAT.Sockets is
Err : aliased C.int;
begin
if Safe_Gethostbyaddr (HA'Address, HA'Size / 8, Constants.AF_INET,
if Safe_Gethostbyaddr (HA'Address, HA'Size / 8, SOSC.AF_INET,
Res'Access, Buf'Address, Buflen, Err'Access) /= 0
then
Raise_Host_Error (Integer (Err));
@ -1260,7 +1260,7 @@ package body GNAT.Sockets is
-- calling Inet_Addr("") will not return an error.
elsif Image = "" then
Raise_Socket_Error (Constants.EINVAL);
Raise_Socket_Error (SOSC.EINVAL);
end if;
Img := New_String (Image);
@ -1268,7 +1268,7 @@ package body GNAT.Sockets is
Free (Img);
if Res = Failure then
Raise_Socket_Error (Constants.EINVAL);
Raise_Socket_Error (SOSC.EINVAL);
end if;
To_Inet_Addr (To_In_Addr (Res), Result);
@ -1280,7 +1280,7 @@ package body GNAT.Sockets is
----------------
procedure Initialize (Process_Blocking_IO : Boolean) is
Expected : constant Boolean := not Constants.Thread_Blocking_IO;
Expected : constant Boolean := not SOSC.Thread_Blocking_IO;
begin
if Process_Blocking_IO /= Expected then
raise Socket_Error with
@ -1613,16 +1613,16 @@ package body GNAT.Sockets is
(Error_Value : Integer;
From_Errno : Boolean := True) return Error_Type
is
use GNAT.Sockets.Constants;
use GNAT.Sockets.SOSC;
begin
if not From_Errno then
case Error_Value is
when Constants.HOST_NOT_FOUND => return Unknown_Host;
when Constants.TRY_AGAIN => return Host_Name_Lookup_Failure;
when Constants.NO_RECOVERY => return Non_Recoverable_Error;
when Constants.NO_DATA => return Unknown_Server_Error;
when others => return Cannot_Resolve_Error;
when SOSC.HOST_NOT_FOUND => return Unknown_Host;
when SOSC.TRY_AGAIN => return Host_Name_Lookup_Failure;
when SOSC.NO_RECOVERY => return Non_Recoverable_Error;
when SOSC.NO_DATA => return Unknown_Server_Error;
when others => return Cannot_Resolve_Error;
end case;
end if;
@ -1828,8 +1828,8 @@ package body GNAT.Sockets is
pragma Warnings (Off);
-- Following test may be compile time known on some targets
if Vector'Length - Iov_Count > Constants.IOV_MAX then
This_Iov_Count := Constants.IOV_MAX;
if Vector'Length - Iov_Count > SOSC.IOV_MAX then
This_Iov_Count := SOSC.IOV_MAX;
else
This_Iov_Count := Vector'Length - Iov_Count;
end if;
@ -1879,7 +1879,7 @@ package body GNAT.Sockets is
function To_int is
new Ada.Unchecked_Conversion (C.unsigned, C.int);
begin
return To_int (To_unsigned (F) or Constants.MSG_Forced_Flags);
return To_int (To_unsigned (F) or SOSC.MSG_Forced_Flags);
end Set_Forced_Flags;
-----------------------
@ -2160,7 +2160,7 @@ package body GNAT.Sockets is
if Current mod 2 /= 0 then
if Flags (J) = -1 then
Raise_Socket_Error (Constants.EOPNOTSUPP);
Raise_Socket_Error (SOSC.EOPNOTSUPP);
end if;
Result := Result + Flags (J);

9
gcc/ada/g-socket.ads
View File

@ -369,7 +369,7 @@ package GNAT.Sockets is
-- Finalize;
-- end PingPong;
package Constants renames System.OS_Constants;
package SOSC renames System.OS_Constants;
-- Renaming used to provide short-hand notations thoughout the sockets
-- binding. Note that System.OS_Constants is an internal unit, and the
-- entities declared therein are not meant for direct access by users,
@ -414,10 +414,9 @@ package GNAT.Sockets is
Immediate : constant Duration := 0.0;
Timeval_Forever : constant :=
2.0 ** (Constants.SIZEOF_tv_sec * 8 - 1) - 1.0;
Forever : constant Duration :=
Duration'Min (Duration'Last, Timeval_Forever);
Timeval_Forever : constant := 2.0 ** (SOSC.SIZEOF_tv_sec * 8 - 1) - 1.0;
Forever : constant Duration :=
Duration'Min (Duration'Last, Timeval_Forever);
subtype Timeval_Duration is Duration range Immediate .. Forever;

8
gcc/ada/g-socthi-mingw.adb
View File

@ -239,8 +239,8 @@ package body GNAT.Sockets.Thin is
Res := Standard_Connect (S, Name, Namelen);
if Res = -1 then
if Socket_Errno = Constants.EWOULDBLOCK then
Set_Socket_Errno (Constants.EINPROGRESS);
if Socket_Errno = SOSC.EWOULDBLOCK then
Set_Socket_Errno (SOSC.EINPROGRESS);
end if;
end if;
@ -341,7 +341,7 @@ package body GNAT.Sockets.Thin is
if EFS /= No_Fd_Set_Access then
declare
EFSC : constant Fd_Set_Access := New_Socket_Set (EFS);
Flag : constant C.int := Constants.MSG_PEEK + Constants.MSG_OOB;
Flag : constant C.int := SOSC.MSG_PEEK + Constants.MSG_OOB;
Buffer : Character;
Length : C.int;
Fromlen : aliased C.int;
@ -487,7 +487,7 @@ package body GNAT.Sockets.Thin is
function Socket_Error_Message
(Errno : Integer) return C.Strings.chars_ptr
is
use GNAT.Sockets.Constants;
use GNAT.Sockets.SOSC;
begin
case Errno is
when EINTR => return Error_Messages (N_EINTR);

42
gcc/ada/g-socthi-vms.adb
View File

@ -52,7 +52,7 @@ package body GNAT.Sockets.Thin is
-- been set in non-blocking mode by the user.
Quantum : constant Duration := 0.2;
-- When Constants.Thread_Blocking_IO is False, we set sockets in
-- When SOSC.Thread_Blocking_IO is False, we set sockets in
-- non-blocking mode and we spend a period of time Quantum between
-- two attempts on a blocking operation.
@ -134,14 +134,14 @@ package body GNAT.Sockets.Thin is
begin
loop
R := Syscall_Accept (S, Addr, Addrlen);
exit when Constants.Thread_Blocking_IO
exit when SOSC.Thread_Blocking_IO
or else R /= Failure
or else Non_Blocking_Socket (S)
or else Errno /= Constants.EWOULDBLOCK;
or else Errno /= SOSC.EWOULDBLOCK;
delay Quantum;
end loop;
if not Constants.Thread_Blocking_IO
if not SOSC.Thread_Blocking_IO
and then R /= Failure
then
-- A socket inherits the properties of its server, especially
@ -149,7 +149,7 @@ package body GNAT.Sockets.Thin is
-- tracks sockets set in non-blocking mode by user.
Set_Non_Blocking_Socket (R, Non_Blocking_Socket (S));
Discard := Syscall_Ioctl (R, Constants.FIONBIO, Val'Unchecked_Access);
Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Unchecked_Access);
end if;
return R;
@ -169,10 +169,10 @@ package body GNAT.Sockets.Thin is
begin
Res := Syscall_Connect (S, Name, Namelen);
if Constants.Thread_Blocking_IO
if SOSC.Thread_Blocking_IO
or else Res /= Failure
or else Non_Blocking_Socket (S)
or else Errno /= Constants.EINPROGRESS
or else Errno /= SOSC.EINPROGRESS
then
return Res;
end if;
@ -208,7 +208,7 @@ package body GNAT.Sockets.Thin is
Res := Syscall_Connect (S, Name, Namelen);
if Res = Failure and then Errno = Constants.EISCONN then
if Res = Failure and then Errno = SOSC.EISCONN then
return Thin_Common.Success;
else
@ -226,8 +226,8 @@ package body GNAT.Sockets.Thin is
Arg : Int_Access) return C.int
is
begin
if not Constants.Thread_Blocking_IO
and then Req = Constants.FIONBIO
if not SOSC.Thread_Blocking_IO
and then Req = SOSC.FIONBIO
then
if Arg.all /= 0 then
Set_Non_Blocking_Socket (S, True);
@ -252,10 +252,10 @@ package body GNAT.Sockets.Thin is
begin
loop
Res := Syscall_Recv (S, Msg, Len, Flags);
exit when Constants.Thread_Blocking_IO
exit when SOSC.Thread_Blocking_IO
or else Res /= Failure
or else Non_Blocking_Socket (S)
or else Errno /= Constants.EWOULDBLOCK;
or else Errno /= SOSC.EWOULDBLOCK;
delay Quantum;
end loop;
@ -279,10 +279,10 @@ package body GNAT.Sockets.Thin is
begin
loop
Res := Syscall_Recvfrom (S, Msg, Len, Flags, From, Fromlen);
exit when Constants.Thread_Blocking_IO
exit when SOSC.Thread_Blocking_IO
or else Res /= Failure
or else Non_Blocking_Socket (S)
or else Errno /= Constants.EWOULDBLOCK;
or else Errno /= SOSC.EWOULDBLOCK;
delay Quantum;
end loop;
@ -304,10 +304,10 @@ package body GNAT.Sockets.Thin is
begin
loop
Res := Syscall_Send (S, Msg, Len, Flags);
exit when Constants.Thread_Blocking_IO
exit when SOSC.Thread_Blocking_IO
or else Res /= Failure
or else Non_Blocking_Socket (S)
or else Errno /= Constants.EWOULDBLOCK;
or else Errno /= SOSC.EWOULDBLOCK;
delay Quantum;
end loop;
@ -331,10 +331,10 @@ package body GNAT.Sockets.Thin is
begin
loop
Res := Syscall_Sendto (S, Msg, Len, Flags, To, Tolen);
exit when Constants.Thread_Blocking_IO
exit when SOSC.Thread_Blocking_IO
or else Res /= Failure
or else Non_Blocking_Socket (S)
or else Errno /= Constants.EWOULDBLOCK;
or else Errno /= SOSC.EWOULDBLOCK;
delay Quantum;
end loop;
@ -359,13 +359,13 @@ package body GNAT.Sockets.Thin is
begin
R := Syscall_Socket (Domain, Typ, Protocol);
if not Constants.Thread_Blocking_IO
if not SOSC.Thread_Blocking_IO
and then R /= Failure
then
-- Do not use C_Ioctl as this subprogram tracks sockets set
-- in non-blocking mode by user.
Discard := Syscall_Ioctl (R, Constants.FIONBIO, Val'Unchecked_Access);
Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Unchecked_Access);
Set_Non_Blocking_Socket (R, False);
end if;
@ -508,7 +508,7 @@ package body GNAT.Sockets.Thin is
(Fd,
Iovec (J).Base.all'Address,
Interfaces.C.int (Iovec (J).Length),
Constants.MSG_Forced_Flags);
SOSC.MSG_Forced_Flags);
if Res < 0 then
return Res;

40
gcc/ada/g-socthi-vxworks.adb
View File

@ -56,7 +56,7 @@ package body GNAT.Sockets.Thin is
-- been set in non-blocking mode by the user.
Quantum : constant Duration := 0.2;
-- When Constants.Thread_Blocking_IO is False, we set sockets in
-- When SOSC.Thread_Blocking_IO is False, we set sockets in
-- non-blocking mode and we spend a period of time Quantum between
-- two attempts on a blocking operation.
@ -146,14 +146,14 @@ package body GNAT.Sockets.Thin is
begin
loop
R := Syscall_Accept (S, Addr, Addrlen);
exit when Constants.Thread_Blocking_IO
exit when SOSC.Thread_Blocking_IO
or else R /= Failure
or else Non_Blocking_Socket (S)
or else Errno /= Constants.EWOULDBLOCK;
or else Errno /= SOSC.EWOULDBLOCK;
delay Quantum;
end loop;
if not Constants.Thread_Blocking_IO
if not SOSC.Thread_Blocking_IO
and then R /= Failure
then
-- A socket inherits the properties of its server especially
@ -161,7 +161,7 @@ package body GNAT.Sockets.Thin is
-- tracks sockets set in non-blocking mode by user.
Set_Non_Blocking_Socket (R, Non_Blocking_Socket (S));
Res := Syscall_Ioctl (R, Constants.FIONBIO, Val'Unchecked_Access);
Res := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Unchecked_Access);
-- Is it OK to ignore result ???
end if;
@ -182,10 +182,10 @@ package body GNAT.Sockets.Thin is
begin
Res := Syscall_Connect (S, Name, Namelen);
if Constants.Thread_Blocking_IO
if SOSC.Thread_Blocking_IO
or else Res /= Failure
or else Non_Blocking_Socket (S)
or else Errno /= Constants.EINPROGRESS
or else Errno /= SOSC.EINPROGRESS
then
return Res;
end if;
@ -223,7 +223,7 @@ package body GNAT.Sockets.Thin is
Res := Syscall_Connect (S, Name, Namelen);
if Res = Failure
and then Errno = Constants.EISCONN
and then Errno = SOSC.EISCONN
then
return Thin_Common.Success;
else
@ -241,8 +241,8 @@ package body GNAT.Sockets.Thin is
Arg : Int_Access) return C.int
is
begin
if not Constants.Thread_Blocking_IO
and then Req = Constants.FIONBIO
if not SOSC.Thread_Blocking_IO
and then Req = SOSC.FIONBIO
then
if Arg.all /= 0 then
Set_Non_Blocking_Socket (S, True);
@ -267,10 +267,10 @@ package body GNAT.Sockets.Thin is
begin
loop
Res := Syscall_Recv (S, Msg, Len, Flags);
exit when Constants.Thread_Blocking_IO
exit when SOSC.Thread_Blocking_IO
or else Res /= Failure
or else Non_Blocking_Socket (S)
or else Errno /= Constants.EWOULDBLOCK;
or else Errno /= SOSC.EWOULDBLOCK;
delay Quantum;
end loop;
@ -294,10 +294,10 @@ package body GNAT.Sockets.Thin is
begin
loop
Res := Syscall_Recvfrom (S, Msg, Len, Flags, From, Fromlen);
exit when Constants.Thread_Blocking_IO
exit when SOSC.Thread_Blocking_IO
or else Res /= Failure
or else Non_Blocking_Socket (S)
or else Errno /= Constants.EWOULDBLOCK;
or else Errno /= SOSC.EWOULDBLOCK;
delay Quantum;
end loop;
@ -319,10 +319,10 @@ package body GNAT.Sockets.Thin is
begin
loop
Res := Syscall_Send (S, Msg, Len, Flags);
exit when Constants.Thread_Blocking_IO
exit when SOSC.Thread_Blocking_IO
or else Res /= Failure
or else Non_Blocking_Socket (S)
or else Errno /= Constants.EWOULDBLOCK;
or else Errno /= SOSC.EWOULDBLOCK;
delay Quantum;
end loop;
@ -346,10 +346,10 @@ package body GNAT.Sockets.Thin is
begin
loop
Res := Syscall_Sendto (S, Msg, Len, Flags, To, Tolen);
exit when Constants.Thread_Blocking_IO
exit when SOSC.Thread_Blocking_IO
or else Res /= Failure
or else Non_Blocking_Socket (S)
or else Errno /= Constants.EWOULDBLOCK;
or else Errno /= SOSC.EWOULDBLOCK;
delay Quantum;
end loop;
@ -374,13 +374,13 @@ package body GNAT.Sockets.Thin is
begin
R := Syscall_Socket (Domain, Typ, Protocol);
if not Constants.Thread_Blocking_IO
if not SOSC.Thread_Blocking_IO
and then R /= Failure
then
-- Do not use C_Ioctl as this subprogram tracks sockets set
-- in non-blocking mode by user.
Res := Syscall_Ioctl (R, Constants.FIONBIO, Val'Unchecked_Access);
Res := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Unchecked_Access);
-- Is it OK to ignore result ???
Set_Non_Blocking_Socket (R, False);
end if;

40
gcc/ada/g-socthi.adb
View File

@ -56,7 +56,7 @@ package body GNAT.Sockets.Thin is
-- been set in non-blocking mode by the user.
Quantum : constant Duration := 0.2;
-- When Constants.Thread_Blocking_IO is False, we set sockets in
-- When SOSC.Thread_Blocking_IO is False, we set sockets in
-- non-blocking mode and we spend a period of time Quantum between
-- two attempts on a blocking operation.
@ -150,14 +150,14 @@ package body GNAT.Sockets.Thin is
begin
loop
R := Syscall_Accept (S, Addr, Addrlen);
exit when Constants.Thread_Blocking_IO
exit when SOSC.Thread_Blocking_IO
or else R /= Failure
or else Non_Blocking_Socket (S)
or else Errno /= Constants.EWOULDBLOCK;
or else Errno /= SOSC.EWOULDBLOCK;
delay Quantum;
end loop;
if not Constants.Thread_Blocking_IO
if not SOSC.Thread_Blocking_IO
and then R /= Failure
then
-- A socket inherits the properties ot its server especially
@ -165,7 +165,7 @@ package body GNAT.Sockets.Thin is
-- tracks sockets set in non-blocking mode by user.
Set_Non_Blocking_Socket (R, Non_Blocking_Socket (S));
Discard := Syscall_Ioctl (R, Constants.FIONBIO, Val'Unchecked_Access);
Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Unchecked_Access);
end if;
Disable_SIGPIPE (R);
@ -186,10 +186,10 @@ package body GNAT.Sockets.Thin is
begin
Res := Syscall_Connect (S, Name, Namelen);
if Constants.Thread_Blocking_IO
if SOSC.Thread_Blocking_IO
or else Res /= Failure
or else Non_Blocking_Socket (S)
or else Errno /= Constants.EINPROGRESS
or else Errno /= SOSC.EINPROGRESS
then
return Res;
end if;
@ -226,7 +226,7 @@ package body GNAT.Sockets.Thin is
Res := Syscall_Connect (S, Name, Namelen);
if Res = Failure
and then Errno = Constants.EISCONN
and then Errno = SOSC.EISCONN
then
return Thin_Common.Success;
else
@ -244,8 +244,8 @@ package body GNAT.Sockets.Thin is
Arg : Int_Access) return C.int
is
begin
if not Constants.Thread_Blocking_IO
and then Req = Constants.FIONBIO
if not SOSC.Thread_Blocking_IO
and then Req = SOSC.FIONBIO
then
if Arg.all /= 0 then
Set_Non_Blocking_Socket (S, True);
@ -270,10 +270,10 @@ package body GNAT.Sockets.Thin is
begin
loop
Res := Syscall_Recv (S, Msg, Len, Flags);
exit when Constants.Thread_Blocking_IO
exit when SOSC.Thread_Blocking_IO
or else Res /= Failure
or else Non_Blocking_Socket (S)
or else Errno /= Constants.EWOULDBLOCK;
or else Errno /= SOSC.EWOULDBLOCK;
delay Quantum;
end loop;
@ -297,10 +297,10 @@ package body GNAT.Sockets.Thin is
begin
loop
Res := Syscall_Recvfrom (S, Msg, Len, Flags, From, Fromlen);
exit when Constants.Thread_Blocking_IO
exit when SOSC.Thread_Blocking_IO
or else Res /= Failure
or else Non_Blocking_Socket (S)
or else Errno /= Constants.EWOULDBLOCK;
or else Errno /= SOSC.EWOULDBLOCK;
delay Quantum;
end loop;
@ -322,10 +322,10 @@ package body GNAT.Sockets.Thin is
begin
loop
Res := Syscall_Send (S, Msg, Len, Flags);
exit when Constants.Thread_Blocking_IO
exit when SOSC.Thread_Blocking_IO
or else Res /= Failure
or else Non_Blocking_Socket (S)
or else Errno /= Constants.EWOULDBLOCK;
or else Errno /= SOSC.EWOULDBLOCK;
delay Quantum;
end loop;
@ -349,10 +349,10 @@ package body GNAT.Sockets.Thin is
begin
loop
Res := Syscall_Sendto (S, Msg, Len, Flags, To, Tolen);
exit when Constants.Thread_Blocking_IO
exit when SOSC.Thread_Blocking_IO
or else Res /= Failure
or else Non_Blocking_Socket (S)
or else Errno /= Constants.EWOULDBLOCK;
or else Errno /= SOSC.EWOULDBLOCK;
delay Quantum;
end loop;
@ -377,13 +377,13 @@ package body GNAT.Sockets.Thin is
begin
R := Syscall_Socket (Domain, Typ, Protocol);
if not Constants.Thread_Blocking_IO
if not SOSC.Thread_Blocking_IO
and then R /= Failure
then
-- Do not use C_Ioctl as this subprogram tracks sockets set
-- in non-blocking mode by user.
Discard := Syscall_Ioctl (R, Constants.FIONBIO, Val'Unchecked_Access);
Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Unchecked_Access);
Set_Non_Blocking_Socket (R, False);
end if;
Disable_SIGPIPE (R);

2
gcc/ada/g-sothco.adb
View File

@ -54,7 +54,7 @@ package body GNAT.Sockets.Thin_Common is
Family : Family_Type)
is
C_Family : C.int renames Families (Family);
Has_Sockaddr_Len : constant Boolean := Constants.Has_Sockaddr_Len /= 0;
Has_Sockaddr_Len : constant Boolean := SOSC.Has_Sockaddr_Len /= 0;
begin
if Has_Sockaddr_Len then
Length_And_Family.Length := Lengths (Family);

26
gcc/ada/g-sothco.ads
View File

@ -51,15 +51,15 @@ package GNAT.Sockets.Thin_Common is
Failure : constant C.int := -1;
type time_t is
range -2 ** (8 * Constants.SIZEOF_tv_sec - 1)
.. 2 ** (8 * Constants.SIZEOF_tv_sec - 1) - 1;
for time_t'Size use 8 * Constants.SIZEOF_tv_sec;
range -2 ** (8 * SOSC.SIZEOF_tv_sec - 1)
.. 2 ** (8 * SOSC.SIZEOF_tv_sec - 1) - 1;
for time_t'Size use 8 * SOSC.SIZEOF_tv_sec;
pragma Convention (C, time_t);
type suseconds_t is
range -2 ** (8 * Constants.SIZEOF_tv_usec - 1)
.. 2 ** (8 * Constants.SIZEOF_tv_usec - 1) - 1;
for suseconds_t'Size use 8 * Constants.SIZEOF_tv_usec;
range -2 ** (8 * SOSC.SIZEOF_tv_usec - 1)
.. 2 ** (8 * SOSC.SIZEOF_tv_usec - 1) - 1;
for suseconds_t'Size use 8 * SOSC.SIZEOF_tv_usec;
pragma Convention (C, suseconds_t);
type Timeval is record
@ -78,12 +78,12 @@ package GNAT.Sockets.Thin_Common is
-------------------------------------------
Families : constant array (Family_Type) of C.int :=
(Family_Inet => Constants.AF_INET,
Family_Inet6 => Constants.AF_INET6);
(Family_Inet => SOSC.AF_INET,
Family_Inet6 => SOSC.AF_INET6);
Lengths : constant array (Family_Type) of C.unsigned_char :=
(Family_Inet => Constants.SIZEOF_sockaddr_in,
Family_Inet6 => Constants.SIZEOF_sockaddr_in6);
(Family_Inet => SOSC.SIZEOF_sockaddr_in,
Family_Inet6 => SOSC.SIZEOF_sockaddr_in6);
----------------------------
-- Generic socket address --
@ -95,7 +95,7 @@ package GNAT.Sockets.Thin_Common is
-- and protocol specific address types) start with the same 2-byte header,
-- which is either a length and a family (one byte each) or just a two-byte
-- family. The following unchecked union describes the two possible layouts
-- and is meant to be constrained with Constants.Have_Sockaddr_Len.
-- and is meant to be constrained with SOSC.Have_Sockaddr_Len.
type Sockaddr_Length_And_Family
(Has_Sockaddr_Len : Boolean := False)
@ -231,8 +231,8 @@ package GNAT.Sockets.Thin_Common is
type Hostent is record
H_Name : C.Strings.chars_ptr;
H_Aliases : Chars_Ptr_Pointers.Pointer;
H_Addrtype : Constants.H_Addrtype_T;
H_Length : Constants.H_Length_T;
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);

10
gcc/ada/g-stheme.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2007, AdaCore --
-- 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- --
@ -54,16 +54,16 @@ package body Host_Error_Messages is
renames To_Chars_Ptr;
begin
case H_Errno is
when Constants.HOST_NOT_FOUND =>
when SOSC.HOST_NOT_FOUND =>
return TCP (Messages.HOST_NOT_FOUND'Access);
when Constants.TRY_AGAIN =>
when SOSC.TRY_AGAIN =>
return TCP (Messages.TRY_AGAIN'Access);
when Constants.NO_RECOVERY =>
when SOSC.NO_RECOVERY =>
return TCP (Messages.NO_RECOVERY'Access);
when Constants.NO_DATA =>
when SOSC.NO_DATA =>
return TCP (Messages.NO_DATA'Access);
when others =>

12
gcc/ada/g-stsifd-sockets.adb
View File

@ -82,7 +82,7 @@ package body Signalling_Fds is
-- Create a listening socket
L_Sock := C_Socket (Constants.AF_INET, Constants.SOCK_STREAM, 0);
L_Sock := C_Socket (SOSC.AF_INET, Constants.SOCK_STREAM, 0);
if L_Sock = Failure then
goto Fail;
@ -122,7 +122,7 @@ package body Signalling_Fds is
-- Create read end (client) socket
R_Sock := C_Socket (Constants.AF_INET, Constants.SOCK_STREAM, 0);
R_Sock := C_Socket (SOSC.AF_INET, Constants.SOCK_STREAM, 0);
if R_Sock = Failure then
goto Fail;
@ -134,7 +134,7 @@ package body Signalling_Fds is
exit when Res /= Failure;
if Socket_Errno /= Constants.EADDRINUSE then
if Socket_Errno /= SOSC.EADDRINUSE then
goto Fail;
end if;
@ -152,7 +152,7 @@ package body Signalling_Fds is
pragma Assert (Res = Failure
and then
Socket_Errno = Constants.EADDRINUSE);
Socket_Errno = SOSC.EADDRINUSE);
pragma Warnings (Off); -- useless assignment to "Res"
Res := C_Close (W_Sock);
pragma Warnings (On);
@ -217,7 +217,7 @@ package body Signalling_Fds is
function Read (Rsig : C.int) return C.int is
Buf : aliased Character;
begin
return C_Recv (Rsig, Buf'Address, 1, Constants.MSG_Forced_Flags);
return C_Recv (Rsig, Buf'Address, 1, SOSC.MSG_Forced_Flags);
end Read;
-----------
@ -227,7 +227,7 @@ package body Signalling_Fds is
function Write (Wsig : C.int) return C.int is
Buf : aliased Character := ASCII.NUL;
begin
return C_Send (Wsig, Buf'Address, 1, Constants.MSG_Forced_Flags);
return C_Send (Wsig, Buf'Address, 1, SOSC.MSG_Forced_Flags);
end Write;
end Signalling_Fds;

10
gcc/ada/g-sttsne-vxworks.adb
View File

@ -81,7 +81,7 @@ package body GNAT.Sockets.Thin.Task_Safe_NetDB is
-- VxWorks does not provide h_errno
begin
pragma Assert (Addr_Type = Constants.AF_INET);
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
@ -93,7 +93,7 @@ package body GNAT.Sockets.Thin.Task_Safe_NetDB is
if VxWorks_hostGetByAddr (To_Pointer (Addr).all,
Netdb_Data.Name'Address)
/= Constants.OK
/= SOSC.OK
then
return -1;
end if;
@ -106,7 +106,7 @@ package body GNAT.Sockets.Thin.Task_Safe_NetDB is
Ret.H_Name := C.Strings.To_Chars_Ptr
(Netdb_Data.Name'Unrestricted_Access);
Ret.H_Aliases := Alias_Access;
Ret.H_Addrtype := Constants.AF_INET;
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;
@ -135,7 +135,7 @@ package body GNAT.Sockets.Thin.Task_Safe_NetDB is
begin
Addr := VxWorks_hostGetByName (Name);
if Addr = Constants.ERROR then
if Addr = SOSC.ERROR then
return -1;
end if;
@ -161,7 +161,7 @@ package body GNAT.Sockets.Thin.Task_Safe_NetDB is
Ret.H_Name := C.Strings.To_Chars_Ptr
(Netdb_Data.Name'Unrestricted_Access);
Ret.H_Aliases := Alias_Access;
Ret.H_Addrtype := Constants.AF_INET;
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;