2009-04-27 Basile Starynkevitch <basile@starynkevitch.net>

	MERGED WITH TRUNK r146824::
	* gcc/basilys.h: all GTY goes before the identifiers.
	* gcc/basilys.c: removed errors.h include.
	* gcc/run-basilys.h: ditto.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@146839 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 29 insertions, 64 deletions

diff --git a/gcc/ada/g-socthi-vms.adb b/gcc/ada/g-socthi-vms.adb
index 0151ef567f4..afadbb2e5b8 100644
--- a/gcc/ada/g-socthi-vms.adb
+++ b/gcc/ada/g-socthi-vms.adb
@@ -31,7 +31,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  Temporary version for Alpha/VMS
+--  This is the version for OpenVMS
 
 with GNAT.OS_Lib; use GNAT.OS_Lib;
 with GNAT.Task_Lock;
@@ -40,21 +40,19 @@ with Interfaces.C; use Interfaces.C;
 
 package body GNAT.Sockets.Thin is
 
-   Non_Blocking_Sockets : constant Fd_Set_Access :=
-                            New_Socket_Set (No_Fd_Set_Access);
-   --  When this package is initialized with Process_Blocking_IO set
-   --  to True, sockets are set in non-blocking mode to avoid blocking
-   --  the whole process when a thread wants to perform a blocking IO
-   --  operation. But the user can also set a socket in non-blocking
-   --  mode by purpose. In order to make a difference between these
-   --  two situations, we track the origin of non-blocking mode in
-   --  Non_Blocking_Sockets. If S is in Non_Blocking_Sockets, it has
-   --  been set in non-blocking mode by the user.
+   Non_Blocking_Sockets : aliased Fd_Set;
+   --  When this package is initialized with Process_Blocking_IO set to True,
+   --  sockets are set in non-blocking mode to avoid blocking the whole process
+   --  when a thread wants to perform a blocking IO operation. But the user can
+   --  also set a socket in non-blocking mode by purpose. In order to make a
+   --  difference between these two situations, we track the origin of
+   --  non-blocking mode in Non_Blocking_Sockets. If S is in
+   --  Non_Blocking_Sockets, it has been set in non-blocking mode by the user.
 
    Quantum : constant Duration := 0.2;
-   --  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.
+   --  When SOSC.Thread_Blocking_IO is False, we set sockets to non-blocking
+   --  mode and we spend a period of time Quantum between two attempts on a
+   --  blocking operation.
 
    Unknown_System_Error : constant C.Strings.chars_ptr :=
                             C.Strings.New_String ("Unknown system error");
@@ -74,7 +72,7 @@ package body GNAT.Sockets.Thin is
    function Syscall_Ioctl
      (S    : C.int;
       Req  : C.int;
-      Arg  : Int_Access) return C.int;
+      Arg  : access C.int) return C.int;
    pragma Import (C, Syscall_Ioctl, "ioctl");
 
    function Syscall_Recv
@@ -93,13 +91,6 @@ package body GNAT.Sockets.Thin is
       Fromlen : not null access C.int) return C.int;
    pragma Import (C, Syscall_Recvfrom, "recvfrom");
 
-   function Syscall_Send
-     (S     : C.int;
-      Msg   : System.Address;
-      Len   : C.int;
-      Flags : C.int) return C.int;
-   pragma Import (C, Syscall_Send, "send");
-
    function Syscall_Sendto
      (S     : C.int;
       Msg   : System.Address;
@@ -113,7 +104,7 @@ package body GNAT.Sockets.Thin is
      (Domain, Typ, Protocol : C.int) return C.int;
    pragma Import (C, Syscall_Socket, "socket");
 
-   function  Non_Blocking_Socket (S : C.int) return Boolean;
+   function Non_Blocking_Socket (S : C.int) return Boolean;
    procedure Set_Non_Blocking_Socket (S : C.int; V : Boolean);
 
    --------------
@@ -149,7 +140,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, SOSC.FIONBIO, Val'Unchecked_Access);
+         Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access);
       end if;
 
       return R;
@@ -178,32 +169,29 @@ package body GNAT.Sockets.Thin is
       end if;
 
       declare
