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

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;