diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-06-06 10:31:06 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-06-06 10:31:06 +0000 |
commit | 9c106c0e27975584592308c14e544b6519294ecf (patch) | |
tree | fc7e9dbcdb9f0960c2ce0a3170d937a7c1f6f6a4 /gcc/ada/g-socthi.adb | |
parent | f1e7e44d0973adb35ddc43ea0fa8b89d73974379 (diff) | |
download | gcc-9c106c0e27975584592308c14e544b6519294ecf.tar.gz |
2007-04-20 Thomas Quinot <quinot@adacore.com>
* g-soccon.ads: Add new constant Thread_Blocking_IO, always True by
default, set False on a per-runtime basis.
(Need_Netdb_Buffer): New constant.
* g-socket.ads, g-socket.adb: Import new package
GNAT.Sockets.Thin.Task_Safe_NetDB.
(Raise_Host_Error): Use Host_Error_Message from platform-specific thin
binding to obtain proper message.
(Close_Selector): Use GNAT.Sockets.Thin.Signalling_Fds.Close.
Replace various occurrences of Arry (Arry'First)'Address with the
equivalent Arry'Address (GNAT always follows implementation advice from
13.3(14)).
(Get_Host_By_Address, Get_Host_By_Name,
Get_Service_By_Name, Get_Service_By_Port): Do not use GNAT.Task_Lock;
instead, rely on platform-specific task safe netdb operations provided
by g-socthi.
* g-socthi.ads, g-socthi.adb (Initialize): Remove obsolete formal
parameter Process_Blocking_IO.
(Host_Error_Messages): Add stub body.
(GNAT.Sockets.Thin.Signalling_Fds): New procedure Close.
(Safe_Gethostbyname, Safe_Gethostbyaddr, Safe_Getservbyname,
Safe_Getservbyport): Move functions into new child package
Task_Safe_NetDB.
(Nonreentrant_Gethostbyname, Nonreentrant_Gethostbyaddr,
Nonreentrant_Getservbyname, Nonreentrant_Getservbyport): New routines.
(In_Addr): Add alignment clause.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@125424 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/g-socthi.adb')
-rw-r--r-- | gcc/ada/g-socthi.adb | 43 |
1 files changed, 23 insertions, 20 deletions
diff --git a/gcc/ada/g-socthi.adb b/gcc/ada/g-socthi.adb index 7ca1c1cdfdf..6ea18f67b47 100644 --- a/gcc/ada/g-socthi.adb +++ b/gcc/ada/g-socthi.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2006, AdaCore -- +-- Copyright (C) 2001-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- -- @@ -56,13 +56,10 @@ package body GNAT.Sockets.Thin is -- been set in non-blocking mode by the user. Quantum : constant Duration := 0.2; - -- When Thread_Blocking_IO is False, we set sockets in + -- When Constants.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. - Thread_Blocking_IO : Boolean := True; - -- Comment required for this ??? - Unknown_System_Error : constant C.Strings.chars_ptr := C.Strings.New_String ("Unknown system error"); @@ -153,14 +150,14 @@ package body GNAT.Sockets.Thin is begin loop R := Syscall_Accept (S, Addr, Addrlen); - exit when Thread_Blocking_IO + exit when Constants.Thread_Blocking_IO or else R /= Failure or else Non_Blocking_Socket (S) or else Errno /= Constants.EWOULDBLOCK; delay Quantum; end loop; - if not Thread_Blocking_IO + if not Constants.Thread_Blocking_IO and then R /= Failure then -- A socket inherits the properties ot its server especially @@ -189,7 +186,7 @@ package body GNAT.Sockets.Thin is begin Res := Syscall_Connect (S, Name, Namelen); - if Thread_Blocking_IO + if Constants.Thread_Blocking_IO or else Res /= Failure or else Non_Blocking_Socket (S) or else Errno /= Constants.EINPROGRESS @@ -247,7 +244,7 @@ package body GNAT.Sockets.Thin is Arg : Int_Access) return C.int is begin - if not Thread_Blocking_IO + if not Constants.Thread_Blocking_IO and then Req = Constants.FIONBIO then if Arg.all /= 0 then @@ -273,7 +270,7 @@ package body GNAT.Sockets.Thin is begin loop Res := Syscall_Recv (S, Msg, Len, Flags); - exit when Thread_Blocking_IO + exit when Constants.Thread_Blocking_IO or else Res /= Failure or else Non_Blocking_Socket (S) or else Errno /= Constants.EWOULDBLOCK; @@ -300,7 +297,7 @@ package body GNAT.Sockets.Thin is begin loop Res := Syscall_Recvfrom (S, Msg, Len, Flags, From, Fromlen); - exit when Thread_Blocking_IO + exit when Constants.Thread_Blocking_IO or else Res /= Failure or else Non_Blocking_Socket (S) or else Errno /= Constants.EWOULDBLOCK; @@ -325,7 +322,7 @@ package body GNAT.Sockets.Thin is begin loop Res := Syscall_Send (S, Msg, Len, Flags); - exit when Thread_Blocking_IO + exit when Constants.Thread_Blocking_IO or else Res /= Failure or else Non_Blocking_Socket (S) or else Errno /= Constants.EWOULDBLOCK; @@ -352,7 +349,7 @@ package body GNAT.Sockets.Thin is begin loop Res := Syscall_Sendto (S, Msg, Len, Flags, To, Tolen); - exit when Thread_Blocking_IO + exit when Constants.Thread_Blocking_IO or else Res /= Failure or else Non_Blocking_Socket (S) or else Errno /= Constants.EWOULDBLOCK; @@ -380,7 +377,7 @@ package body GNAT.Sockets.Thin is begin R := Syscall_Socket (Domain, Typ, Protocol); - if not Thread_Blocking_IO + if not Constants.Thread_Blocking_IO and then R /= Failure then -- Do not use C_Ioctl as this subprogram tracks sockets set @@ -402,13 +399,18 @@ package body GNAT.Sockets.Thin is null; end Finalize; + ------------------------- + -- Host_Error_Messages -- + ------------------------- + + package body Host_Error_Messages is separate; + ---------------- -- Initialize -- ---------------- - procedure Initialize (Process_Blocking_IO : Boolean) is + procedure Initialize is begin - Thread_Blocking_IO := not Process_Blocking_IO; Disable_All_SIGPIPEs; end Initialize; @@ -505,17 +507,18 @@ package body GNAT.Sockets.Thin is function C_Create (Fds : not null access Fd_Pair) return C.int; function C_Read (Rsig : C.int) return C.int; function C_Write (Wsig : C.int) return C.int; + procedure C_Close (Sig : C.int); pragma Import (C, C_Create, "__gnat_create_signalling_fds"); pragma Import (C, C_Read, "__gnat_read_signalling_fd"); pragma Import (C, C_Write, "__gnat_write_signalling_fd"); + pragma Import (C, C_Close, "__gnat_close_signalling_fd"); - function Create (Fds : not null access Fd_Pair) return C.int - renames C_Create; - + function Create + (Fds : not null access Fd_Pair) return C.int renames C_Create; function Read (Rsig : C.int) return C.int renames C_Read; - function Write (Wsig : C.int) return C.int renames C_Write; + procedure Close (Sig : C.int) renames C_Close; end Signalling_Fds; |