-         WSet : Fd_Set_Access;
+         WSet : aliased Fd_Set;
          Now  : aliased Timeval;
 
       begin
-         WSet := New_Socket_Set (No_Fd_Set_Access);
+         Reset_Socket_Set (WSet'Access);
          loop
-            Insert_Socket_In_Set (WSet, S);
+            Insert_Socket_In_Set (WSet'Access, S);
             Now := Immediat;
             Res := C_Select
               (S + 1,
                No_Fd_Set_Access,
-               WSet,
+               WSet'Access,
                No_Fd_Set_Access,
                Now'Unchecked_Access);
 
             exit when Res > 0;
 
             if Res = Failure then
-               Free_Socket_Set (WSet);
                return Res;
             end if;
 
             delay Quantum;
          end loop;
-
-         Free_Socket_Set (WSet);
       end;
 
       Res := Syscall_Connect (S, Name, Namelen);
@@ -223,7 +211,7 @@ package body GNAT.Sockets.Thin is
    function C_Ioctl
      (S   : C.int;
       Req : C.int;
-      Arg : Int_Access) return C.int
+      Arg : access C.int) return C.int
    is
    begin
       if not SOSC.Thread_Blocking_IO
@@ -289,31 +277,6 @@ package body GNAT.Sockets.Thin is
       return Res;
    end C_Recvfrom;
 
-   ------------
-   -- C_Send --
-   ------------
-
-   function C_Send
-     (S     : C.int;
-      Msg   : System.Address;
-      Len   : C.int;
-      Flags : C.int) return C.int
-   is
-      Res : C.int;
-
-   begin
-      loop
-         Res := Syscall_Send (S, Msg, Len, Flags);
-         exit when SOSC.Thread_Blocking_IO
-           or else Res /= Failure
-           or else Non_Blocking_Socket (S)
-           or else Errno /= SOSC.EWOULDBLOCK;
-         delay Quantum;
-      end loop;
-
-      return Res;
-   end C_Send;
-
    --------------
    -- C_Sendto --
    --------------
@@ -365,7 +328,7 @@ package body GNAT.Sockets.Thin is
          --  Do not use C_Ioctl as this subprogram tracks sockets set
          --  in non-blocking mode by user.
 
-         Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Unchecked_Access);
+         Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access);
          Set_Non_Blocking_Socket (R, False);
       end if;
 
@@ -393,7 +356,7 @@ package body GNAT.Sockets.Thin is
 
    procedure Initialize is
    begin
-      null;
+      Reset_Socket_Set (Non_Blocking_Sockets'Access);
    end Initialize;
 
    -------------------------
@@ -404,7 +367,7 @@ package body GNAT.Sockets.Thin is
       R : Boolean;
    begin
       Task_Lock.Lock;
-      R := (Is_Socket_In_Set (Non_Blocking_Sockets, S) /= 0);
+      R := (Is_Socket_In_Set (Non_Blocking_Sockets'Access, S) /= 0);
       Task_Lock.Unlock;
       return R;
    end Non_Blocking_Socket;
@@ -418,9 +381,9 @@ package body GNAT.Sockets.Thin is
       Task_Lock.Lock;
 
       if V then
-         Insert_Socket_In_Set (Non_Blocking_Sockets, S);
+         Insert_Socket_In_Set (Non_Blocking_Sockets'Access, S);
       else
-         Remove_Socket_From_Set (Non_Blocking_Sockets, S);
+         Remove_Socket_From_Set (Non_Blocking_Sockets'Access, S);
       end if;
 
       Task_Lock.Unlock;
@@ -504,11 +467,13 @@ package body GNAT.Sockets.Thin is
 
    begin
       for J in Iovec'Range loop
-         Res := C_Send
+         Res := C_Sendto
            (Fd,
             Iovec (J).Base.all'Address,
             Interfaces.C.int (Iovec (J).Length),
-            SOSC.MSG_Forced_Flags);
+            SOSC.MSG_Forced_Flags,
+            To    => null,
+            Tolen => 0);
 
          if Res < 0 then
             return Res;