obtained gcc-4.6.4.tar.bz2 from upstream website;upstream

verified gcc-4.6.4.tar.bz2.sig;
imported gcc-4.6.4 source tree from verified upstream tarball.

downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.

if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.

1 files changed, 478 insertions, 0 deletions

diff --git a/gcc/ada/g-socthi-vms.adb b/gcc/ada/g-socthi-vms.adb
new file mode 100644
index 000000000..133182144
--- /dev/null
+++ b/gcc/ada/g-socthi-vms.adb
@@ -0,0 +1,478 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                    G N A T . S O C K E T S . T H I N                     --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                     Copyright (C) 2001-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- --
+-- 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 is the version for OpenVMS
+
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+with GNAT.Task_Lock;
+
+with Interfaces.C; use Interfaces.C;
+
+package body GNAT.Sockets.Thin is
+
+   type VMS_Msghdr is new Msghdr;
+   pragma Pack (VMS_Msghdr);
+   --  On VMS (unlike other platforms), struct msghdr is packed, so a specific
+   --  derived type is required.
+
+   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. Note that 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 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");
+
+   function Syscall_Accept
+     (S       : C.int;
+      Addr    : System.Address;
+      Addrlen : not null access C.int) return C.int;
+   pragma Import (C, Syscall_Accept, "accept");
+
+   function Syscall_Connect
+     (S       : C.int;
+      Name    : System.Address;
+      Namelen : C.int) return C.int;
+   pragma Import (C, Syscall_Connect, "connect");
+
+   function Syscall_Recv
+     (S     : C.int;
+      Msg   : System.Address;
+      Len   : C.int;
+      Flags : C.int) return C.int;
+   pragma Import (C, Syscall_Recv, "recv");
+
+   function Syscall_Recvfrom
+     (S       : C.int;
+      Msg     : System.Address;
+      Len     : C.int;
+      Flags   : C.int;
+      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_Sendto
+     (S     : C.int;
+      Msg   : System.Address;
+      Len   : C.int;
+      Flags : C.int;
+      To    : System.Address;
+      Tolen : C.int) return C.int;
+   pragma Import (C, Syscall_Sendto, "sendto");
+
+   function Syscall_Socket
+     (Domain, Typ, Protocol : C.int) return C.int;
+   pragma Import (C, Syscall_Socket, "socket");
+
+   function Non_Blocking_Socket (S : C.int) return Boolean;
+   procedure Set_Non_Blocking_Socket (S : C.int; V : Boolean);
+
+   --------------
+   -- C_Accept --
+   --------------
+
+   function C_Accept
+     (S       : C.int;
+      Addr    : System.Address;
+      Addrlen : not null access C.int) return C.int
+   is
+      R   : C.int;
+      Val : aliased C.int := 1;
+
+      Discard : C.int;
+      pragma Warnings (Off, Discard);
+
+   begin
+      loop
+         R := Syscall_Accept (S, Addr, Addrlen);
+         exit when SOSC.Thread_Blocking_IO
+           or else R /= Failure
+           or else Non_Blocking_Socket (S)
+           or else Errno /= SOSC.EWOULDBLOCK;
+         delay Quantum;
+      end loop;
+
+      if not SOSC.Thread_Blocking_IO
+        and then R /= Failure
+      then
+         --  A socket inherits the properties of its server, especially
+         --  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));
+         Discard := C_Ioctl (R, SOSC.FIONBIO, Val'Access);
+      end if;
+
+      return R;
+   end C_Accept;
+
+   ---------------
+   -- C_Connect --
+   ---------------
+
+   function C_Connect
+     (S       : C.int;
+      Name    : System.Address;
+      Namelen : C.int) return C.int
+   is
+      Res : C.int;
+
+   begin
+      Res := Syscall_Connect (S, Name, Namelen);
+
+      if SOSC.Thread_Blocking_IO
+        or else Res /= Failure
+        or else Non_Blocking_Socket (S)
+        or else Errno /= SOSC.EINPROGRESS
+      then
+         return Res;
+      end if;
+
+      declare
+         WSet : aliased Fd_Set;
+         Now  : aliased Timeval;
+
+      begin
+         Reset_Socket_Set (WSet'Access);
+         loop
+            Insert_Socket_In_Set (WSet'Access, S);
+            Now := Immediat;
+            Res := C_Select
+              (S + 1,
+               No_Fd_Set_Access,
+               WSet'Access,
+               No_Fd_Set_Access,
+               Now'Unchecked_Access);
+
+            exit when Res > 0;
+
+            if Res = Failure then
+               return Res;
+            end if;
+
+            delay Quantum;
+         end loop;
+      end;
+
+      Res := Syscall_Connect (S, Name, Namelen);
+
+      if Res = Failure and then Errno = SOSC.EISCONN then
+         return Thin_Common.Success;
+      else
+         return Res;
+      end if;
+   end C_Connect;
+
+   ------------------
+   -- Socket_Ioctl --
+   ------------------
+
+   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 Arg.all /= 0 then
+            Set_Non_Blocking_Socket (S, True);
+         end if;
+      end if;
+
+      return C_Ioctl (S, Req, Arg);
+   end Socket_Ioctl;
+
+   ------------
+   -- C_Recv --
+   ------------
+
+   function C_Recv
+     (S     : C.int;
+      Msg   : System.Address;
+      Len   : C.int;
+      Flags : C.int) return C.int
+   is
+      Res : C.int;
+
+   begin
+      loop
+         Res := Syscall_Recv (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_Recv;
+
+   ----------------
+   -- C_Recvfrom --
+   ----------------
+
+   function C_Recvfrom
+     (S       : C.int;
+      Msg     : System.Address;
+      Len     : C.int;
+      Flags   : C.int;
+      From    : System.Address;
+      Fromlen : not null access C.int) return C.int
+   is
+      Res : C.int;
+
+   begin
+      loop
+         Res := Syscall_Recvfrom (S, Msg, Len, Flags, From, Fromlen);
+         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_Recvfrom;
+
+   ---------------
+   -- C_Recvmsg --
+   ---------------
+
+   function C_Recvmsg
+     (S     : C.int;
+      Msg   : System.Address;
+      Flags : C.int) return System.CRTL.ssize_t
+   is
+      Res : C.int;
+
+      GNAT_Msg : Msghdr;
+      for GNAT_Msg'Address use Msg;
+      pragma Import (Ada, GNAT_Msg);
+
+      VMS_Msg : aliased VMS_Msghdr := VMS_Msghdr (GNAT_Msg);
+
+   begin
+      loop
+         Res := Syscall_Recvmsg (S, VMS_Msg'Address, 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;
+
+      GNAT_Msg := Msghdr (VMS_Msg);
+
+      return System.CRTL.ssize_t (Res);
+   end C_Recvmsg;
+
+   ---------------
+   -- C_Sendmsg --
+   ---------------
+
+   function C_Sendmsg
+     (S     : C.int;
+      Msg   : System.Address;
+      Flags : C.int) return System.CRTL.ssize_t
+   is
+      Res : C.int;
+
+      GNAT_Msg : Msghdr;
+      for GNAT_Msg'Address use Msg;
+      pragma Import (Ada, GNAT_Msg);
+
+      VMS_Msg : aliased VMS_Msghdr := VMS_Msghdr (GNAT_Msg);
+
+   begin
+      loop
+         Res := Syscall_Sendmsg (S, VMS_Msg'Address, 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;
+
+      GNAT_Msg := Msghdr (VMS_Msg);
+
+      return System.CRTL.ssize_t (Res);
+   end C_Sendmsg;
+
+   --------------
+   -- C_Sendto --
+   --------------
+
+   function C_Sendto
+     (S     : C.int;
+      Msg   : System.Address;
+      Len   : C.int;
+      Flags : C.int;
+      To    : System.Address;
+      Tolen : C.int) return C.int
+   is
+      Res : C.int;
+
+   begin
+      loop
+         Res := Syscall_Sendto (S, Msg, Len, Flags, To, Tolen);
+         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_Sendto;
+
+   --------------
+   -- C_Socket --
+   --------------
+
+   function C_Socket
+     (Domain   : C.int;
+      Typ      : C.int;
+      Protocol : C.int) return C.int
+   is
+      R   : C.int;
+      Val : aliased C.int := 1;
+
+      Discard : C.int;
+      pragma Unreferenced (Discard);
+
+   begin
+      R := Syscall_Socket (Domain, Typ, Protocol);
+
+      if not SOSC.Thread_Blocking_IO
+        and then R /= Failure
+      then
+         --  Do not use Socket_Ioctl as this subprogram tracks sockets set
+         --  in non-blocking mode by user.
+
+         Discard := C_Ioctl (R, SOSC.FIONBIO, Val'Access);
+         Set_Non_Blocking_Socket (R, False);
+      end if;
+
+      return R;
+   end C_Socket;
+
+   --------------
+   -- Finalize --
+   --------------
+
+   procedure Finalize is
+   begin
+      null;
+   end Finalize;
+
+   -------------------------
+   -- Host_Error_Messages --
+   -------------------------
+
+   package body Host_Error_Messages is separate;
+
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize is
+   begin
+      Reset_Socket_Set (Non_Blocking_Sockets'Access);
+   end Initialize;
+
+   -------------------------
+   -- Non_Blocking_Socket --
+   -------------------------
+
+   function Non_Blocking_Socket (S : C.int) return Boolean is
+      R : Boolean;
+   begin
+      Task_Lock.Lock;
+      R := (Is_Socket_In_Set (Non_Blocking_Sockets'Access, S) /= 0);
+      Task_Lock.Unlock;
+      return R;
+   end Non_Blocking_Socket;
+
+   -----------------------------
+   -- Set_Non_Blocking_Socket --
+   -----------------------------
+
+   procedure Set_Non_Blocking_Socket (S : C.int; V : Boolean) is
+   begin
+      Task_Lock.Lock;
+
+      if V then
+         Insert_Socket_In_Set (Non_Blocking_Sockets'Access, S);
+      else
+         Remove_Socket_From_Set (Non_Blocking_Sockets'Access, S);
+      end if;
+
+      Task_Lock.Unlock;
+   end Set_Non_Blocking_Socket;
+
+   --------------------
+   -- Signalling_Fds --
+   --------------------
+
+   package body Signalling_Fds is separate;
+
+   --------------------------
+   -- Socket_Error_Message --
+   --------------------------
+
+   function Socket_Error_Message
+     (Errno : Integer) return C.Strings.chars_ptr
+   is separate;
+
+end GNAT.Sockets.Thin;