path: root/gcc47-ada.patch

--- origsrc/gcc-4.7.2/gcc/ada//a-intnam-cygwin.ads	1970-01-01 00:00:00.000000000 +0000
+++ src/gcc-4.7.2/gcc/ada//a-intnam-cygwin.ads	2012-11-01 21:17:31.000000000 +0000
@@ -0,0 +1,170 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
+--                                                                          --
+--                   A D A . I N T E R R U P T S . N A M E S                --
+--                                                                          --
+--                                  S p e c                                 --
+--                                                                          --
+--          Copyright (C) 1991-2011, Free Software Foundation, Inc.         --
+--                                                                          --
+-- GNARL 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 3,  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.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNARL was developed by the GNARL team at Florida State University.       --
+-- Extensive contributions were provided by Ada Core Technologies, Inc.     --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This is a Cygwin version of this package but really it's a copy of the
+--  Linux version, so the below comments are probably irrelevant:
+
+--  The following signals are reserved by the run time (FSU threads):
+
+--  SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGABRT, SIGINT,
+--  SIGALRM, SIGVTALRM, SIGUNUSED, SIGSTOP, SIGKILL
+
+--  The following signals are reserved by the run time (LinuxThreads):
+
+--  SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGABRT, SIGINT,
+--  SIGUSR1, SIGUSR2, SIGVTALRM, SIGUNUSED, SIGSTOP, SIGKILL
+
+--  The pragma Unreserve_All_Interrupts affects the following signal(s):
+
+--  SIGINT: made available for Ada handler
+
+--  This target-dependent package spec contains names of interrupts
+--  supported by the local system.
+
+with System.OS_Interface;
+--  used for names of interrupts
+
+package Ada.Interrupts.Names is
+
+   --  All identifiers in this unit are implementation defined
+
+   pragma Implementation_Defined;
+
+   --  Beware that the mapping of names to signals may be many-to-one. There
+   --  may be aliases. Also, for all signal names that are not supported on the
+   --  current system the value of the corresponding constant will be zero.
+
+   SIGHUP : constant Interrupt_ID :=
+     System.OS_Interface.SIGHUP;      --  hangup
+
+   SIGINT : constant Interrupt_ID :=
+     System.OS_Interface.SIGINT;      --  interrupt (rubout)
+
+   SIGQUIT : constant Interrupt_ID :=
+     System.OS_Interface.SIGQUIT;     --  quit (ASCD FS)
+
+   SIGILL : constant Interrupt_ID :=
+     System.OS_Interface.SIGILL;      --  illegal instruction (not reset)
+
+   SIGTRAP : constant Interrupt_ID :=
+     System.OS_Interface.SIGTRAP;     --  trace trap (not reset)
+
+   SIGIOT : constant Interrupt_ID :=
+     System.OS_Interface.SIGIOT;      --  IOT instruction
+
+   SIGABRT : constant Interrupt_ID := --  used by abort,
+     System.OS_Interface.SIGABRT;     --  replace SIGIOT in the  future
+
+   SIGFPE : constant Interrupt_ID :=
+     System.OS_Interface.SIGFPE;      --  floating point exception
+
+   SIGKILL : constant Interrupt_ID :=
+     System.OS_Interface.SIGKILL;     --  kill (cannot be caught or ignored)
+
+   SIGBUS : constant Interrupt_ID :=
+     System.OS_Interface.SIGBUS;      --  bus error
+
+   SIGSEGV : constant Interrupt_ID :=
+     System.OS_Interface.SIGSEGV;     --  segmentation violation
+
+   SIGPIPE : constant Interrupt_ID := --  write on a pipe with
+     System.OS_Interface.SIGPIPE;     --  no one to read it
+
+   SIGALRM : constant Interrupt_ID :=
+     System.OS_Interface.SIGALRM;     --  alarm clock
+
+   SIGTERM : constant Interrupt_ID :=
+     System.OS_Interface.SIGTERM;     --  software termination signal from kill
+
+   SIGUSR1 : constant Interrupt_ID :=
+     System.OS_Interface.SIGUSR1;     --  user defined signal 1
+
+   SIGUSR2 : constant Interrupt_ID :=
+     System.OS_Interface.SIGUSR2;     --  user defined signal 2
+
+   SIGCLD : constant Interrupt_ID :=
+     System.OS_Interface.SIGCLD;      --  child status change
+
+   SIGCHLD : constant Interrupt_ID :=
+     System.OS_Interface.SIGCHLD;     --  4.3BSD's/POSIX name for SIGCLD
+
+   SIGWINCH : constant Interrupt_ID :=
+     System.OS_Interface.SIGWINCH;    --  window size change
+
+   SIGURG : constant Interrupt_ID :=
+     System.OS_Interface.SIGURG;      --  urgent condition on IO channel
+
+   SIGPOLL : constant Interrupt_ID :=
+     System.OS_Interface.SIGPOLL;     --  pollable event occurred
+
+   SIGIO : constant Interrupt_ID :=   --  input/output possible,
+     System.OS_Interface.SIGIO;       --  SIGPOLL alias (Solaris)
+
+   SIGSTOP : constant Interrupt_ID :=
+     System.OS_Interface.SIGSTOP;     --  stop (cannot be caught or ignored)
+
+   SIGTSTP : constant Interrupt_ID :=
+     System.OS_Interface.SIGTSTP;     --  user stop requested from tty
+
+   SIGCONT : constant Interrupt_ID :=
+     System.OS_Interface.SIGCONT;     --  stopped process has been continued
+
+   SIGTTIN : constant Interrupt_ID :=
+     System.OS_Interface.SIGTTIN;     --  background tty read attempted
+
+   SIGTTOU : constant Interrupt_ID :=
+     System.OS_Interface.SIGTTOU;     --  background tty write attempted
+
+   SIGVTALRM : constant Interrupt_ID :=
+     System.OS_Interface.SIGVTALRM;   --  virtual timer expired
+
+   SIGPROF : constant Interrupt_ID :=
+     System.OS_Interface.SIGPROF;     --  profiling timer expired
+
+   SIGXCPU : constant Interrupt_ID :=
+     System.OS_Interface.SIGXCPU;     --  CPU time limit exceeded
+
+   SIGXFSZ : constant Interrupt_ID :=
+     System.OS_Interface.SIGXFSZ;     --  filesize limit exceeded
+
+   SIGUNUSED : constant Interrupt_ID :=
+     System.OS_Interface.SIGUNUSED;     --  unused signal
+
+   SIGSTKFLT : constant Interrupt_ID :=
+     System.OS_Interface.SIGSTKFLT;     --  stack fault on coprocessor
+
+   SIGLOST : constant Interrupt_ID :=
+     System.OS_Interface.SIGLOST;       --  Linux alias for SIGIO
+
+   SIGPWR : constant Interrupt_ID :=
+     System.OS_Interface.SIGPWR;        --  Power failure
+
+end Ada.Interrupts.Names;
--- origsrc/gcc-4.7.2/gcc/ada//gcc-interface/Makefile.in	2012-11-02 15:16:49.765625000 +0000
+++ src/gcc-4.7.2/gcc/ada//gcc-interface/Makefile.in	2012-11-01 21:17:31.000000000 +0000
@@ -191,6 +191,13 @@ TARGET_ADA_SRCS =
 # Type of tools build we are doing; default is not compiling tools.
 TOOLSCASE =
 
+# Which install goal to use.
+INSTALL_GNATLIB_MAIN  = install-gnatlib
+INSTALL_GNATLIB_WIN32 = unused-install-gnatlib
+
+# Set shared lib prefix (lib on all systems but cygwin, which uses cyg)
+LIBGNAT_SHARED_LIB_PREFIX=lib
+
 # Multilib handling
 MULTISUBDIR =
 RTSDIR = rts$(subst /,_,$(MULTISUBDIR))
