2009-08-28 Sebastian Pop <sebastian.pop@amd.com>

[pf3gnuchains/gcc-fork.git] / gcc / ada / g-socthi-vxworks.adb

diff --git a/gcc/ada/g-socthi-vxworks.adb b/gcc/ada/g-socthi-vxworks.adb
index d9d436f..96d0cfc 100644 (file)
--- a/gcc/ada/g-socthi-vxworks.adb
+++ b/gcc/ada/g-socthi-vxworks.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 2002-2008, AdaCore                     --
+--                     Copyright (C) 2002-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- --
@@ -80,12 +80,6 @@ package body GNAT.Sockets.Thin is
       Namelen : C.int) return C.int;
    pragma Import (C, Syscall_Connect, "connect");
 
-   function Syscall_Ioctl
-     (S    : C.int;
-      Req  : C.int;
-      Arg  : Int_Access) return C.int;
-   pragma Import (C, Syscall_Ioctl, "ioctl");
-
    function Syscall_Recv
      (S     : C.int;
       Msg   : System.Address;
@@ -98,10 +92,22 @@ package body GNAT.Sockets.Thin is
       Msg     : System.Address;
       Len     : C.int;
       Flags   : C.int;
-      From    : Sockaddr_In_Access;
+      From    : System.Address;
       Fromlen : not null access C.int) return C.int;
    pragma Import (C, Syscall_Recvfrom, "recvfrom");
 
+   function Syscall_Recvmsg
+     (S     : C.int;
+      Msg   : System.Address;
+      Flags : C.int) return C.int;
+   pragma Import (C, Syscall_Recvmsg, "recvmsg");
+
+   function Syscall_Sendmsg
+     (S     : C.int;
+      Msg   : System.Address;
+      Flags : C.int) return C.int;
+   pragma Import (C, Syscall_Sendmsg, "sendmsg");
+
    function Syscall_Send
      (S     : C.int;
       Msg   : System.Address;
@@ -114,7 +120,7 @@ package body GNAT.Sockets.Thin is
       Msg   : System.Address;
       Len   : C.int;
       Flags : C.int;
-      To    : Sockaddr_In_Access;
+      To    : System.Address;
       Tolen : C.int) return C.int;
    pragma Import (C, Syscall_Sendto, "sendto");
 
@@ -156,11 +162,11 @@ package body GNAT.Sockets.Thin is
         and then R /= Failure
       then
          --  A socket inherits the properties of its server especially
-         --  the FIONBIO flag. Do not use C_Ioctl as this subprogram
+         --  the FIONBIO flag. Do not use Socket_Ioctl as this subprogram
          --  tracks sockets set in non-blocking mode by user.
 
          Set_Non_Blocking_Socket (R, Non_Blocking_Socket (S));
-         Res := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Unchecked_Access);
+         Res := C_Ioctl (R, SOSC.FIONBIO, Val'Access);
          --  Is it OK to ignore result ???
       end if;
 
@@ -225,26 +231,24 @@ package body GNAT.Sockets.Thin is
       end if;
    end C_Connect;
 
-   -------------
-   -- C_Ioctl --
-   -------------
+   ------------------
+   -- Socket_Ioctl --
+   ------------------
 
-   function C_Ioctl
-     (S    : C.int;
-      Req  : C.int;
-      Arg  : Int_Access) return C.int
+   function Socket_Ioctl
+     (S   : C.int;
+      Req : C.int;
+      Arg : access C.int) return C.int
    is
    begin
-      if not SOSC.Thread_Blocking_IO
-        and then Req = SOSC.FIONBIO
-      then
+      if not SOSC.Thread_Blocking_IO and then Req = SOSC.FIONBIO then
          if Arg.all /= 0 then
             Set_Non_Blocking_Socket (S, True);
          end if;
       end if;
 
-      return Syscall_Ioctl (S, Req, Arg);
-   end C_Ioctl;
+      return C_Ioctl (S, Req, Arg);
+   end Socket_Ioctl;
 
    ------------
    -- C_Recv --
@@ -280,7 +284,7 @@ package body GNAT.Sockets.Thin is
       Msg     : System.Address;
       Len     : C.int;
       Flags   : C.int;
-      From    : Sockaddr_In_Access;
+      From    : System.Address;
       Fromlen : not null access C.int) return C.int
    is
       Res : C.int;
@@ -298,21 +302,20 @@ package body GNAT.Sockets.Thin is
       return Res;
    end C_Recvfrom;
 
-   ------------
-   -- C_Send --
-   ------------
+   ---------------
+   -- C_Recvmsg --
+   ---------------
 
-   function C_Send
+   function C_Recvmsg
      (S     : C.int;
       Msg   : System.Address;
-      Len   : C.int;
-      Flags : C.int) return C.int
+      Flags : C.int) return ssize_t
    is
       Res : C.int;
 
    begin
       loop
-         Res := Syscall_Send (S, Msg, Len, Flags);
+         Res := Syscall_Recvmsg (S, Msg, Flags);
          exit when SOSC.Thread_Blocking_IO
            or else Res /= Failure
            or else Non_Blocking_Socket (S)
@@ -320,8 +323,32 @@ package body GNAT.Sockets.Thin is
          delay Quantum;
       end loop;
 
-      return Res;
-   end C_Send;
+      return ssize_t (Res);
+   end C_Recvmsg;
+
+   ---------------
+   -- C_Sendmsg --
+   ---------------
+
+   function C_Sendmsg
+     (S     : C.int;
+      Msg   : System.Address;
+      Flags : C.int) return ssize_t
+   is
+      Res : C.int;
+
+   begin
+      loop
+         Res := Syscall_Sendmsg (S, Msg, 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 ssize_t (Res);
+   end C_Sendmsg;
 
    --------------
    -- C_Sendto --
@@ -332,14 +359,29 @@ package body GNAT.Sockets.Thin is
       Msg   : System.Address;
       Len   : C.int;
       Flags : C.int;
-      To    : Sockaddr_In_Access;
+      To    : System.Address;
       Tolen : C.int) return C.int
    is
+      use System;
+
       Res : C.int;
 
    begin
       loop
-         Res := Syscall_Sendto (S, Msg, Len, Flags, To, Tolen);
+         if To = Null_Address then
+
+            --  In violation of the standard sockets API, VxWorks does not
+            --  support sendto(2) calls on connected sockets with a null
+            --  destination address, so use send(2) instead in that case.
+
+            Res := Syscall_Send (S, Msg, Len, Flags);
+
+         --  Normal case where destination address is non-null
+
+         else
+            Res := Syscall_Sendto (S, Msg, Len, Flags, To, Tolen);
+         end if;
+
          exit when SOSC.Thread_Blocking_IO
            or else Res /= Failure
            or else Non_Blocking_Socket (S)
@@ -371,10 +413,10 @@ package body GNAT.Sockets.Thin is
       if not SOSC.Thread_Blocking_IO
         and then R /= Failure
       then
-         --  Do not use C_Ioctl as this subprogram tracks sockets set
+         --  Do not use Socket_Ioctl as this subprogram tracks sockets set
          --  in non-blocking mode by user.
 
-         Res := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Unchecked_Access);
+         Res := C_Ioctl (R, SOSC.FIONBIO, Val'Access);
          --  Is it OK to ignore result ???
          Set_Non_Blocking_Socket (R, False);
       end if;