@@ -1583,6 +1590,12 @@ ifeq ($(strip $(filter-out avr none powe
 endif
 
 ifeq ($(strip $(filter-out cygwin% mingw32% pe,$(osys))),)
+  # Set target pair suffix for mingw or cygwin
+  W32_TARG=mingw
+  ifneq ($(strip $(filter cygwin%,$(osys))),)
+    W32_TARG=cygwin
+    LIBGNAT_SHARED_LIB_PREFIX=cyg
+  endif
   # Cygwin provides a full Posix environment, and so we use the default
   # versions of s-memory and g-socthi rather than the Windows-specific
   # MinGW versions.  Ideally we would use all the default versions for
@@ -1651,24 +1664,24 @@ ifeq ($(strip $(filter-out cygwin% mingw
       ifeq ($(strip $(MULTISUBDIR)),/32)
 	LIBGNAT_TARGET_PAIRS += \
 	  $(X86_TARGET_PAIRS) \
-	  system.ads<system-mingw.ads
+	  system.ads<system-$(W32_TARG).ads
 	SO_OPTS= -m32 -Wl,-soname,
       else
 	LIBGNAT_TARGET_PAIRS += \
 	  $(X86_64_TARGET_PAIRS) \
-	  system.ads<system-mingw-x86_64.ads
+	  system.ads<system-$(W32_TARG)-x86_64.ads
 	SO_OPTS = -m64 -Wl,-soname,
       endif
     else
       ifeq ($(strip $(MULTISUBDIR)),/64)
 	LIBGNAT_TARGET_PAIRS += \
 	  $(X86_64_TARGET_PAIRS) \
-	  system.ads<system-mingw-x86_64.ads
+	  system.ads<system-$(W32_TARG)-x86_64.ads
 	SO_OPTS = -m64 -Wl,-soname,
       else
 	LIBGNAT_TARGET_PAIRS += \
 	  $(X86_TARGET_PAIRS) \
-	  system.ads<system-mingw.ads
+	  system.ads<system-$(W32_TARG).ads
 	SO_OPTS = -m32 -Wl,-soname,
       endif
     endif
@@ -1677,7 +1690,14 @@ ifeq ($(strip $(filter-out cygwin% mingw
 	s-win32.o s-winext.o g-regist.o g-sse.o g-ssvety.o
     EXTRA_GNATRTL_TASKING_OBJS = a-exetim.o
 
-    MISCLIB = -lws2_32
+    # Which install goal to use.
+    INSTALL_GNATLIB_MAIN  = unused-install-gnatlib
+    INSTALL_GNATLIB_WIN32 = install-gnatlib
+
+    # Mingw uses winsock-based sockets; cygwin uses POSIX sockets.
+    ifneq ($(strip $(filter-out cygwin%,$(osys))),)
+      MISCLIB = -lwsock32
+    endif
 
     # ??? This will be replaced by gnatlib-shared-dual-win32 when GNAT
     # auto-import support for array/record will be done.
@@ -1687,10 +1707,11 @@ ifeq ($(strip $(filter-out cygwin% mingw
   endif
 
   TOOLS_TARGET_PAIRS= \
-  mlib-tgt-specific.adb<mlib-tgt-specific-mingw.adb \
-  indepsw.adb<indepsw-mingw.adb
+  mlib-tgt-specific.adb<mlib-tgt-specific-$(W32_TARG).adb \
+  indepsw.adb<indepsw-$(W32_TARG).adb
 
   GMEM_LIB = gmemlib
+  EH_MECHANISM=-gcc
   EXTRA_GNATTOOLS = ../../gnatdll$(exeext)
   EXTRA_GNATMAKE_OBJS = mdll.o mdll-utl.o mdll-fil.o
   soext = .dll
@@ -2425,7 +2446,7 @@ gnatlink-re: ../stamp-tools link.o targe
 	  true; \
 	fi
 
-install-gnatlib: ../stamp-gnatlib-$(RTSDIR)
+$(INSTALL_GNATLIB_MAIN): ../stamp-gnatlib-$(RTSDIR)
 #	Create the directory before deleting it, in case the directory is
 #	a list of directories (as it may be on VMS). This ensures we are
 #	deleting the right one.
@@ -2472,6 +2493,46 @@ install-gnatlib: ../stamp-gnatlib-$(RTSD
 	cd $(DESTDIR)$(ADA_INCLUDE_DIR); $(CHMOD) a-wx *.adb
 	cd $(DESTDIR)$(ADA_INCLUDE_DIR); $(CHMOD) a-wx *.ads
 
+$(INSTALL_GNATLIB_WIN32): ../stamp-gnatlib-$(RTSDIR)
+#	Create the directory before deleting it, in case the directory is
+#	a list of directories (as it may be on VMS). This ensures we are
+#	deleting the right one.
+	-$(MKDIR) $(DESTDIR)$(ADA_RTL_OBJ_DIR)
+	-$(MKDIR) $(DESTDIR)$(ADA_INCLUDE_DIR)
+	$(RMDIR) $(DESTDIR)$(ADA_RTL_OBJ_DIR)
+	$(RMDIR) $(DESTDIR)$(ADA_INCLUDE_DIR)
+	-$(MKDIR) $(DESTDIR)$(ADA_RTL_OBJ_DIR)
+	-$(MKDIR) $(DESTDIR)$(ADA_INCLUDE_DIR)
+	for file in $(RTSDIR)/*.ali; do \
+	    $(INSTALL_DATA_DATE) $$file $(DESTDIR)$(ADA_RTL_OBJ_DIR); \
+	done
+	-$(INSTALL_DATA) $(RTSDIR)/g-trasym$(objext) $(DESTDIR)$(ADA_RTL_OBJ_DIR)
+	-cd $(RTSDIR); for file in *$(arext);do \
+	    $(INSTALL_DATA) $$file $(DESTDIR)$(ADA_RTL_OBJ_DIR); \
+	    $(RANLIB_FOR_TARGET) $(DESTDIR)$(ADA_RTL_OBJ_DIR)/$$file; \
+	done
+	-$(foreach file, $(EXTRA_ADALIB_FILES), \
+	    $(INSTALL_DATA_DATE) $(RTSDIR)/$(file) $(DESTDIR)$(ADA_RTL_OBJ_DIR) && \
+	) true
+#     Install the shared libraries, if any, using $(INSTALL) instead
+#     of $(INSTALL_DATA). The latter may force a mode inappropriate
+#     for shared libraries on some targets, e.g. on HP-UX where the x
+#     permission is required.  We are win32 here.
+	for file in gnat gnarl; do \
+	   if [ -f $(RTSDIR)/$(LIBGNAT_SHARED_LIB_PREFIX)$${file}$(hyphen)$(LIBRARY_VERSION)$(soext) ]; then \
+	      $(INSTALL) $(RTSDIR)/$(LIBGNAT_SHARED_LIB_PREFIX)$${file}$(hyphen)$(LIBRARY_VERSION)$(soext) \
+			 $(DESTDIR)$(bindir); \
+	      $(LN_S) $(bindir)/$(LIBGNAT_SHARED_LIB_PREFIX)$${file}$(hyphen)$(LIBRARY_VERSION)$(soext) \
+	      $(DESTDIR)$(ADA_RTL_OBJ_DIR)/lib$${file}$(hyphen)$(LIBRARY_VERSION).dll.a; \
+	   fi; \
+	done
+# This copy must be done preserving the date on the original file.
+	for file in $(RTSDIR)/*.ad?; do \
+	    $(INSTALL_DATA_DATE) $$file $(DESTDIR)$(ADA_INCLUDE_DIR); \
+	done
+	cd $(DESTDIR)$(ADA_INCLUDE_DIR); $(CHMOD) a-wx *.adb
+	cd $(DESTDIR)$(ADA_INCLUDE_DIR); $(CHMOD) a-wx *.ads
+
 ../stamp-gnatlib2-$(RTSDIR):
 	$(RM) $(RTSDIR)/s-*.ali
 	$(RM) $(RTSDIR)/s-*$(objext)
@@ -2672,20 +2733,20 @@ gnatlib-shared-win32:
 	     MULTISUBDIR="$(MULTISUBDIR)" \
 	     THREAD_KIND="$(THREAD_KIND)" \
              gnatlib
-	$(RM) $(RTSDIR)/libgna*$(soext)
+	$(RM) $(RTSDIR)/$(LIBGNAT_SHARED_LIB_PREFIX)gna*$(soext)
 	cd $(RTSDIR); `echo "$(GCC_FOR_TARGET)" \
                 | sed -e 's,\./xgcc,../../xgcc,' -e 's,-B\./,-B../../,'` -shared -shared-libgcc \
 		$(PICFLAG_FOR_TARGET) \
-		-o libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) \
+		-o $(LIBGNAT_SHARED_LIB_PREFIX)gnat$(hyphen)$(LIBRARY_VERSION)$(soext) \
 		$(GNATRTL_NONTASKING_OBJS) $(LIBGNAT_OBJS) \
-		$(SO_OPTS)libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) $(MISCLIB)
+		$(SO_OPTS)$(LIBGNAT_SHARED_LIB_PREFIX)gnat$(hyphen)$(LIBRARY_VERSION)$(soext) $(MISCLIB)
 	cd $(RTSDIR); `echo "$(GCC_FOR_TARGET)" \
                 | sed -e 's,\./xgcc,../../xgcc,' -e 's,-B\./,-B../../,'` -shared -shared-libgcc \
 		$(PICFLAG_FOR_TARGET) \
-		-o libgnarl$(hyphen)$(LIBRARY_VERSION)$(soext) \
+		-o $(LIBGNAT_SHARED_LIB_PREFIX)gnarl$(hyphen)$(LIBRARY_VERSION)$(soext) \
 		$(GNATRTL_TASKING_OBJS) \
-		$(SO_OPTS)libgnarl$(hyphen)$(LIBRARY_VERSION)$(soext) \
-		$(THREADSLIB) -Wl,libgnat$(hyphen)$(LIBRARY_VERSION)$(soext)
+		$(SO_OPTS)$(LIBGNAT_SHARED_LIB_PREFIX)gnarl$(hyphen)$(LIBRARY_VERSION)$(soext) \
+		$(THREADSLIB) -Wl,$(LIBGNAT_SHARED_LIB_PREFIX)gnat$(hyphen)$(LIBRARY_VERSION)$(soext)
 
 gnatlib-shared-darwin:
 	$(MAKE) $(FLAGS_TO_PASS) \
--- origsrc/gcc-4.7.2/gcc/ada//gsocket.h	2012-11-02 15:16:49.781250000 +0000
+++ src/gcc-4.7.2/gcc/ada//gsocket.h	2012-11-01 21:17:31.000000000 +0000
@@ -204,7 +204,8 @@
 #endif
 
 #if defined (_AIX) || defined (__FreeBSD__) || defined (__hpux__) || \
-    defined (__osf__) || defined (_WIN32) || defined (__APPLE__)
+    defined (__osf__) || defined (_WIN32) || defined (__APPLE__) || \
+    defined (__CYGWIN__)
 # define HAVE_THREAD_SAFE_GETxxxBYyyy 1
 
 #elif defined (sgi) || defined (linux) || defined (__GLIBC__) || \
--- origsrc/gcc-4.7.2/gcc/ada//indepsw-cygwin.adb	1970-01-01 00:00:00.000000000 +0000
+++ src/gcc-4.7.2/gcc/ada//indepsw-cygwin.adb	2012-11-01 21:17:31.000000000 +0000
@@ -0,0 +1,67 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                              I N D E P S W                               --
+--                                                                          --
+--                                 B o d y                                  --
+--                            (Windows version)                             --
+--                                                                          --
+--            Copyright (C) 2009 Free Software Foundation, Inc.             --
+--                                                                          --
+-- 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 3,  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.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This is the Windows version
+
+package body Indepsw is
+
+   Map_Switch : aliased constant String := "-Wl,-Map,";
+
+   -------------
+   -- Convert --
+   -------------
+
+   procedure Convert
+     (Switch   : Switch_Kind;
+      Argument : String;
+      To       : out String_List_Access)
+   is
+   begin
+      case Switch is
+         when Map_File =>
+            To := new Argument_List'(1 => new String'(Map_Switch & Argument));
+      end case;
+   end Convert;
+
+   ------------------
+   -- Is_Supported --
+   ------------------
+
+   function Is_Supported (Switch : Switch_Kind) return Boolean is
+   begin
+      case Switch is
+         when Map_File =>
+            return True;
+      end case;
+   end Is_Supported;
+
+end Indepsw;
--- origsrc/gcc-4.7.2/gcc/ada//initialize.c	2012-11-02 15:16:50.031250000 +0000
+++ src/gcc-4.7.2/gcc/ada//initialize.c	2012-11-01 21:17:31.000000000 +0000
@@ -348,6 +348,40 @@ __gnat_initialize (void *eh ATTRIBUTE_UN
   __main ();
 }
 
+#elif defined (__CYGWIN__)
+
+/***************************************/
+/* __gnat_initialize (Cygwin Version) */
+/***************************************/
+
+extern void __main (void);
+
+void
+__gnat_initialize (void *eh ATTRIBUTE_UNUSED)
+{
+#ifdef IN_RTS
+  /* We must call __main to run the static ctors, or DW2 EH, amongst
+     other things, will fail.  */
+  __main ();
+#endif
+   /* Initialize floating-point coprocessor. This call is needed because
+      the MS libraries default to 64-bit precision instead of 80-bit
+      precision, and we require the full precision for proper operation,
+      given that we have set Max_Digits etc with this in mind */
+   __gnat_init_float ();
+
+   /* Note that we do not activate this for the compiler itself to avoid a
+      bootstrap path problem.  Older version of gnatbind will generate a call
+      to __gnat_initialize() without argument. Therefore we cannot use eh in
+      this case.  It will be possible to remove the following #ifdef at some
+      point.  */
+#ifdef IN_RTS
+   /* Install the Structured Exception handler.  */
+   if (eh)
+     __gnat_install_SEH_handler (eh);
+#endif
+}
+
 #else
 
 /* For all other versions of GNAT, the initialize routine and handler
--- origsrc/gcc-4.7.2/gcc/ada//mlib-tgt-specific-cygwin.adb	1970-01-01 00:00:00.000000000 +0000
+++ src/gcc-4.7.2/gcc/ada//mlib-tgt-specific-cygwin.adb	2012-11-01 21:17:31.000000000 +0000
@@ -0,0 +1,162 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                    M L I B . T G T . S P E C I F I C                     --
+--                            (Cygwin  Version)                             --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--          Copyright (C) 2002-2010, Free Software Foundation, Inc.         --
+--                                                                          --
+-- 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 3,  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 COPYING3.  If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the 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 Windows version of the body. Works only with GCC versions
+--  supporting the "-shared" option.
+
+with Opt;
+with Output; use Output;
+
+with MLib.Fil;
+with MLib.Utl;
+
+package body MLib.Tgt.Specific is
+
+   package Files renames MLib.Fil;
+   package Tools renames MLib.Utl;
+
+   --  Non default subprograms
+
+   procedure Build_Dynamic_Library
+     (Ofiles       : Argument_List;
+      Options      : Argument_List;
+      Interfaces   : Argument_List;
+      Lib_Filename : String;
+      Lib_Dir      : String;
+      Symbol_Data  : Symbol_Record;
+      Driver_Name  : Name_Id := No_Name;
+      Lib_Version  : String  := "";
+      Auto_Init    : Boolean := False);
+
+   function DLL_Ext return String;
+
+   function DLL_Prefix return String;
+
+   function Is_Archive_Ext (Ext : String) return Boolean;
+
+   function Library_Major_Minor_Id_Supported return Boolean;
+
+   function PIC_Option return String;
+
+   Shared_Libgcc : aliased String := "-shared-libgcc";
+
+   Shared_Libgcc_Switch : constant Argument_List :=
+                            (1 => Shared_Libgcc'Access);
+
+   ---------------------------
+   -- Build_Dynamic_Library --
+   ---------------------------
+
+   procedure Build_Dynamic_Library
+     (Ofiles       : Argument_List;
+      Options      : Argument_List;
+      Interfaces   : Argument_List;
+      Lib_Filename : String;
+      Lib_Dir      : String;
+      Symbol_Data  : Symbol_Record;
+      Driver_Name  : Name_Id := No_Name;
+      Lib_Version  : String  := "";
+      Auto_Init    : Boolean := False)
+   is
+      pragma Unreferenced (Symbol_Data);
+      pragma Unreferenced (Interfaces);
+      pragma Unreferenced (Lib_Version);
+      pragma Unreferenced (Auto_Init);
+
+      Lib_File : constant String :=
+                   Lib_Dir & Directory_Separator &
+                   DLL_Prefix & Files.Append_To (Lib_Filename, DLL_Ext);
+
+   --  Start of processing for Build_Dynamic_Library
+
+   begin
+      if Opt.Verbose_Mode then
+         Write_Str ("building relocatable shared library ");
+         Write_Line (Lib_File);
+      end if;
+
+      Tools.Gcc
+        (Output_File => Lib_File,
+         Objects     => Ofiles,
+         Options     => Shared_Libgcc_Switch,
+         Options_2   => Options,
+         Driver_Name => Driver_Name);
+   end Build_Dynamic_Library;
+
+   -------------
+   -- DLL_Ext --
+   -------------
+
+   function DLL_Ext return String is
+   begin
+      return "dll";
+   end DLL_Ext;
+
+   ----------------
+   -- DLL_Prefix --
+   ----------------
+
+   function DLL_Prefix return String is
+   begin
+      return "cyg";
+   end DLL_Prefix;
+
+   --------------------
+   -- Is_Archive_Ext --
+   --------------------
+
+   function Is_Archive_Ext (Ext : String) return Boolean is
+   begin
+      return Ext = ".a" or else Ext = ".dll";
+   end Is_Archive_Ext;
+
+   --------------------------------------
+   -- Library_Major_Minor_Id_Supported --
+   --------------------------------------
+
+   function Library_Major_Minor_Id_Supported return Boolean is
+   begin
+      return False;
+   end Library_Major_Minor_Id_Supported;
+
+   ----------------
+   -- PIC_Option --
+   ----------------
+
+   function PIC_Option return String is
+   begin
+      return "";
+   end PIC_Option;
+
+begin
+   Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access;
+   DLL_Ext_Ptr               := DLL_Ext'Access;
+   DLL_Prefix_Ptr            := DLL_Prefix'Access;
+   Is_Archive_Ext_Ptr        := Is_Archive_Ext'Access;
+   PIC_Option_Ptr            := PIC_Option'Access;
+   Library_Major_Minor_Id_Supported_Ptr :=
+                                Library_Major_Minor_Id_Supported'Access;
+end MLib.Tgt.Specific;
--- origsrc/gcc-4.7.2/gcc/ada//s-gloloc-cygwin.adb	1970-01-01 00:00:00.000000000 +0000
+++ src/gcc-4.7.2/gcc/ada//s-gloloc-cygwin.adb	2012-11-01 21:17:31.000000000 +0000
@@ -0,0 +1,107 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                  S Y S T E M . G L O B A L _ L O C K S                   --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                     Copyright (C) 1999-2010, 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 3,  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.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This implementation is specific to NT
+
+with System.OS_Interface;
+with System.Task_Lock;
+with System.Win32;
+
+with Interfaces.C.Strings;
+
+package body System.Global_Locks is
+
+   package TSL renames System.Task_Lock;
+   package OSI renames System.OS_Interface;
+   package ICS renames Interfaces.C.Strings;
+
+   subtype Lock_File_Entry is Win32.HANDLE;
+
+   Last_Lock  : Lock_Type := Null_Lock;
+   Lock_Table : array (Lock_Type range 1 .. 15) of Lock_File_Entry;
+
+   -----------------
+   -- Create_Lock --
+   -----------------
+
+   procedure Create_Lock (Lock : out Lock_Type; Name : String) is
+      L : Lock_Type;
+
+   begin
+      TSL.Lock;
+      Last_Lock := Last_Lock + 1;
+      L := Last_Lock;
+      TSL.Unlock;
+
+      if L > Lock_Table'Last then
+         raise Lock_Error;
+      end if;
+
+      Lock_Table (L) :=
+        OSI.CreateMutex (null, Win32.FALSE, ICS.New_String (Name));
+      Lock := L;
+   end Create_Lock;
+
+   ------------------
+   -- Acquire_Lock --
+   ------------------
+
+   procedure Acquire_Lock (Lock : in out Lock_Type) is
+      use type Win32.DWORD;
+
+      Res : Win32.DWORD;
+
+   begin
+      Res := OSI.WaitForSingleObject (Lock_Table (Lock), OSI.Wait_Infinite);
+
+      if Res = OSI.WAIT_FAILED then
+         raise Lock_Error;
+      end if;
+   end Acquire_Lock;
+
+   ------------------
+   -- Release_Lock --
+   ------------------
+
+   procedure Release_Lock (Lock : in out Lock_Type) is
+      use type Win32.BOOL;
+
+      Res : Win32.BOOL;
+
+   begin
+      Res := OSI.ReleaseMutex (Lock_Table (Lock));
+
+      if Res = Win32.FALSE then
+         raise Lock_Error;
+      end if;
+   end Release_Lock;
+
+end System.Global_Locks;
--- origsrc/gcc-4.7.2/gcc/ada//s-osinte-cygwin.ads	1970-01-01 00:00:00.000000000 +0000
+++ src/gcc-4.7.2/gcc/ada//s-osinte-cygwin.ads	2012-11-01 21:17:31.000000000 +0000
@@ -0,0 +1,951 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
+--                                                                          --
+--                   S Y S T E M . O S _ I N T E R F A C E                  --
+--                                                                          --
+--                                  S p e c                                 --
+--                                                                          --
+--             Copyright (C) 1991-1994, Florida State University            --
+--          Copyright (C) 1995-2010, Free Software Foundation, Inc.         --
+--                                                                          --
+-- 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 3,  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.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNARL was developed by the GNARL team at Florida State University.       --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This is a GNU/Linux (GNU/LinuxThreads) version of this package
+
+--  This package encapsulates all direct interfaces to OS services
+--  that are needed by children of System.
+
+--  PLEASE DO NOT add any with-clauses to this package or remove the pragma
+--  Preelaborate. This package is designed to be a bottom-level (leaf) package.
+
+with Interfaces.C;
+with Interfaces.C.Strings;
+with Ada.Unchecked_Conversion;
+
+package System.OS_Interface is
+   pragma Preelaborate;
+
+   subtype int            is Interfaces.C.int;
+   subtype char           is Interfaces.C.char;
+   subtype short          is Interfaces.C.short;
+   subtype long           is Interfaces.C.long;
+   subtype unsigned       is Interfaces.C.unsigned;
+   subtype unsigned_short is Interfaces.C.unsigned_short;
+   subtype unsigned_long  is Interfaces.C.unsigned_long;
+   subtype unsigned_char  is Interfaces.C.unsigned_char;
+   subtype plain_char     is Interfaces.C.plain_char;
+   subtype size_t         is Interfaces.C.size_t;
+
+   -----------
+   -- Errno --
+   -----------
+
+   function errno return int;
+   pragma Import (C, errno, "__get_errno");
+
+   EAGAIN    : constant := 11;
+   EINTR     : constant := 4;
+   EINVAL    : constant := 22;
+   ENOMEM    : constant := 12;
+   EPERM     : constant := 1;
+   ETIMEDOUT : constant := 110;
+
+   -------------
+   -- Signals --
+   -------------
+
+   Max_Interrupt : constant := 63;
+   type Signal is new int range 0 .. Max_Interrupt;
+   for Signal'Size use int'Size;
+
+   SIGHUP     : constant := 1; --  hangup
+   SIGINT     : constant := 2; --  interrupt (rubout)
+   SIGQUIT    : constant := 3; --  quit (ASCD FS)
+   SIGILL     : constant := 4; --  illegal instruction (not reset)
+   SIGTRAP    : constant := 5; --  trace trap (not reset)
+   SIGIOT     : constant := 6; --  IOT instruction
+   SIGABRT    : constant := 6; --  used by abort, replace SIGIOT in the  future
+   SIGFPE     : constant := 8; --  floating point exception
+   SIGKILL    : constant := 9; --  kill (cannot be caught or ignored)
+   SIGBUS     : constant := 7; --  bus error
+   SIGSEGV    : constant := 11; --  segmentation violation
+   SIGPIPE    : constant := 13; --  write on a pipe with no one to read it
+   SIGALRM    : constant := 14; --  alarm clock
+   SIGTERM    : constant := 15; --  software termination signal from kill
+   SIGUSR1    : constant := 10; --  user defined signal 1
+   SIGUSR2    : constant := 12; --  user defined signal 2
+   SIGCLD     : constant := 17; --  alias for SIGCHLD
+   SIGCHLD    : constant := 17; --  child status change
+   SIGPWR     : constant := 30; --  power-fail restart
+   SIGWINCH   : constant := 28; --  window size change
+   SIGURG     : constant := 23; --  urgent condition on IO channel
+   SIGPOLL    : constant := 29; --  pollable event occurred
+   SIGIO      : constant := 29; --  I/O now possible (4.2 BSD)
+   SIGLOST    : constant := 29; --  File lock lost
+   SIGSTOP    : constant := 19; --  stop (cannot be caught or ignored)
+   SIGTSTP    : constant := 20; --  user stop requested from tty
+   SIGCONT    : constant := 18; --  stopped process has been continued
+   SIGTTIN    : constant := 21; --  background tty read attempted
+   SIGTTOU    : constant := 22; --  background tty write attempted
+   SIGVTALRM  : constant := 26; --  virtual timer expired
+   SIGPROF    : constant := 27; --  profiling timer expired
+   SIGXCPU    : constant := 24; --  CPU time limit exceeded
+   SIGXFSZ    : constant := 25; --  filesize limit exceeded
+   SIGUNUSED  : constant := 31; --  unused signal (GNU/Linux)
+   SIGSTKFLT  : constant := 16; --  coprocessor stack fault (Linux)
+   SIGLTHRRES : constant := 32; --  GNU/LinuxThreads restart signal
+   SIGLTHRCAN : constant := 33; --  GNU/LinuxThreads cancel signal
+   SIGLTHRDBG : constant := 34; --  GNU/LinuxThreads debugger signal
+
+   SIGADAABORT : constant := SIGABRT;
+   --  Change this if you want to use another signal for task abort.
+   --  SIGTERM might be a good one.
+
+   type Signal_Set is array (Natural range <>) of Signal;
+
+   Unmasked : constant Signal_Set := (
+      SIGTRAP,
+      --  To enable debugging on multithreaded applications, mark SIGTRAP to
+      --  be kept unmasked.
+
+      SIGBUS,
+
+      SIGTTIN, SIGTTOU, SIGTSTP,
+      --  Keep these three signals unmasked so that background processes
+      --  and IO behaves as normal "C" applications
+
+      SIGPROF,
+      --  To avoid confusing the profiler
+
+      SIGKILL, SIGSTOP,
+      --  These two signals actually cannot be masked;
+      --  POSIX simply won't allow it.
+
+      SIGLTHRRES, SIGLTHRCAN, SIGLTHRDBG);
+      --  These three signals are used by GNU/LinuxThreads starting from
+      --  glibc 2.1 (future 2.2).
+
+   Reserved    : constant Signal_Set :=
+   --  I am not sure why the following two signals are reserved.
+   --  I guess they are not supported by this version of GNU/Linux.
+     (SIGVTALRM, SIGUNUSED);
+
+   type sigset_t is private;
+
+   function sigaddset (set : access sigset_t; sig : Signal) return int;
+   pragma Import (C, sigaddset, "sigaddset");
+
+   function sigdelset (set : access sigset_t; sig : Signal) return int;
+   pragma Import (C, sigdelset, "sigdelset");
+
+   function sigfillset (set : access sigset_t) return int;
+   pragma Import (C, sigfillset, "sigfillset");
+
+   function sigismember (set : access sigset_t; sig : Signal) return int;
+   pragma Import (C, sigismember, "sigismember");
+
+   function sigemptyset (set : access sigset_t) return int;
+   pragma Import (C, sigemptyset, "sigemptyset");
+
+   type union_type_3 is new String (1 .. 116);
+   type siginfo_t is record
+      si_signo : int;
+      si_code  : int;
+      si_errno : int;
+      X_data   : union_type_3;
+   end record;
+   pragma Convention (C, siginfo_t);
+
+   type struct_sigaction is record
+      sa_handler  : System.Address;
+      sa_mask     : sigset_t;
+      sa_flags    : unsigned_long;
+      sa_restorer : System.Address;
+   end record;
+   pragma Convention (C, struct_sigaction);
+
+   type struct_sigaction_ptr is access all struct_sigaction;
+
+   type Machine_State is record
+      eip : unsigned_long;
+      ebx : unsigned_long;
+      esp : unsigned_long;
+      ebp : unsigned_long;
+      esi : unsigned_long;
+      edi : unsigned_long;
+   end record;
+   type Machine_State_Ptr is access all Machine_State;
+
+   SA_SIGINFO  : constant := 16#04#;
+
+   SIG_BLOCK   : constant := 0;
+   SIG_UNBLOCK : constant := 1;
+   SIG_SETMASK : constant := 2;
+
+   SIG_DFL : constant := 0;
+   SIG_IGN : constant := 1;
+
+   function sigaction
+     (sig  : Signal;
+      act  : struct_sigaction_ptr;
+      oact : struct_sigaction_ptr) return int;
+   pragma Import (C, sigaction, "sigaction");
+
+   ----------
+   -- Time --
+   ----------
+
+   type timespec is private;
+
+   function To_Duration (TS : timespec) return Duration;
+   pragma Inline (To_Duration);
+
+   function To_Timespec (D : Duration) return timespec;
+   pragma Inline (To_Timespec);
+
+   type struct_timeval is private;
+
+   function To_Duration (TV : struct_timeval) return Duration;
+   pragma Inline (To_Duration);
+
+   function To_Timeval (D : Duration) return struct_timeval;
+   pragma Inline (To_Timeval);
+
+   function gettimeofday
+     (tv : access struct_timeval;
+      tz : System.Address := System.Null_Address) return int;
+   pragma Import (C, gettimeofday, "gettimeofday");
+
+   function sysconf (name : int) return long;
+   pragma Import (C, sysconf);
+
+   SC_CLK_TCK          : constant := 2;
+   SC_NPROCESSORS_ONLN : constant := 84;
+
+   -------------------------
+   -- Priority Scheduling --
+   -------------------------
+
+   SCHED_OTHER : constant := 0;
+   SCHED_FIFO  : constant := 1;
+   SCHED_RR    : constant := 2;
+
+   function To_Target_Priority
+     (Prio : System.Any_Priority) return Interfaces.C.int;
+   --  Maps System.Any_Priority to a POSIX priority
+
+   -------------
+   -- Process --
+   -------------
+
+   type pid_t is private;
+
+   function kill (pid : pid_t; sig : Signal) return int;
+   pragma Import (C, kill, "kill");
+
+   function getpid return pid_t;
+   pragma Import (C, getpid, "getpid");
+
+   -------------
+   -- Threads --
+   -------------
+
+   type Thread_Body is access
+     function (arg : System.Address) return System.Address;
+   pragma Convention (C, Thread_Body);
+
+   function Thread_Body_Access is new
+     Ada.Unchecked_Conversion (System.Address, Thread_Body);
+
+   type pthread_t is new unsigned_long;
+   subtype Thread_Id is pthread_t;
+
+   function To_pthread_t is
+     new Ada.Unchecked_Conversion (unsigned_long, pthread_t);
+
+   type pthread_mutex_t      is limited private;
+   type pthread_cond_t       is limited private;
+   type pthread_attr_t       is limited private;
+   type pthread_mutexattr_t  is limited private;
+   type pthread_condattr_t   is limited private;
+   type pthread_key_t        is private;
+
+   PTHREAD_CREATE_DETACHED : constant := 1;
+
+   -----------
+   -- Stack --
+   -----------
+
+   function Get_Stack_Base (thread : pthread_t) return Address;
+   pragma Inline (Get_Stack_Base);
+   --  This is a dummy procedure to share some GNULLI files
+
+   ---------------------------------------
+   -- Nonstandard Thread Initialization --
+   ---------------------------------------
+
+   procedure pthread_init;
+   pragma Inline (pthread_init);
+   --  This is a dummy procedure to share some GNULLI files
+
+   -------------------------
+   -- POSIX.1c  Section 3 --
+   -------------------------
+
+   function sigwait (set : access sigset_t; sig : access Signal) return int;
+   pragma Import (C, sigwait, "sigwait");
+
+   function pthread_kill (thread : pthread_t; sig : Signal) return int;
+   pragma Import (C, pthread_kill, "pthread_kill");
+
+   function pthread_sigmask
+     (how  : int;
+      set  : access sigset_t;
+      oset : access sigset_t) return int;
+   pragma Import (C, pthread_sigmask, "pthread_sigmask");
+
+   --------------------------
+   -- POSIX.1c  Section 11 --
+   --------------------------
+
+   function pthread_mutexattr_init
+     (attr : access pthread_mutexattr_t) return int;
+   pragma Import (C, pthread_mutexattr_init, "pthread_mutexattr_init");
+
+   function pthread_mutexattr_destroy
+     (attr : access pthread_mutexattr_t) return int;
+   pragma Import (C, pthread_mutexattr_destroy, "pthread_mutexattr_destroy");
+
+   function pthread_mutex_init
+     (mutex : access pthread_mutex_t;
+      attr  : access pthread_mutexattr_t) return int;
+   pragma Import (C, pthread_mutex_init, "pthread_mutex_init");
+
+   function pthread_mutex_destroy (mutex : access pthread_mutex_t) return int;
+   pragma Import (C, pthread_mutex_destroy, "pthread_mutex_destroy");
+
+   function pthread_mutex_lock (mutex : access pthread_mutex_t) return int;
+   pragma Import (C, pthread_mutex_lock, "pthread_mutex_lock");
+
+   function pthread_mutex_unlock (mutex : access pthread_mutex_t) return int;
+   pragma Import (C, pthread_mutex_unlock, "pthread_mutex_unlock");
+
+   function pthread_condattr_init
+     (attr : access pthread_condattr_t) return int;
+   pragma Import (C, pthread_condattr_init, "pthread_condattr_init");
+
+   function pthread_condattr_destroy
+     (attr : access pthread_condattr_t) return int;
+   pragma Import (C, pthread_condattr_destroy, "pthread_condattr_destroy");
+
+   function pthread_cond_init
+     (cond : access pthread_cond_t;
+      attr : access pthread_condattr_t) return int;
+   pragma Import (C, pthread_cond_init, "pthread_cond_init");
+
+   function pthread_cond_destroy (cond : access pthread_cond_t) return int;
+   pragma Import (C, pthread_cond_destroy, "pthread_cond_destroy");
+
+   function pthread_cond_signal (cond : access pthread_cond_t) return int;
+   pragma Import (C, pthread_cond_signal, "pthread_cond_signal");
+
+   function pthread_cond_wait
+     (cond  : access pthread_cond_t;
+      mutex : access pthread_mutex_t) return int;
+   pragma Import (C, pthread_cond_wait, "pthread_cond_wait");
+
+   function pthread_cond_timedwait
+     (cond    : access pthread_cond_t;
+      mutex   : access pthread_mutex_t;
+      abstime : access timespec) return int;
+   pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
+
+   --------------------------
+   -- POSIX.1c  Section 13 --
+   --------------------------
+
+   type struct_sched_param is record
+      sched_priority : int;  --  scheduling priority
+   end record;
+   pragma Convention (C, struct_sched_param);
+
+   function pthread_setschedparam
+     (thread : pthread_t;
+      policy : int;
+      param  : access struct_sched_param) return int;
+   pragma Import (C, pthread_setschedparam, "pthread_setschedparam");
+
+   function pthread_attr_setschedpolicy
+     (attr   : access pthread_attr_t;
+      policy : int) return int;
+   pragma Import
+     (C, pthread_attr_setschedpolicy, "pthread_attr_setschedpolicy");
+
+   function sched_yield return int;
+   pragma Import (C, sched_yield, "sched_yield");
+
+   ---------------------------
+   -- P1003.1c - Section 16 --
+   ---------------------------
+
+   function pthread_attr_init
+     (attributes : access pthread_attr_t) return int;
+   pragma Import (C, pthread_attr_init, "pthread_attr_init");
+
+   function pthread_attr_destroy
+     (attributes : access pthread_attr_t) return int;
+   pragma Import (C, pthread_attr_destroy, "pthread_attr_destroy");
+
+   function pthread_attr_setdetachstate
+     (attr        : access pthread_attr_t;
+      detachstate : int) return int;
+   pragma Import
+     (C, pthread_attr_setdetachstate, "pthread_attr_setdetachstate");
+
+   function pthread_attr_setstacksize
+     (attr      : access pthread_attr_t;
+      stacksize : size_t) return int;
+   pragma Import (C, pthread_attr_setstacksize, "pthread_attr_setstacksize");
+
+   function pthread_create
+     (thread        : access pthread_t;
+      attributes    : access pthread_attr_t;
+      start_routine : Thread_Body;
+      arg           : System.Address) return int;
+   pragma Import (C, pthread_create, "pthread_create");
+
+   procedure pthread_exit (status : System.Address);
+   pragma Import (C, pthread_exit, "pthread_exit");
+
+   function pthread_self return pthread_t;
+   pragma Import (C, pthread_self, "pthread_self");
+
+   --------------------------
+   -- POSIX.1c  Section 17 --
+   --------------------------
+
+   function pthread_setspecific
+     (key   : pthread_key_t;
+      value : System.Address) return int;
+   pragma Import (C, pthread_setspecific, "pthread_setspecific");
+
+   function pthread_getspecific (key : pthread_key_t) return System.Address;
+   pragma Import (C, pthread_getspecific, "pthread_getspecific");
+
+   type destructor_pointer is access procedure (arg : System.Address);
+   pragma Convention (C, destructor_pointer);
+
+   function pthread_key_create
+     (key        : access pthread_key_t;
+      destructor : destructor_pointer) return int;
+   pragma Import (C, pthread_key_create, "pthread_key_create");
+
+   CPU_SETSIZE : constant := 1_024;
+
+   type bit_field is array (1 .. CPU_SETSIZE) of Boolean;
+   for bit_field'Size use CPU_SETSIZE;
+   pragma Pack (bit_field);
+   pragma Convention (C, bit_field);
+
+   type cpu_set_t is record
+      bits : bit_field;
+   end record;
+   pragma Convention (C, cpu_set_t);
+
+   function pthread_setaffinity_np
+     (thread     : pthread_t;
+      cpusetsize : size_t;
+      cpuset     : access cpu_set_t) return int;
+   pragma Import (C, pthread_setaffinity_np, "__gnat_pthread_setaffinity_np");
+
+   -------------------
+   -- Win32 compat  --
+   -------------------
+
+   -------------------
+   -- General Types --
+   -------------------
+
+   type DWORD is new Interfaces.C.unsigned_long;
+   type WORD  is new Interfaces.C.unsigned_short;
+
+   --  The LARGE_INTEGER type is actually a fixed point type
+   --  that only can represent integers. The reason for this is
+   --  easier conversion to Duration or other fixed point types.
+   --  (See Operations.Clock)
+
+   type LARGE_INTEGER is delta 1.0 range -2.0**63 .. 2.0**63 - 1.0;
+
+   subtype PSZ   is Interfaces.C.Strings.chars_ptr;
+   subtype PCHAR is Interfaces.C.Strings.chars_ptr;
+
+   subtype PVOID is System.Address;
+
+   Null_Void : constant PVOID := System.Null_Address;
+
+   type PLONG  is access all Interfaces.C.long;
+   type PDWORD is access all DWORD;
+
+   type BOOL is new Boolean;
+   for BOOL'Size use Interfaces.C.unsigned_long'Size;
+
+   -------------------------
+   -- Handles for objects --
+   -------------------------
+
+   type HANDLE is new Interfaces.C.long;
+   type PHANDLE is access all HANDLE;
+
+   subtype Win32_Thread_Id is HANDLE;
+
+   ------------------------
+   -- System Information --
+   ------------------------
+
+   type SYSTEM_INFO is record
+      dwOemId                     : DWORD;
+      dwPageSize                  : DWORD;
+      lpMinimumApplicationAddress : PVOID;
+      lpMaximumApplicationAddress : PVOID;
+      dwActiveProcessorMask       : DWORD;
+      dwNumberOfProcessors        : DWORD;
+      dwProcessorType             : DWORD;
+      dwAllocationGranularity     : DWORD;
+      dwReserved                  : DWORD;
+   end record;
+
+   procedure GetSystemInfo (SI : access SYSTEM_INFO);
+   pragma Import (Stdcall, GetSystemInfo, "GetSystemInfo");
+
+   ---------------------
+   -- Time Management --
+   ---------------------
+
+   procedure Sleep (dwMilliseconds : DWORD);
+   pragma Import (Stdcall, Sleep, External_Name => "Sleep");
+
+   type SYSTEMTIME is record
+      wYear         : WORD;
+      wMonth        : WORD;
+      wDayOfWeek    : WORD;
+      wDay          : WORD;
+      wHour         : WORD;
+      wMinute       : WORD;
+      wSecond       : WORD;
+      wMilliseconds : WORD;
+   end record;
+
+   procedure GetSystemTime (pSystemTime : access SYSTEMTIME);
+   pragma Import (Stdcall, GetSystemTime, "GetSystemTime");
+
+   procedure GetSystemTimeAsFileTime (lpFileTime : access Long_Long_Integer);
+   pragma Import (Stdcall, GetSystemTimeAsFileTime, "GetSystemTimeAsFileTime");
+
+   function SetSystemTime (pSystemTime : access SYSTEMTIME) return BOOL;
+   pragma Import (Stdcall, SetSystemTime, "SetSystemTime");
+
+   function FileTimeToSystemTime
+     (lpFileTime   : access Long_Long_Integer;
+      lpSystemTime : access SYSTEMTIME) return BOOL;
+   pragma Import (Stdcall, FileTimeToSystemTime, "FileTimeToSystemTime");
+
+   function SystemTimeToFileTime
+     (lpSystemTime : access SYSTEMTIME;
+      lpFileTime   : access Long_Long_Integer) return BOOL;
+   pragma Import (Stdcall, SystemTimeToFileTime, "SystemTimeToFileTime");
+
+   function FileTimeToLocalFileTime
+     (lpFileTime      : access Long_Long_Integer;
+      lpLocalFileTime : access Long_Long_Integer) return BOOL;
+   pragma Import (Stdcall, FileTimeToLocalFileTime, "FileTimeToLocalFileTime");
+
+   function LocalFileTimeToFileTime
+     (lpFileTime      : access Long_Long_Integer;
+      lpLocalFileTime : access Long_Long_Integer) return BOOL;
+   pragma Import (Stdcall, LocalFileTimeToFileTime, "LocalFileTimeToFileTime");
+
+   function QueryPerformanceCounter
+     (lpPerformanceCount : access LARGE_INTEGER) return BOOL;
+   pragma Import
+     (Stdcall, QueryPerformanceCounter, "QueryPerformanceCounter");
+
+   function QueryPerformanceFrequency
+     (lpFrequency : access LARGE_INTEGER) return BOOL;
+   pragma Import
+     (Stdcall, QueryPerformanceFrequency, "QueryPerformanceFrequency");
+
+   -------------
+   -- Threads --
+   -------------
+
+--   type Win32_Thread_Body is access
+--     function (arg : System.Address) return System.Address;
+--   pragma Convention (C, Thread_Body);
+
+--   function Win32_Thread_Body_Access is new
+--     Ada.Unchecked_Conversion (System.Address, Thread_Body);
+
+   procedure SwitchToThread;
+   pragma Import (Stdcall, SwitchToThread, "SwitchToThread");
+
+   function GetThreadTimes
+     (hThread        : HANDLE;
+      lpCreationTime : access Long_Long_Integer;
+      lpExitTime     : access Long_Long_Integer;
+      lpKernelTime   : access Long_Long_Integer;
+      lpUserTime     : access Long_Long_Integer) return BOOL;
+   pragma Import (Stdcall, GetThreadTimes, "GetThreadTimes");
+
+   -----------------------
+   -- Critical sections --
+   -----------------------
+
+   type CRITICAL_SECTION is private;
+
+   procedure InitializeCriticalSection
+     (pCriticalSection : access CRITICAL_SECTION);
+   pragma Import
+     (Stdcall, InitializeCriticalSection, "InitializeCriticalSection");
+
+   procedure EnterCriticalSection
+     (pCriticalSection : access CRITICAL_SECTION);
+   pragma Import (Stdcall, EnterCriticalSection, "EnterCriticalSection");
+
+   procedure LeaveCriticalSection
+     (pCriticalSection : access CRITICAL_SECTION);
+   pragma Import (Stdcall, LeaveCriticalSection, "LeaveCriticalSection");
+
+   procedure DeleteCriticalSection
+     (pCriticalSection : access CRITICAL_SECTION);
+   pragma Import (Stdcall, DeleteCriticalSection, "DeleteCriticalSection");
+
+   -------------------------------------------------------------
+   -- Thread Creation, Activation, Suspension And Termination --
+   -------------------------------------------------------------
+
+   subtype ProcessorId is DWORD;
+
+   type PTHREAD_START_ROUTINE is access function
+     (pThreadParameter : PVOID) return DWORD;
+   pragma Convention (Stdcall, PTHREAD_START_ROUTINE);
+
+   function To_PTHREAD_START_ROUTINE is new
+     Ada.Unchecked_Conversion (System.Address, PTHREAD_START_ROUTINE);
+
+   type SECURITY_ATTRIBUTES is record
+      nLength              : DWORD;
+      pSecurityDescriptor  : PVOID;
+      bInheritHandle       : BOOL;
+   end record;
+
+   type PSECURITY_ATTRIBUTES is access all SECURITY_ATTRIBUTES;
+
+   function CreateThread
+     (pThreadAttributes    : PSECURITY_ATTRIBUTES;
+      dwStackSize          : DWORD;
+      pStartAddress        : PTHREAD_START_ROUTINE;
+      pParameter           : PVOID;
+      dwCreationFlags      : DWORD;
+      pThreadId            : PDWORD) return HANDLE;
+   pragma Import (Stdcall, CreateThread, "CreateThread");
+
+   function BeginThreadEx
+     (pThreadAttributes    : PSECURITY_ATTRIBUTES;
+      dwStackSize          : DWORD;
+      pStartAddress        : PTHREAD_START_ROUTINE;
+      pParameter           : PVOID;
+      dwCreationFlags      : DWORD;
+      pThreadId            : PDWORD) return HANDLE;
+   pragma Import (C, BeginThreadEx, "_beginthreadex");
+
+   Debug_Process                     : constant := 16#00000001#;
+   Debug_Only_This_Process           : constant := 16#00000002#;
+   Create_Suspended                  : constant := 16#00000004#;
+   Detached_Process                  : constant := 16#00000008#;
+   Create_New_Console                : constant := 16#00000010#;
+
+   Create_New_Process_Group          : constant := 16#00000200#;
+
+   Create_No_window                  : constant := 16#08000000#;
+
+   Profile_User                      : constant := 16#10000000#;
+   Profile_Kernel                    : constant := 16#20000000#;
+   Profile_Server                    : constant := 16#40000000#;
+
+   Stack_Size_Param_Is_A_Reservation : constant := 16#00010000#;
+
+   function GetExitCodeThread
+     (hThread   : HANDLE;
+      pExitCode : PDWORD) return BOOL;
+   pragma Import (Stdcall, GetExitCodeThread, "GetExitCodeThread");
+
+   function ResumeThread (hThread : HANDLE) return DWORD;
+   pragma Import (Stdcall, ResumeThread, "ResumeThread");
+
+   function SuspendThread (hThread : HANDLE) return DWORD;
+   pragma Import (Stdcall, SuspendThread, "SuspendThread");
+
+   procedure ExitThread (dwExitCode : DWORD);
+   pragma Import (Stdcall, ExitThread, "ExitThread");
+
+   procedure EndThreadEx (dwExitCode : DWORD);
+   pragma Import (C, EndThreadEx, "_endthreadex");
+
+   function TerminateThread
+     (hThread    : HANDLE;
+      dwExitCode : DWORD) return BOOL;
+   pragma Import (Stdcall, TerminateThread, "TerminateThread");
+
+   function GetCurrentThread return HANDLE;
+   pragma Import (Stdcall, GetCurrentThread, "GetCurrentThread");
+
+   function GetCurrentProcess return HANDLE;
+   pragma Import (Stdcall, GetCurrentProcess, "GetCurrentProcess");
+
+   function GetCurrentThreadId return DWORD;
+   pragma Import (Stdcall, GetCurrentThreadId, "GetCurrentThreadId");
+
+   function TlsAlloc return DWORD;
+   pragma Import (Stdcall, TlsAlloc, "TlsAlloc");
+
+   function TlsGetValue (dwTlsIndex : DWORD) return PVOID;
+   pragma Import (Stdcall, TlsGetValue, "TlsGetValue");
+
+   function TlsSetValue (dwTlsIndex : DWORD; pTlsValue : PVOID) return BOOL;
+   pragma Import (Stdcall, TlsSetValue, "TlsSetValue");
+
+   function TlsFree (dwTlsIndex : DWORD) return BOOL;
+   pragma Import (Stdcall, TlsFree, "TlsFree");
+
+   TLS_Nothing : constant := DWORD'Last;
+
+   procedure ExitProcess (uExitCode : Interfaces.C.unsigned);
+   pragma Import (Stdcall, ExitProcess, "ExitProcess");
+
+   function WaitForSingleObject
+     (hHandle        : HANDLE;
+      dwMilliseconds : DWORD) return DWORD;
+   pragma Import (Stdcall, WaitForSingleObject, "WaitForSingleObject");
+
+   function WaitForSingleObjectEx
+     (hHandle        : HANDLE;
+      dwMilliseconds : DWORD;
+      fAlertable     : BOOL) return DWORD;
+   pragma Import (Stdcall, WaitForSingleObjectEx, "WaitForSingleObjectEx");
+
+   function SetThreadIdealProcessor
+     (hThread          : HANDLE;
+      dwIdealProcessor : ProcessorId) return DWORD;
+   pragma Import (Stdcall, SetThreadIdealProcessor, "SetThreadIdealProcessor");
+
+   Wait_Infinite : constant := DWORD'Last;
+   WAIT_TIMEOUT  : constant := 16#0000_0102#;
+   WAIT_FAILED   : constant := 16#FFFF_FFFF#;
+
+   ------------------------------------
+   -- Semaphores, Events and Mutexes --
+   ------------------------------------
+
+   function CloseHandle (hObject : HANDLE) return BOOL;
+   pragma Import (Stdcall, CloseHandle, "CloseHandle");
+
+   function CreateSemaphore
+     (pSemaphoreAttributes : PSECURITY_ATTRIBUTES;
+      lInitialCount        : Interfaces.C.long;
+      lMaximumCount        : Interfaces.C.long;
+      pName                : PSZ) return HANDLE;
+   pragma Import (Stdcall, CreateSemaphore, "CreateSemaphoreA");
+
+   function OpenSemaphore
+     (dwDesiredAccess : DWORD;
+      bInheritHandle  : BOOL;
+      pName           : PSZ) return HANDLE;
+   pragma Import (Stdcall, OpenSemaphore, "OpenSemaphoreA");
+
+   function ReleaseSemaphore
+     (hSemaphore     : HANDLE;
+      lReleaseCount  : Interfaces.C.long;
+      pPreviousCount : PLONG) return BOOL;
+   pragma Import (Stdcall, ReleaseSemaphore, "ReleaseSemaphore");
+
+   function CreateEvent
+     (pEventAttributes : PSECURITY_ATTRIBUTES;
+      bManualReset     : BOOL;
+      bInitialState    : BOOL;
+      pName            : PSZ) return HANDLE;
+   pragma Import (Stdcall, CreateEvent, "CreateEventA");
+
+   function OpenEvent
+     (dwDesiredAccess : DWORD;
+      bInheritHandle  : BOOL;
+      pName           : PSZ) return HANDLE;
+   pragma Import (Stdcall, OpenEvent, "OpenEventA");
+
+   function SetEvent (hEvent : HANDLE) return BOOL;
+   pragma Import (Stdcall, SetEvent, "SetEvent");
+
+   function ResetEvent (hEvent : HANDLE) return BOOL;
+   pragma Import (Stdcall, ResetEvent, "ResetEvent");
+
+   function PulseEvent (hEvent : HANDLE) return BOOL;
+   pragma Import (Stdcall, PulseEvent, "PulseEvent");
+
+   function CreateMutex
+     (pMutexAttributes : PSECURITY_ATTRIBUTES;
+      bInitialOwner    : BOOL;
+      pName            : PSZ) return HANDLE;
+   pragma Import (Stdcall, CreateMutex, "CreateMutexA");
+
+   function OpenMutex
+     (dwDesiredAccess : DWORD;
+      bInheritHandle  : BOOL;
+      pName           : PSZ) return HANDLE;
+   pragma Import (Stdcall, OpenMutex, "OpenMutexA");
+
+   function ReleaseMutex (hMutex : HANDLE) return BOOL;
+   pragma Import (Stdcall, ReleaseMutex, "ReleaseMutex");
+
+   ---------------------------------------------------
+   -- Accessing properties of Threads and Processes --
+   ---------------------------------------------------
+
+   -----------------
+   --  Priorities --
+   -----------------
+
+   function SetThreadPriority
+     (hThread   : HANDLE;
+      nPriority : Interfaces.C.int) return BOOL;
+   pragma Import (Stdcall, SetThreadPriority, "SetThreadPriority");
+
+   function GetThreadPriority (hThread : HANDLE) return Interfaces.C.int;
+   pragma Import (Stdcall, GetThreadPriority, "GetThreadPriority");
+
+   function SetPriorityClass
+     (hProcess        : HANDLE;
+      dwPriorityClass : DWORD) return BOOL;
+   pragma Import (Stdcall, SetPriorityClass, "SetPriorityClass");
+
+   procedure SetThreadPriorityBoost
+     (hThread              : HANDLE;
+      DisablePriorityBoost : BOOL);
+   pragma Import (Stdcall, SetThreadPriorityBoost, "SetThreadPriorityBoost");
+
+   Normal_Priority_Class   : constant := 16#00000020#;
+   Idle_Priority_Class     : constant := 16#00000040#;
+   High_Priority_Class     : constant := 16#00000080#;
+   Realtime_Priority_Class : constant := 16#00000100#;
+
+   Thread_Priority_Idle          : constant := -15;
+   Thread_Priority_Lowest        : constant := -2;
+   Thread_Priority_Below_Normal  : constant := -1;
+   Thread_Priority_Normal        : constant := 0;
+   Thread_Priority_Above_Normal  : constant := 1;
+   Thread_Priority_Highest       : constant := 2;
+   Thread_Priority_Time_Critical : constant := 15;
+   Thread_Priority_Error_Return  : constant := Interfaces.C.long'Last;
+
+   function GetLastError return DWORD;
+   pragma Import (Stdcall, GetLastError, "GetLastError");
+
+private
+
+   type sigset_t is array (0 .. 127) of unsigned_char;
+   pragma Convention (C, sigset_t);
+   for sigset_t'Alignment use unsigned_long'Alignment;
+
+   type pid_t is new int;
+
+   type time_t is new long;
+
+   type timespec is record
+      tv_sec  : time_t;
+      tv_nsec : long;
+   end record;
+   pragma Convention (C, timespec);
+
+   type struct_timeval is record
+      tv_sec  : time_t;
+      tv_usec : time_t;
+   end record;
+   pragma Convention (C, struct_timeval);
+
+   type pthread_attr_t is record
+      detachstate   : int;
+      schedpolicy   : int;
+      schedparam    : struct_sched_param;
+      inheritsched  : int;
+      scope         : int;
+      guardsize     : size_t;
+      stackaddr_set : int;
+      stackaddr     : System.Address;
+      stacksize     : size_t;
+   end record;
+   pragma Convention (C, pthread_attr_t);
+
+   type pthread_condattr_t is record
+      dummy : int;
+   end record;
+   pragma Convention (C, pthread_condattr_t);
+
+   type pthread_mutexattr_t is record
+      mutexkind : int;
+   end record;
+   pragma Convention (C, pthread_mutexattr_t);
+
+   type struct_pthread_fast_lock is record
+      status   : long;
+      spinlock : int;
+   end record;
+   pragma Convention (C, struct_pthread_fast_lock);
+
+   type pthread_mutex_t is record
+      m_reserved : int;
+      m_count    : int;
+      m_owner    : System.Address;
+      m_kind     : int;
+      m_lock     : struct_pthread_fast_lock;
+   end record;
+   pragma Convention (C, pthread_mutex_t);
+
+   type pthread_cond_t is array (0 .. 47) of unsigned_char;
+   pragma Convention (C, pthread_cond_t);
+
+   type pthread_key_t is new unsigned;
+
+   -------------------
+   -- Win32 private --
+   -------------------
+
+   type CRITICAL_SECTION is record
+      DebugInfo      : System.Address;
+      --  The following three fields control entering and
+      --  exiting the critical section for the resource
+      LockCount      : Long_Integer;
+      RecursionCount : Long_Integer;
+      OwningThread   : HANDLE;
+      LockSemaphore  : HANDLE;
+      Reserved       : DWORD;
+   end record;
+
+end System.OS_Interface;
--- origsrc/gcc-4.7.2/gcc/ada//s-taprop-cygwin.adb	1970-01-01 00:00:00.000000000 +0000
+++ src/gcc-4.7.2/gcc/ada//s-taprop-cygwin.adb	2012-11-01 21:17:31.000000000 +0000
@@ -0,0 +1,1337 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
+--                                                                          --
+--     S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S    --
+--                                                                          --
+--                                  B o d y                                 --
+--                                                                          --
+--         Copyright (C) 1992-2011, Free Software Foundation, Inc.          --
+--                                                                          --
+-- GNARL 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 3,  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.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNARL was developed by the GNARL team at Florida State University.       --
+-- Extensive contributions were provided by Ada Core Technologies, Inc.     --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This is a GNU/Linux (GNU/LinuxThreads) version of this package
+
+--  This package contains all the GNULL primitives that interface directly
+--  with the underlying OS.
+
+pragma Polling (Off);
+--  Turn off polling, we do not want ATC polling to take place during
+--  tasking operations. It causes infinite loops and other problems.
+
+with Interfaces.C;
+--  used for int
+--           size_t
+
+with System.Task_Info;
+--  used for Unspecified_Task_Info
+
+with System.Tasking.Debug;
+--  used for Known_Tasks
+
+with System.Interrupt_Management;
+--  used for Keep_Unmasked
+--           Abort_Task_Interrupt
+--           Interrupt_ID
+
+with System.OS_Primitives;
+--  used for Delay_Modes
+
+with System.Soft_Links;
+--  used for Abort_Defer/Undefer
+
+--  We use System.Soft_Links instead of System.Tasking.Initialization
+--  because the later is a higher level package that we shouldn't depend on.
+--  For example when using the restricted run time, it is replaced by
+--  System.Tasking.Restricted.Stages.
+
+with System.Storage_Elements;
+with System.Stack_Checking.Operations;
+--  Used for Invalidate_Stack_Cache and Notify_Stack_Attributes;
+
+with Ada.Exceptions;
+--  used for Raise_Exception
+--           Raise_From_Signal_Handler
+--           Exception_Id
+
+with Ada.Unchecked_Conversion;
+with Ada.Unchecked_Deallocation;
+
+package body System.Task_Primitives.Operations is
+
+   package SSL renames System.Soft_Links;
+   package SC renames System.Stack_Checking.Operations;
+
+   use System.Tasking.Debug;
+   use System.Tasking;
+   use Interfaces.C;
+   use System.OS_Interface;
+   use System.Parameters;
+   use System.OS_Primitives;
+   use System.Storage_Elements;
+   use System.Task_Info;
+
+   ----------------
+   -- Local Data --
+   ----------------
+
+   --  The followings are logically constants, but need to be initialized
+   --  at run time.
+
+   Single_RTS_Lock : aliased RTS_Lock;
+   --  This is a lock to allow only one thread of control in the RTS at
+   --  a time; it is used to execute in mutual exclusion from all other tasks.
+   --  Used mainly in Single_Lock mode, but also to protect All_Tasks_List
+
+   ATCB_Key : aliased pthread_key_t;
+   --  Key used to find the Ada Task_Id associated with a thread
+
+   Environment_Task_Id : Task_Id;
+   --  A variable to hold Task_Id for the environment task
+
+   Unblocked_Signal_Mask : aliased sigset_t;
+   --  The set of signals that should be unblocked in all tasks
+
+   --  The followings are internal configuration constants needed
+
+   Next_Serial_Number : Task_Serial_Number := 100;
+   --  We start at 100 (reserve some special values for using in error checks)
+
+   Time_Slice_Val : Integer;
+   pragma Import (C, Time_Slice_Val, "__gl_time_slice_val");
+
+   Dispatching_Policy : Character;
+   pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
+
+   --  The following are effectively constants, but they need to be initialized
+   --  by calling a pthread_ function.
+
+   Mutex_Attr   : aliased pthread_mutexattr_t;
+   Cond_Attr    : aliased pthread_condattr_t;
+
+   Foreign_Task_Elaborated : aliased Boolean := True;
+   --  Used to identified fake tasks (i.e., non-Ada Threads)
+
+   --------------------
+   -- Local Packages --
+   --------------------
+
+   package Specific is
+
+      procedure Initialize (Environment_Task : Task_Id);
+      pragma Inline (Initialize);
+      --  Initialize various data needed by this package
+
+      function Is_Valid_Task return Boolean;
+      pragma Inline (Is_Valid_Task);
+      --  Does executing thread have a TCB?
+
+      procedure Set (Self_Id : Task_Id);
+      pragma Inline (Set);
+      --  Set the self id for the current task
+
+      function Self return Task_Id;
+      pragma Inline (Self);
+      --  Return a pointer to the Ada Task Control Block of the calling task
+
+   end Specific;
+
+   package body Specific is separate;
+   --  The body of this package is target specific
+
+   ---------------------------------
+   -- Support for foreign threads --
+   ---------------------------------
+
+   function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id;
+   --  Allocate and Initialize a new ATCB for the current Thread
+
+   function Register_Foreign_Thread
+     (Thread : Thread_Id) return Task_Id is separate;
+
+   -----------------------
+   -- Local Subprograms --
+   -----------------------
+
+   subtype unsigned_long is Interfaces.C.unsigned_long;
+
+   procedure Abort_Handler (signo : Signal);
+
+   function To_pthread_t is new Ada.Unchecked_Conversion
+     (unsigned_long, System.OS_Interface.pthread_t);
+
+   procedure Get_Stack_Attributes
+     (T    : Task_Id;
+      ISP  : out System.Address;
+      Size : out Storage_Offset);
+   --  Fill ISP and Size with the Initial Stack Pointer value and the
+   --  thread stack size for task T.
+
+   -------------------
+   -- Abort_Handler --
+   -------------------
+
+   procedure Abort_Handler (signo : Signal) is
+      pragma Unreferenced (signo);
+
+      Self_Id : constant Task_Id := Self;
+      Result  : Interfaces.C.int;
+      Old_Set : aliased sigset_t;
+
+   begin
+      if ZCX_By_Default and then GCC_ZCX_Support then
+         return;
+      end if;
+
+      if Self_Id.Deferral_Level = 0
+        and then Self_Id.Pending_ATC_Level < Self_Id.ATC_Nesting_Level
+        and then not Self_Id.Aborting
+      then
+         Self_Id.Aborting := True;
+
+         --  Make sure signals used for RTS internal purpose are unmasked
+
+         Result :=
+           pthread_sigmask
+             (SIG_UNBLOCK,
+              Unblocked_Signal_Mask'Access,
+              Old_Set'Access);
+         pragma Assert (Result = 0);
+
+         raise Standard'Abort_Signal;
+      end if;
+   end Abort_Handler;
+
+   --------------
+   -- Lock_RTS --
+   --------------
+
+   procedure Lock_RTS is
+   begin
+      Write_Lock (Single_RTS_Lock'Access, Global_Lock => True);
+   end Lock_RTS;
+
+   ----------------
+   -- Unlock_RTS --
+   ----------------
+
+   procedure Unlock_RTS is
+   begin
+      Unlock (Single_RTS_Lock'Access, Global_Lock => True);
+   end Unlock_RTS;
+
+   -----------------
+   -- Stack_Guard --
+   -----------------
+
+   --  The underlying thread system extends the memory (up to 2MB) when needed
+
+   procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is
+      pragma Unreferenced (T);
+      pragma Unreferenced (On);
+   begin
+      null;
+   end Stack_Guard;
+
+   --------------------
+   -- Get_Thread_Id  --
+   --------------------
+
+   function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is
+   begin
+      return T.Common.LL.Thread;
+   end Get_Thread_Id;
+
+   ----------
+   -- Self --
+   ----------
+
+   function Self return Task_Id renames Specific.Self;
+
+   ---------------------
+   -- Initialize_Lock --
+   ---------------------
+
+   --  Note: mutexes and cond_variables needed per-task basis are
+   --  initialized in Initialize_TCB and the Storage_Error is
+   --  handled. Other mutexes (such as RTS_Lock, Memory_Lock...)
+   --  used in RTS is initialized before any status change of RTS.
+   --  Therefore rasing Storage_Error in the following routines
+   --  should be able to be handled safely.
+
+   procedure Initialize_Lock
+     (Prio : System.Any_Priority;
+      L    : not null access Lock)
+   is
+      pragma Unreferenced (Prio);
+
+      Result : Interfaces.C.int;
+
+   begin
+      Result := pthread_mutex_init (L, Mutex_Attr'Access);
+
+      pragma Assert (Result = 0 or else Result = ENOMEM);
+
+      if Result = ENOMEM then
+         Ada.Exceptions.Raise_Exception (Storage_Error'Identity,
+           "Failed to allocate a lock");
+      end if;
+   end Initialize_Lock;
+
+   procedure Initialize_Lock
+     (L     : not null access RTS_Lock;
+      Level : Lock_Level)
+   is
+      pragma Unreferenced (Level);
+
+      Result : Interfaces.C.int;
+
+   begin
+      Result := pthread_mutex_init (L, Mutex_Attr'Access);
+
+      pragma Assert (Result = 0 or else Result = ENOMEM);
+
+      if Result = ENOMEM then
+         raise Storage_Error;
+      end if;
+   end Initialize_Lock;
+
+   -------------------
+   -- Finalize_Lock --
+   -------------------
+
+   procedure Finalize_Lock (L : not null access Lock) is
+      Result : Interfaces.C.int;
+   begin
+      Result := pthread_mutex_destroy (L);
+      pragma Assert (Result = 0);
+   end Finalize_Lock;
+
+   procedure Finalize_Lock (L : not null access RTS_Lock) is
+      Result : Interfaces.C.int;
+   begin
+      Result := pthread_mutex_destroy (L);
+      pragma Assert (Result = 0);
+   end Finalize_Lock;
+
+   ----------------
+   -- Write_Lock --
+   ----------------
+
+   procedure Write_Lock
+     (L                 : not null access Lock;
+      Ceiling_Violation : out Boolean)
+   is
+      Result : Interfaces.C.int;
+   begin
+      Result := pthread_mutex_lock (L);
+      Ceiling_Violation := Result = EINVAL;
+
+      --  Assume the cause of EINVAL is a priority ceiling violation
+
+      pragma Assert (Result = 0 or else Result = EINVAL);
+   end Write_Lock;
+
+   procedure Write_Lock
+     (L           : not null access RTS_Lock;
+      Global_Lock : Boolean := False)
+   is
+      Result : Interfaces.C.int;
+   begin
+      if not Single_Lock or else Global_Lock then
+         Result := pthread_mutex_lock (L);
+         pragma Assert (Result = 0);
+      end if;
+   end Write_Lock;
+
+   procedure Write_Lock (T : Task_Id) is
+      Result : Interfaces.C.int;
+   begin
+      if not Single_Lock then
+         Result := pthread_mutex_lock (T.Common.LL.L'Access);
+         pragma Assert (Result = 0);
+      end if;
+   end Write_Lock;
+
+   ---------------
+   -- Read_Lock --
+   ---------------
+
+   procedure Read_Lock
+     (L                 : not null access Lock;
+      Ceiling_Violation : out Boolean)
+   is
+   begin
+      Write_Lock (L, Ceiling_Violation);
+   end Read_Lock;
+
+   ------------
+   -- Unlock --
+   ------------
+
+   procedure Unlock (L : not null access Lock) is
+      Result : Interfaces.C.int;
+   begin
+      Result := pthread_mutex_unlock (L);
+      pragma Assert (Result = 0);
+   end Unlock;
+
+   procedure Unlock
+     (L           : not null access RTS_Lock;
+      Global_Lock : Boolean := False)
+   is
+      Result : Interfaces.C.int;
+   begin
+      if not Single_Lock or else Global_Lock then
+         Result := pthread_mutex_unlock (L);
+         pragma Assert (Result = 0);
+      end if;
+   end Unlock;
+
+   procedure Unlock (T : Task_Id) is
+      Result : Interfaces.C.int;
+   begin
+      if not Single_Lock then
+         Result := pthread_mutex_unlock (T.Common.LL.L'Access);
+         pragma Assert (Result = 0);
+      end if;
+   end Unlock;
+
+   -----------------
+   -- Set_Ceiling --
+   -----------------
+
+   --  Dynamic priority ceilings are not supported by the underlying system
+
+   procedure Set_Ceiling
+     (L    : not null access Lock;
+      Prio : System.Any_Priority)
+   is
+      pragma Unreferenced (L, Prio);
+   begin
+      null;
+   end Set_Ceiling;
+
+   -----------
+   -- Sleep --
+   -----------
+
+   procedure Sleep
+     (Self_ID  : Task_Id;
+      Reason   : System.Tasking.Task_States)
+   is
+      pragma Unreferenced (Reason);
+
+      Result : Interfaces.C.int;
+
+   begin
+      pragma Assert (Self_ID = Self);
+
+      if Single_Lock then
+         Result :=
+           pthread_cond_wait
+             (Self_ID.Common.LL.CV'Access, Single_RTS_Lock'Access);
+      else
+         Result :=
+           pthread_cond_wait
+             (Self_ID.Common.LL.CV'Access, Self_ID.Common.LL.L'Access);
+      end if;
+
+      --  EINTR is not considered a failure
+
+      pragma Assert (Result = 0 or else Result = EINTR);
+   end Sleep;
+
+   -----------------
+   -- Timed_Sleep --
+   -----------------
+
+   --  This is for use within the run-time system, so abort is
+   --  assumed to be already deferred, and the caller should be
+   --  holding its own ATCB lock.
+
+   procedure Timed_Sleep
+     (Self_ID  : Task_Id;
+      Time     : Duration;
+      Mode     : ST.Delay_Modes;
+      Reason   : System.Tasking.Task_States;
+      Timedout : out Boolean;
+      Yielded  : out Boolean)
+   is
+      pragma Unreferenced (Reason);
+
+      Base_Time  : constant Duration := Monotonic_Clock;
+      Check_Time : Duration := Base_Time;
+      Abs_Time   : Duration;
+      Request    : aliased timespec;
+      Result     : Interfaces.C.int;
+
+   begin
+      Timedout := True;
+      Yielded := False;
+
+      if Mode = Relative then
+         Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time;
+      else
+         Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
+      end if;
+
+      if Abs_Time > Check_Time then
+         Request := To_Timespec (Abs_Time);
+
+         loop
+            exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
+
+            if Single_Lock then
+               Result :=
+                 pthread_cond_timedwait
+                   (Self_ID.Common.LL.CV'Access,
+                    Single_RTS_Lock'Access,
+                    Request'Access);
+
+            else
+               Result :=
+                 pthread_cond_timedwait
+                   (Self_ID.Common.LL.CV'Access,
+                    Self_ID.Common.LL.L'Access,
+                    Request'Access);
+            end if;
+
+            Check_Time := Monotonic_Clock;
+            exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
+
+            if Result = 0 or else Result = EINTR then
+
+               --  Somebody may have called Wakeup for us
+
+               Timedout := False;
+               exit;
+            end if;
+
+            pragma Assert (Result = ETIMEDOUT);
+         end loop;
+      end if;
+   end Timed_Sleep;
+
+   -----------------
+   -- Timed_Delay --
+   -----------------
+
+   --  This is for use in implementing delay statements, so we assume the
+   --  caller is abort-deferred but is holding no locks.
+
+   procedure Timed_Delay
+     (Self_ID : Task_Id;
+      Time    : Duration;
+      Mode    : ST.Delay_Modes)
+   is
+      Base_Time  : constant Duration := Monotonic_Clock;
+      Check_Time : Duration := Base_Time;
+      Abs_Time   : Duration;
+      Request    : aliased timespec;
+
+      Result : Interfaces.C.int;
+      pragma Warnings (Off, Result);
+
+   begin
+      if Single_Lock then
+         Lock_RTS;
+      end if;
+
+      Write_Lock (Self_ID);
+
+      if Mode = Relative then
+         Abs_Time := Time + Check_Time;
+      else
+         Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
+      end if;
+
+      if Abs_Time > Check_Time then
+         Request := To_Timespec (Abs_Time);
+         Self_ID.Common.State := Delay_Sleep;
+
+         loop
+            exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
+
+            if Single_Lock then
+               Result := pthread_cond_timedwait
+                           (Self_ID.Common.LL.CV'Access,
+                            Single_RTS_Lock'Access,
+                            Request'Access);
+            else
+               Result := pthread_cond_timedwait
+                           (Self_ID.Common.LL.CV'Access,
+                            Self_ID.Common.LL.L'Access,
+                            Request'Access);
+            end if;
+
+            Check_Time := Monotonic_Clock;
+            exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
+
+            pragma Assert (Result = 0 or else
+              Result = ETIMEDOUT or else
+              Result = EINTR);
+         end loop;
+
+         Self_ID.Common.State := Runnable;
+      end if;
+
+      Unlock (Self_ID);
+
+      if Single_Lock then
+         Unlock_RTS;
+      end if;
+
+      Result := sched_yield;
+   end Timed_Delay;
+
+   ---------------------
+   -- Monotonic_Clock --
+   ---------------------
+
+   function Monotonic_Clock return Duration is
+      TV     : aliased struct_timeval;
+      Result : Interfaces.C.int;
+   begin
+      Result := gettimeofday (TV'Access, System.Null_Address);
+      pragma Assert (Result = 0);
+      return To_Duration (TV);
+   end Monotonic_Clock;
+
+   -------------------
+   -- RT_Resolution --
+   -------------------
+
+   function RT_Resolution return Duration is
+   begin
+      return 10#1.0#E-6;
+   end RT_Resolution;
+
+   ------------
+   -- Wakeup --
+   ------------
+
+   procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is
+      pragma Unreferenced (Reason);
+      Result : Interfaces.C.int;
+   begin
+      Result := pthread_cond_signal (T.Common.LL.CV'Access);
+      pragma Assert (Result = 0);
+   end Wakeup;
+
+   -----------
+   -- Yield --
+   -----------
+
+   procedure Yield (Do_Yield : Boolean := True) is
+      Result : Interfaces.C.int;
+      pragma Unreferenced (Result);
+   begin
+      if Do_Yield then
+         Result := sched_yield;
+      end if;
+   end Yield;
+
+   ------------------
+   -- Set_Priority --
+   ------------------
+
+   procedure Set_Priority
+     (T                   : Task_Id;
+      Prio                : System.Any_Priority;
+      Loss_Of_Inheritance : Boolean := False)
+   is
+      pragma Unreferenced (Loss_Of_Inheritance);
+
+      Result : Interfaces.C.int;
+      Param  : aliased struct_sched_param;
+
+      function Get_Policy (Prio : System.Any_Priority) return Character;
+      pragma Import (C, Get_Policy, "__gnat_get_specific_dispatching");
+      --  Get priority specific dispatching policy
+
+      Priority_Specific_Policy : constant Character := Get_Policy (Prio);
+      --  Upper case first character of the policy name corresponding to the
+      --  task as set by a Priority_Specific_Dispatching pragma.
+
+   begin
+      T.Common.Current_Priority := Prio;
+
+      --  Priorities on Cygwin follow Win32 standards, we use the
+      --  MinGW conversion table.
+
+      Param.sched_priority := Interfaces.C.int (Underlying_Priorities (Prio));
+
+      if Dispatching_Policy = 'R'
+        or else Priority_Specific_Policy = 'R'
+        or else Time_Slice_Val > 0
+      then
+         Result :=
+           pthread_setschedparam
+             (T.Common.LL.Thread, SCHED_RR, Param'Access);
+
+      elsif Dispatching_Policy = 'F'
+        or else Priority_Specific_Policy = 'F'
+        or else Time_Slice_Val = 0
+      then
+         Result :=
+           pthread_setschedparam
+             (T.Common.LL.Thread, SCHED_FIFO, Param'Access);
+
+      else
+         Param.sched_priority := 0;
+         Result :=
+           pthread_setschedparam
+             (T.Common.LL.Thread,
+              SCHED_OTHER, Param'Access);
+      end if;
+
+      pragma Assert (Result = 0 or else Result = EPERM);
+   end Set_Priority;
+
+   ------------------
+   -- Get_Priority --
+   ------------------
+
+   function Get_Priority (T : Task_Id) return System.Any_Priority is
+   begin
+      return T.Common.Current_Priority;
+   end Get_Priority;
+
+   --------------------------
+   -- Get_Stack_Attributes --
+   --------------------------
+
+   procedure Get_Stack_Attributes
+     (T    : Task_Id;
+      ISP  : out System.Address;
+      Size : out Storage_Offset)
+   is
+      function pthread_getattr_np
+        (thread : pthread_t;
+         attr   : System.Address) return Interfaces.C.int;
+      pragma Import (C, pthread_getattr_np, "pthread_getattr_np");
+
+      function pthread_attr_getstack
+        (attr : System.Address;
+         base : System.Address;
+         size : System.Address) return Interfaces.C.int;
+      pragma Import (C, pthread_attr_getstack, "pthread_attr_getstack");
+
+      Result : Interfaces.C.int;
+
+      Attributes : aliased pthread_attr_t;
+      Stack_Base : aliased System.Address;
+      Stack_Size : aliased Storage_Offset;
+
+   begin
+      Result :=
+        pthread_getattr_np
+          (T.Common.LL.Thread, Attributes'Address);
+      pragma Assert (Result = 0);
+
+      Result :=
+        pthread_attr_getstack
+          (Attributes'Address, Stack_Base'Address, Stack_Size'Address);
+      pragma Assert (Result = 0);
+
+      Result := pthread_attr_destroy (Attributes'Access);
+      pragma Assert (Result = 0);
+
+      ISP  := Stack_Base + Stack_Size;
+      Size := Stack_Size;
+   end Get_Stack_Attributes;
+
+   ----------------
+   -- Enter_Task --
+   ----------------
+
+   procedure Enter_Task (Self_ID : Task_Id) is
+   begin
+      if Self_ID.Common.Task_Info /= null
+        and then
+          Self_ID.Common.Task_Info.CPU_Affinity = No_CPU
+      then
+         raise Invalid_CPU_Number;
+      end if;
+
+      Self_ID.Common.LL.Thread := pthread_self;
+
+      Specific.Set (Self_ID);
+
+      Lock_RTS;
+
+      for J in Known_Tasks'Range loop
+         if Known_Tasks (J) = null then
+            Known_Tasks (J) := Self_ID;
+            Self_ID.Known_Tasks_Index := J;
+            exit;
+         end if;
+      end loop;
+
+      Unlock_RTS;
+
+      --  Determine where the task stack starts, how large it is, and let the
+      --  stack checking engine know about it.
+
+      declare
+         Initial_SP : System.Address;
+         Stack_Size : Storage_Offset;
+      begin
+         Get_Stack_Attributes (Self_ID, Initial_SP, Stack_Size);
+         System.Stack_Checking.Operations.Notify_Stack_Attributes
+           (Initial_SP, Stack_Size);
+      end;
+   end Enter_Task;
+
+   --------------
+   -- New_ATCB --
+   --------------
+
+   function New_ATCB (Entry_Num : Task_Entry_Index) return Task_Id is
+   begin
+      return new Ada_Task_Control_Block (Entry_Num);
+   end New_ATCB;
+
+   -------------------
+   -- Is_Valid_Task --
+   -------------------
+
+   function Is_Valid_Task return Boolean renames Specific.Is_Valid_Task;
+
+   -----------------------------
+   -- Register_Foreign_Thread --
+   -----------------------------
+
+   function Register_Foreign_Thread return Task_Id is
+   begin
+      if Is_Valid_Task then
+         return Self;
+      else
+         return Register_Foreign_Thread (pthread_self);
+      end if;
+   end Register_Foreign_Thread;
+
+   --------------------
+   -- Initialize_TCB --
+   --------------------
+
+   procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is
+      Result : Interfaces.C.int;
+
+   begin
+      --  Give the task a unique serial number
+
+      Self_ID.Serial_Number := Next_Serial_Number;
+      Next_Serial_Number := Next_Serial_Number + 1;
+      pragma Assert (Next_Serial_Number /= 0);
+
+      Self_ID.Common.LL.Thread := To_pthread_t (-1);
+
+      if not Single_Lock then
+         Result := pthread_mutex_init (Self_ID.Common.LL.L'Access,
+           Mutex_Attr'Access);
+         pragma Assert (Result = 0 or else Result = ENOMEM);
+
+         if Result /= 0 then
+            Succeeded := False;
+            return;
+         end if;
+      end if;
+
+      Result := pthread_cond_init (Self_ID.Common.LL.CV'Access,
+        Cond_Attr'Access);
+      pragma Assert (Result = 0 or else Result = ENOMEM);
+
+      if Result = 0 then
+         Succeeded := True;
+      else
+         if not Single_Lock then
+            Result := pthread_mutex_destroy (Self_ID.Common.LL.L'Access);
+            pragma Assert (Result = 0);
+         end if;
+
+         Succeeded := False;
+      end if;
+   end Initialize_TCB;
+
+   -----------------
+   -- Create_Task --
+   -----------------
+
+   procedure Create_Task
+     (T          : Task_Id;
+      Wrapper    : System.Address;
+      Stack_Size : System.Parameters.Size_Type;
+      Priority   : System.Any_Priority;
+      Succeeded  : out Boolean)
+   is
+      Attributes : aliased pthread_attr_t;
+      Result     : Interfaces.C.int;
+
+   begin
+      Result := pthread_attr_init (Attributes'Access);
+      pragma Assert (Result = 0 or else Result = ENOMEM);
+
+      if Result /= 0 then
+         Succeeded := False;
+         return;
+      end if;
+
+      Result :=
+        pthread_attr_setstacksize
+          (Attributes'Access, Interfaces.C.size_t (Stack_Size));
+      pragma Assert (Result = 0);
+
+      Result :=
+        pthread_attr_setdetachstate
+          (Attributes'Access, PTHREAD_CREATE_DETACHED);
+      pragma Assert (Result = 0);
+
+      --  Since the initial signal mask of a thread is inherited from the
+      --  creator, and the Environment task has all its signals masked, we
+      --  do not need to manipulate caller's signal mask at this point.
+      --  All tasks in RTS will have All_Tasks_Mask initially.
+
+      Result := pthread_create
+        (T.Common.LL.Thread'Access,
+         Attributes'Access,
+         Thread_Body_Access (Wrapper),
+         To_Address (T));
+      pragma Assert (Result = 0 or else Result = EAGAIN);
+
+      Succeeded := Result = 0;
+
+      --  Handle Task_Info
+
+      if T.Common.Task_Info /= null then
+         if T.Common.Task_Info.CPU_Affinity /= Task_Info.Any_CPU then
+            Result :=
+              pthread_setaffinity_np
+                (T.Common.LL.Thread,
+                 CPU_SETSIZE / 8,
+                 T.Common.Task_Info.CPU_Affinity'Access);
+            pragma Assert (Result = 0);
+         end if;
+      end if;
+
+      Result := pthread_attr_destroy (Attributes'Access);
+      pragma Assert (Result = 0);
+
+      Set_Priority (T, Priority);
+   end Create_Task;
+
+   ------------------
+   -- Finalize_TCB --
+   ------------------
+
+   procedure Finalize_TCB (T : Task_Id) is
+      Result  : Interfaces.C.int;
+      Tmp     : Task_Id := T;
+      Is_Self : constant Boolean := T = Self;
+
+      procedure Free is new
+        Ada.Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id);
+
+   begin
+      if not Single_Lock then
+         Result := pthread_mutex_destroy (T.Common.LL.L'Access);
+         pragma Assert (Result = 0);
+      end if;
+
+      Result := pthread_cond_destroy (T.Common.LL.CV'Access);
+      pragma Assert (Result = 0);
+
+      if T.Known_Tasks_Index /= -1 then
+         Known_Tasks (T.Known_Tasks_Index) := null;
+      end if;
+      SC.Invalidate_Stack_Cache (T.Common.Compiler_Data.Pri_Stack_Info'Access);
+      Free (Tmp);
+
+      if Is_Self then
+         Specific.Set (null);
+      end if;
+   end Finalize_TCB;
+
+   ---------------
+   -- Exit_Task --
+   ---------------
+
+   procedure Exit_Task is
+   begin
+      Specific.Set (null);
+   end Exit_Task;
+
+   ----------------
+   -- Abort_Task --
+   ----------------
+
+   procedure Abort_Task (T : Task_Id) is
+      Result : Interfaces.C.int;
+   begin
+      Result :=
+        pthread_kill
+          (T.Common.LL.Thread,
+           Signal (System.Interrupt_Management.Abort_Task_Interrupt));
+      pragma Assert (Result = 0);
+   end Abort_Task;
+
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize (S : in out Suspension_Object) is
+      Result : Interfaces.C.int;
+
+   begin
+      --  Initialize internal state (always to False (RM D.10(6)))
+
+      S.State := False;
+      S.Waiting := False;
+
+      --  Initialize internal mutex
+
+      Result := pthread_mutex_init (S.L'Access, Mutex_Attr'Access);
+
+      pragma Assert (Result = 0 or else Result = ENOMEM);
+
+      if Result = ENOMEM then
+         raise Storage_Error;
+      end if;
+
+      --  Initialize internal condition variable
+
+      Result := pthread_cond_init (S.CV'Access, Cond_Attr'Access);
+
+      pragma Assert (Result = 0 or else Result = ENOMEM);
+
+      if Result /= 0 then
+         Result := pthread_mutex_destroy (S.L'Access);
+         pragma Assert (Result = 0);
+
+         if Result = ENOMEM then
+            raise Storage_Error;
+         end if;
+      end if;
+   end Initialize;
+
+   --------------
+   -- Finalize --
+   --------------
+
+   procedure Finalize (S : in out Suspension_Object) is
+      Result : Interfaces.C.int;
+
+   begin
+      --  Destroy internal mutex
+
+      Result := pthread_mutex_destroy (S.L'Access);
+      pragma Assert (Result = 0);
+
+      --  Destroy internal condition variable
+
+      Result := pthread_cond_destroy (S.CV'Access);
+      pragma Assert (Result = 0);
+   end Finalize;
+
+   -------------------
+   -- Current_State --
+   -------------------
+
+   function Current_State (S : Suspension_Object) return Boolean is
+   begin
+      --  We do not want to use lock on this read operation. State is marked
+      --  as Atomic so that we ensure that the value retrieved is correct.
+
+      return S.State;
+   end Current_State;
+
+   ---------------
+   -- Set_False --
+   ---------------
+
+   procedure Set_False (S : in out Suspension_Object) is
+      Result : Interfaces.C.int;
+
+   begin
+      SSL.Abort_Defer.all;
+
+      Result := pthread_mutex_lock (S.L'Access);
+      pragma Assert (Result = 0);
+
+      S.State := False;
+
+      Result := pthread_mutex_unlock (S.L'Access);
+      pragma Assert (Result = 0);
+
+      SSL.Abort_Undefer.all;
+   end Set_False;
+
+   --------------
+   -- Set_True --
+   --------------
+
+   procedure Set_True (S : in out Suspension_Object) is
+      Result : Interfaces.C.int;
+
+   begin
+      SSL.Abort_Defer.all;
+
+      Result := pthread_mutex_lock (S.L'Access);
+      pragma Assert (Result = 0);
+
+      --  If there is already a task waiting on this suspension object then
+      --  we resume it, leaving the state of the suspension object to False,
+      --  as it is specified in ARM D.10 par. 9. Otherwise, it just leaves
+      --  the state to True.
+
+      if S.Waiting then
+         S.Waiting := False;
+         S.State := False;
+
+         Result := pthread_cond_signal (S.CV'Access);
+         pragma Assert (Result = 0);
+
+      else
+         S.State := True;
+      end if;
+
+      Result := pthread_mutex_unlock (S.L'Access);
+      pragma Assert (Result = 0);
+
+      SSL.Abort_Undefer.all;
+   end Set_True;
+
+   ------------------------
+   -- Suspend_Until_True --
+   ------------------------
+
+   procedure Suspend_Until_True (S : in out Suspension_Object) is
+      Result : Interfaces.C.int;
+
+   begin
+      SSL.Abort_Defer.all;
+
+      Result := pthread_mutex_lock (S.L'Access);
+      pragma Assert (Result = 0);
+
+      if S.Waiting then
+
+         --  Program_Error must be raised upon calling Suspend_Until_True
+         --  if another task is already waiting on that suspension object
+         --  (RM D.10(10)).
+
+         Result := pthread_mutex_unlock (S.L'Access);
+         pragma Assert (Result = 0);
+
+         SSL.Abort_Undefer.all;
+
+         raise Program_Error;
+      else
+         --  Suspend the task if the state is False. Otherwise, the task
+         --  continues its execution, and the state of the suspension object
+         --  is set to False (ARM D.10 par. 9).
+
+         if S.State then
+            S.State := False;
+         else
+            S.Waiting := True;
+            Result := pthread_cond_wait (S.CV'Access, S.L'Access);
+         end if;
+
+         Result := pthread_mutex_unlock (S.L'Access);
+         pragma Assert (Result = 0);
+
+         SSL.Abort_Undefer.all;
+      end
+      if;
+   end Suspend_Until_True;
+
+   ----------------
+   -- Check_Exit --
+   ----------------
+
+   --  Dummy version
+
+   function Check_Exit (Self_ID : ST.Task_Id) return Boolean is
+      pragma Unreferenced (Self_ID);
+   begin
+      return True;
+   end Check_Exit;
+
+   --------------------
+   -- Check_No_Locks --
+   --------------------
+
+   function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is
+      pragma Unreferenced (Self_ID);
+   begin
+      return True;
+   end Check_No_Locks;
+
+   ----------------------
+   -- Environment_Task --
+   ----------------------
+
+   function Environment_Task return Task_Id is
+   begin
+      return Environment_Task_Id;
+   end Environment_Task;
+
+   ------------------
+   -- Suspend_Task --
+   ------------------
+
+   function Suspend_Task
+     (T           : ST.Task_Id;
+      Thread_Self : Thread_Id) return Boolean
+   is
+   begin
+      if T.Common.LL.Thread /= Thread_Self then
+         return pthread_kill (T.Common.LL.Thread, SIGSTOP) = 0;
+      else
+         return True;
+      end if;
+   end Suspend_Task;
+
+   -----------------
+   -- Resume_Task --
+   -----------------
+
+   function Resume_Task
+     (T           : ST.Task_Id;
+      Thread_Self : Thread_Id) return Boolean
+   is
+   begin
+      if T.Common.LL.Thread /= Thread_Self then
+         return pthread_kill (T.Common.LL.Thread, SIGCONT) = 0;
+      else
+         return True;
+      end if;
+   end Resume_Task;
+
+   --------------------
+   -- Stop_All_Tasks --
+   --------------------
+
+   procedure Stop_All_Tasks is
+   begin
+      null;
+   end Stop_All_Tasks;
+
+   ---------------
+   -- Stop_Task --
+   ---------------
+
+   function Stop_Task (T : ST.Task_Id) return Boolean is
+      pragma Unreferenced (T);
+   begin
+      return False;
+   end Stop_Task;
+
+   -------------------
+   -- Continue_Task --
+   -------------------
+
+   function Continue_Task (T : ST.Task_Id) return Boolean is
+      pragma Unreferenced (T);
+   begin
+      return False;
+   end Continue_Task;
+
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize (Environment_Task : Task_Id) is
+      act     : aliased struct_sigaction;
+      old_act : aliased struct_sigaction;
+      Tmp_Set : aliased sigset_t;
+      Result  : Interfaces.C.int;
+
+      function State
+        (Int : System.Interrupt_Management.Interrupt_ID) return Character;
+      pragma Import (C, State, "__gnat_get_interrupt_state");
+      --  Get interrupt state.  Defined in a-init.c
+      --  The input argument is the interrupt number,
+      --  and the result is one of the following:
+
+      Default : constant Character := 's';
+      --    'n'   this interrupt not set by any Interrupt_State pragma
+      --    'u'   Interrupt_State pragma set state to User
+      --    'r'   Interrupt_State pragma set state to Runtime
+      --    's'   Interrupt_State pragma set state to System (use "default"
+      --           system handler)
+
+   begin
+      Environment_Task_Id := Environment_Task;
+
+      Interrupt_Management.Initialize;
+
+      --  Prepare the set of signals that should be unblocked in all tasks
+
+      Result := sigemptyset (Unblocked_Signal_Mask'Access);
+      pragma Assert (Result = 0);
+
+      for J in Interrupt_Management.Interrupt_ID loop
+         if System.Interrupt_Management.Keep_Unmasked (J) then
+            Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
+            pragma Assert (Result = 0);
+         end if;
+      end loop;
+
+      Result := pthread_mutexattr_init (Mutex_Attr'Access);
+      pragma Assert (Result = 0);
+
+      Result := pthread_condattr_init (Cond_Attr'Access);
+      pragma Assert (Result = 0);
+
+      Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
+
+      --  Initialize the global RTS lock
+
+      Specific.Initialize (Environment_Task);
+
+      Enter_Task (Environment_Task);
+
+      --  Install the abort-signal handler
+
+      if State
+          (System.Interrupt_Management.Abort_Task_Interrupt) /= Default
+      then
+         act.sa_flags := 0;
+         act.sa_handler := Abort_Handler'Address;
+
+         Result := sigemptyset (Tmp_Set'Access);
+         pragma Assert (Result = 0);
+         act.sa_mask := Tmp_Set;
+
+         Result :=
+           sigaction
+           (Signal (Interrupt_Management.Abort_Task_Interrupt),
+            act'Unchecked_Access,
+            old_act'Unchecked_Access);
+         pragma Assert (Result = 0);
+      end if;
+   end Initialize;
+
+end System.Task_Primitives.Operations;
--- origsrc/gcc-4.7.2/gcc/ada//sysdep.c	2012-11-02 15:16:50.062500000 +0000
+++ src/gcc-4.7.2/gcc/ada//sysdep.c	2012-11-02 15:50:59.968750000 +0000
@@ -311,7 +311,7 @@ getc_immediate_common (FILE *stream,
 {
 #if defined (linux) || defined (sun) || defined (sgi) \
     || (defined (__osf__) && ! defined (__alpha_vxworks)) \
-    || defined (__CYGWIN32__) || defined (__MACHTEN__) || defined (__hpux__) \
+    || defined (__CYGWIN__) || defined (__MACHTEN__) || defined (__hpux__) \
     || defined (_AIX) || (defined (__svr4__) && defined (i386)) \
     || defined (__Lynx__) || defined (__FreeBSD__) || defined (__OpenBSD__) \
     || defined (__GLIBC__) || defined (__APPLE__)
@@ -592,6 +592,18 @@ rts_get_nShowCmd (void)
 }
 
 #endif /* WINNT */
+
+#ifdef __CYGWIN__
+
+#include <malloc.h>
+
+size_t _msize(void *memblock)
+{
+  return (size_t) malloc_usable_size (memblock);
+}
+
+#endif /* __CYGWIN__ */
+
 #ifdef VMS
 
 /* This gets around a problem with using the old threads library on VMS 7.0. */
--- origsrc/gcc-4.7.2/gcc/ada//system-cygwin.ads	1970-01-01 00:00:00.000000000 +0000
+++ src/gcc-4.7.2/gcc/ada//system-cygwin.ads	2012-11-01 21:17:31.000000000 +0000
@@ -0,0 +1,198 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                        GNAT RUN-TIME COMPONENTS                          --
+--                                                                          --
+--                               S Y S T E M                                --
+--                                                                          --
+--                                 S p e c                                  --
+--                            (Cygwin  Version)                             --
+--                                                                          --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--                                                                          --
+-- This specification is derived from the Ada Reference Manual for use with --
+-- GNAT. The copyright notice above, and the license provisions that follow --
+-- apply solely to the  contents of the part following the private keyword. --
+--                                                                          --
+-- 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.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+package System is
+   pragma Pure;
+   --  Note that we take advantage of the implementation permission to make
+   --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
+   --  2005, this is Pure in any case (AI-362).
+
+   type Name is (SYSTEM_NAME_GNAT);
+   System_Name : constant Name := SYSTEM_NAME_GNAT;
+
+   --  System-Dependent Named Numbers
+
+   Min_Int               : constant := Long_Long_Integer'First;
+   Max_Int               : constant := Long_Long_Integer'Last;
+
+   Max_Binary_Modulus    : constant := 2 ** Long_Long_Integer'Size;
+   Max_Nonbinary_Modulus : constant := 2 ** Integer'Size - 1;
+
+   Max_Base_Digits       : constant := Long_Long_Float'Digits;
+   Max_Digits            : constant := Long_Long_Float'Digits;
+
+   Max_Mantissa          : constant := 63;
+   Fine_Delta            : constant := 2.0 ** (-Max_Mantissa);
+
+   Tick                  : constant := 0.01;
+
+   --  Storage-related Declarations
+
+   type Address is private;
+   pragma Preelaborable_Initialization (Address);
+   Null_Address : constant Address;
+
+   Storage_Unit : constant := 8;
+   Word_Size    : constant := 32;
+   Memory_Size  : constant := 2 ** 32;
+
+   --  Address comparison
+
+   function "<"  (Left, Right : Address) return Boolean;
+   function "<=" (Left, Right : Address) return Boolean;
+   function ">"  (Left, Right : Address) return Boolean;
+   function ">=" (Left, Right : Address) return Boolean;
+   function "="  (Left, Right : Address) return Boolean;
+
+   pragma Import (Intrinsic, "<");
+   pragma Import (Intrinsic, "<=");
+   pragma Import (Intrinsic, ">");
+   pragma Import (Intrinsic, ">=");
+   pragma Import (Intrinsic, "=");
+
+   --  Other System-Dependent Declarations
+
+   type Bit_Order is (High_Order_First, Low_Order_First);
+   Default_Bit_Order : constant Bit_Order := Low_Order_First;
+   pragma Warnings (Off, Default_Bit_Order); -- kill constant condition warning
+
+   --  Priority-related Declarations (RM D.1)
+
+   Max_Priority           : constant Positive := 30;
+   Max_Interrupt_Priority : constant Positive := 31;
+
+   subtype Any_Priority       is Integer      range  0 .. 31;
+   subtype Priority           is Any_Priority range  0 .. 30;
+   subtype Interrupt_Priority is Any_Priority range 31 .. 31;
+
+   Default_Priority : constant Priority := 15;
+
+private
+
+   type Address is mod Memory_Size;
+   Null_Address : constant Address := 0;
+
+   --------------------------------------
+   -- System Implementation Parameters --
+   --------------------------------------
+
+   --  These parameters provide information about the target that is used
+   --  by the compiler. They are in the private part of System, where they
+   --  can be accessed using the special circuitry in the Targparm unit
+   --  whose source should be consulted for more detailed descriptions
+   --  of the individual switch values.
+
+   Backend_Divide_Checks     : constant Boolean := False;
+   Backend_Overflow_Checks   : constant Boolean := False;
+   Command_Line_Args         : constant Boolean := True;
+   Configurable_Run_Time     : constant Boolean := False;
+   Denorm                    : constant Boolean := True;
+   Duration_32_Bits          : constant Boolean := False;
+   Exit_Status_Supported     : constant Boolean := True;
+   Fractional_Fixed_Ops      : constant Boolean := False;
+   Frontend_Layout           : constant Boolean := False;
+   Machine_Overflows         : constant Boolean := False;
+   Machine_Rounds            : constant Boolean := True;
+   Preallocated_Stacks       : constant Boolean := False;
+   Signed_Zeros              : constant Boolean := True;
+   Stack_Check_Default       : constant Boolean := False;
+   Stack_Check_Probes        : constant Boolean := True;
+   Stack_Check_Limits        : constant Boolean := False;
+   Support_64_Bit_Divides    : constant Boolean := True;
+   Support_Aggregates        : constant Boolean := True;
+   Support_Composite_Assign  : constant Boolean := True;
+   Support_Composite_Compare : constant Boolean := True;
+   Support_Long_Shifts       : constant Boolean := True;
+   Always_Compatible_Rep     : constant Boolean := True;
+   Suppress_Standard_Library : constant Boolean := False;
+   Use_Ada_Main_Program_Name : constant Boolean := False;
+   ZCX_By_Default            : constant Boolean := True;
+
+   ---------------------------
+   -- Underlying Priorities --
+   ---------------------------
+
+   --  Important note: this section of the file must come AFTER the
+   --  definition of the system implementation parameters to ensure
+   --  that the value of these parameters is available for analysis
+   --  of the declarations here (using Rtsfind at compile time).
+
+   --  The underlying priorities table provides a generalized mechanism
+   --  for mapping from Ada priorities to system priorities. In some
+   --  cases a 1-1 mapping is not the convenient or optimal choice.
+
+   type Priorities_Mapping is array (Any_Priority) of Integer;
+   pragma Suppress_Initialization (Priorities_Mapping);
+   --  Suppress initialization in case gnat.adc specifies Normalize_Scalars
+
+   Underlying_Priorities : constant Priorities_Mapping :=
+     (Priority'First ..
+      Default_Priority - 8    => -15,
+      Default_Priority - 7    => -7,
+      Default_Priority - 6    => -6,
+      Default_Priority - 5    => -5,
+      Default_Priority - 4    => -4,
+      Default_Priority - 3    => -3,
+      Default_Priority - 2    => -2,
+      Default_Priority - 1    => -1,
+      Default_Priority        => 0,
+      Default_Priority + 1    => 1,
+      Default_Priority + 2    => 2,
+      Default_Priority + 3    => 3,
+      Default_Priority + 4    => 4,
+      Default_Priority + 5    => 5,
+      Default_Priority + 6 ..
+      Priority'Last           => 6,
+      Interrupt_Priority      => 15);
+   --  The default mapping preserves the standard 31 priorities of the Ada
+   --  model, but maps them using compression onto the 7 priority levels
+   --  available in NT and on the 16 priority levels available in 2000/XP.
+
+   --  To replace the default values of the Underlying_Priorities mapping,
+   --  copy this source file into your build directory, edit the file to
+   --  reflect your desired behavior, and recompile using Makefile.adalib
+   --  which can be found under the adalib directory of your gnat installation
+
+   pragma Linker_Options ("-Wl,--stack=0x2000000");
+   --  This is used to change the default stack (32 MB) size for non tasking
+   --  programs. We change this value for GNAT on Windows here because the
+   --  binutils on this platform have switched to a too low value for Ada
+   --  programs. Note that we also set the stack size for tasking programs in
+   --  System.Task_Primitives.Operations.
+
+end System;