]> git.ipfire.org Git - thirdparty/gcc.git/blobdiff - gcc/ada/adaint.c
[Ada] Set GNAT.OS_Lib.GM_Split's granularity back to 1 second
[thirdparty/gcc.git] / gcc / ada / adaint.c
index cd3f11a3469d4a24dcc1a0d88e7b1ba6345b8eb7..7290f7a3d72d45042f67c0e9b86717d657cff093 100644 (file)
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2014, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2019, 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- *
 #define _REENTRANT
 #define _THREAD_SAFE
 
+/* Use 64 bit Large File API */
+#if defined (__QNX__)
+#define _LARGEFILE64_SOURCE 1
+#elif !defined(_LARGEFILE_SOURCE)
+#define _LARGEFILE_SOURCE
+#endif
+#define _FILE_OFFSET_BITS 64
+
 #ifdef __vxworks
 
 /* No need to redefine exit here.  */
 #define __BSD_VISIBLE 1
 #endif
 
+#ifdef __QNX__
+#include <sys/syspage.h>
+#endif
+
 #ifdef IN_RTS
+
+#ifdef STANDALONE
+#include <errno.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <unistd.h>
+#include <stdlib.h>
+#include <string.h>
+
+/* for CPU_SET/CPU_ZERO */
+#define _GNU_SOURCE
+#define __USE_GNU
+
+#include "runtime.h"
+
+#else
 #include "tconfig.h"
 #include "tsystem.h"
+#endif
+
 #include <sys/stat.h>
 #include <fcntl.h>
 #include <time.h>
 extern "C" {
 #endif
 
-#if defined (__MINGW32__)
+#if defined (__DJGPP__)
+
+/* For isalpha-like tests in the compiler, we're expected to resort to
+   safe-ctype.h/ISALPHA.  This isn't available for the runtime library
+   build, so we fallback on ctype.h/isalpha there.  */
+
+#ifdef IN_RTS
+#include <ctype.h>
+#define ISALPHA isalpha
+#endif
+
+#elif defined (__MINGW32__) || defined (__CYGWIN__)
 
-#if defined (RTX)
-#include <windows.h>
-#include <Rtapi.h>
-#else
 #include "mingw32.h"
 
 /* Current code page and CCS encoding to use, set in initialize.c.  */
-UINT CurrentCodePage;
-UINT CurrentCCSEncoding;
-#endif
+UINT __gnat_current_codepage;
+UINT __gnat_current_ccs_encoding;
 
 #include <sys/utime.h>
 
@@ -157,20 +193,28 @@ UINT CurrentCCSEncoding;
    preventing the inclusion of the GCC header from doing anything.  */
 # define GCC_RESOURCE_H
 # include <sys/wait.h>
-#elif defined (__nucleus__) || defined (__PikeOS__)
+#elif defined (__PikeOS__)
 /* No wait() or waitpid() calls available.  */
 #else
 /* Default case.  */
 #include <sys/wait.h>
 #endif
 
-#if defined (_WIN32)
-
+#if defined (__DJGPP__)
 #include <process.h>
+#include <signal.h>
 #include <dir.h>
+#include <utime.h>
+#undef DIR_SEPARATOR
+#define DIR_SEPARATOR '\\'
+
+#elif defined (_WIN32)
+
 #include <windows.h>
 #include <accctrl.h>
 #include <aclapi.h>
+#include <tlhelp32.h>
+#include <signal.h>
 #undef DIR_SEPARATOR
 #define DIR_SEPARATOR '\\'
 
@@ -253,7 +297,7 @@ char __gnat_path_separator = PATH_SEPARATOR;
 
 const char *__gnat_library_template = GNAT_LIBRARY_TEMPLATE;
 
-#if defined (__vxworks) || defined (__OPENNT) || defined(__nucleus__)
+#if defined (__vxworks)
 #define GNAT_MAX_PATH_LEN PATH_MAX
 
 #else
@@ -297,9 +341,10 @@ int max_path_len = GNAT_MAX_PATH_LEN;
 int __gnat_use_acl = 1;
 
 /* The following macro HAVE_READDIR_R should be defined if the
-   system provides the routine readdir_r.  */
+   system provides the routine readdir_r.
+   ... but we never define it anywhere???  */
 #undef HAVE_READDIR_R
-\f
+
 #define MAYBE_TO_PTR32(argv) argv
 
 static const char ATTR_UNSET = 127;
@@ -366,13 +411,6 @@ __gnat_to_gm_time (OS_Time *p_time, int *p_year, int *p_month, int *p_day,
   struct tm *res;
   time_t time = (time_t) *p_time;
 
-#ifdef _WIN32
-  /* On Windows systems, the time is sometimes rounded up to the nearest
-     even second, so if the number of seconds is odd, increment it.  */
-  if (time & 1)
-    time++;
-#endif
-
   res = gmtime (&time);
   if (res)
     {
@@ -417,7 +455,7 @@ __gnat_readlink (char *path ATTRIBUTE_UNUSED,
                 size_t bufsiz ATTRIBUTE_UNUSED)
 {
 #if defined (_WIN32) \
-  || defined(__vxworks) || defined (__nucleus__) || defined (__PikeOS__)
+  || defined(__vxworks) || defined (__PikeOS__)
   return -1;
 #else
   return readlink (path, buf, bufsiz);
@@ -433,7 +471,7 @@ __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED,
                char *newpath ATTRIBUTE_UNUSED)
 {
 #if defined (_WIN32) \
-  || defined(__vxworks) || defined (__nucleus__) || defined (__PikeOS__)
+  || defined(__vxworks) || defined (__PikeOS__)
   return -1;
 #else
   return symlink (oldpath, newpath);
@@ -442,7 +480,7 @@ __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED,
 
 /* Try to lock a file, return 1 if success.  */
 
-#if defined (__vxworks) || defined (__nucleus__) \
+#if defined (__vxworks) \
   || defined (_WIN32) || defined (__PikeOS__)
 
 /* Version that does not use link. */
@@ -550,7 +588,8 @@ __gnat_get_file_names_case_sensitive (void)
        {
          /* By default, we suppose filesystems aren't case sensitive on
             Windows and Darwin (but they are on arm-darwin).  */
-#if defined (WINNT) || (defined (__APPLE__) && !defined (__arm__))
+#if defined (WINNT) || defined (__DJGPP__) \
+  || (defined (__APPLE__) && !(defined (__arm__) || defined (__arm64__)))
          file_names_case_sensitive_cache = 0;
 #else
          file_names_case_sensitive_cache = 1;
@@ -565,7 +604,7 @@ __gnat_get_file_names_case_sensitive (void)
 int
 __gnat_get_env_vars_case_sensitive (void)
 {
-#if defined (WINNT)
+#if defined (WINNT) || defined (__DJGPP__)
  return 0;
 #else
  return 1;
@@ -591,7 +630,16 @@ __gnat_get_current_dir (char *dir, int *length)
   WS2SC (dir, wdir, GNAT_MAX_PATH_LEN);
 
 #else
-   getcwd (dir, *length);
+   char* result = getcwd (dir, *length);
+   /* If the current directory does not exist, set length = 0
+      to indicate error. That can't happen on windows, where
+      you can't delete a directory if it is the current
+      directory of some process. */
+   if (!result)
+     {
+       *length = 0;
+       return;
+     }
 #endif
 
    *length = strlen (dir);
@@ -625,6 +673,7 @@ void
 __gnat_get_executable_suffix_ptr (int *len, const char **value)
 {
   *value = HOST_EXECUTABLE_SUFFIX;
+
   if (!*value)
     *len = 0;
   else
@@ -741,8 +790,8 @@ __gnat_rmdir (char *path)
 #endif
 }
 
-#if defined (_WIN32) || defined (linux) || defined (sun) \
-  || defined (__FreeBSD__)
+#if defined (_WIN32) || defined (__linux__) || defined (__sun__) \
+  || defined (__FreeBSD__) || defined(__DragonFly__) || defined (__QNX__)
 #define HAS_TARGET_WCHAR_T
 #endif
 
@@ -980,12 +1029,11 @@ __gnat_open_new_temp (char *path, int fmode)
   strcpy (path, "GNAT-XXXXXX");
 
 #if (defined (__FreeBSD__) || defined (__NetBSD__) || defined (__OpenBSD__) \
-  || defined (linux) || defined(__GLIBC__)) && !defined (__vxworks)
+  || defined (__linux__) || defined (__GLIBC__) || defined (__ANDROID__) \
+  || defined (__DragonFly__) || defined (__QNX__)) && !defined (__vxworks)
   return mkstemp (path);
 #elif defined (__Lynx__)
   mktemp (path);
-#elif defined (__nucleus__)
-  return -1;
 #else
   if (mktemp (path) == NULL)
     return -1;
@@ -1062,7 +1110,7 @@ __gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr)
 
   attr->exists = !ret;
 
-#if !defined (_WIN32) || defined (RTX)
+#if !defined (_WIN32)
   /* on Windows requires extra system call, see __gnat_is_readable_file_attr */
   attr->readable   = (!ret && (statbuf.st_mode & S_IRUSR));
   attr->writable   = (!ret && (statbuf.st_mode & S_IWUSR));
@@ -1120,15 +1168,7 @@ __gnat_named_file_length (char *name)
 void
 __gnat_tmp_name (char *tmp_filename)
 {
-#ifdef RTX
-  /* Variable used to create a series of unique names */
-  static int counter = 0;
-
-  /* RTX in RTSS mode does not support tempnam nor tmpnam so we emulate it */
-  strcpy (tmp_filename, "c:\\WINDOWS\\Temp\\gnat-");
-  sprintf (&tmp_filename[strlen (tmp_filename)], "%d\0", counter++);
-
-#elif defined (__MINGW32__)
+#if defined (__MINGW32__)
   {
     char *pname;
     char prefix[25];
@@ -1161,8 +1201,9 @@ __gnat_tmp_name (char *tmp_filename)
     free (pname);
   }
 
-#elif defined (linux) || defined (__FreeBSD__) || defined (__NetBSD__) \
-  || defined (__OpenBSD__) || defined(__GLIBC__) || defined (__ANDROID__)
+#elif defined (__linux__) || defined (__FreeBSD__) || defined (__NetBSD__) \
+  || defined (__OpenBSD__) || defined (__GLIBC__) || defined (__ANDROID__) \
+  || defined (__DragonFly__) || defined (__QNX__)
 #define MAX_SAFE_PATH 1000
   char *tmpdir = getenv ("TMPDIR");
 
@@ -1178,23 +1219,37 @@ __gnat_tmp_name (char *tmp_filename)
     sprintf (tmp_filename, "%s/gnat-XXXXXX", tmpdir);
 
   close (mkstemp(tmp_filename));
-#elif defined (__vxworks) && !(defined (__RTP__) || defined (VTHREADS))
-  int             index;
-  char *          pos;
-  ushort_t        t;
+#elif defined (__vxworks) && !defined (VTHREADS)
+  int index;
+  char *pos;
+  char *savepos;
   static ushort_t seed = 0; /* used to generate unique name */
 
-  /* generate unique name */
+  /* Generate a unique name.  */
   strcpy (tmp_filename, "tmp");
 
-  /* fill up the name buffer from the last position */
   index = 5;
-  pos = tmp_filename + strlen (tmp_filename) + index;
+  savepos = pos = tmp_filename + strlen (tmp_filename) + index;
   *pos = '\0';
 
-  seed++;
-  for (t = seed; 0 <= --index; t >>= 3)
-      *--pos = '0' + (t & 07);
+  while (1)
+    {
+      FILE *f;
+      ushort_t t;
+
+      /* Fill up the name buffer from the last position.  */
+      seed++;
+      for (t = seed; --index >= 0; t >>= 3)
+        *--pos = '0' + (t & 07);
+
+      /* Check to see if its unique, if not bump the seed and try again.  */
+      f = fopen (tmp_filename, "r");
+      if (f == NULL)
+        break;
+      fclose (f);
+      pos = savepos;
+      index = 5;
+    }
 #else
   tmpnam (tmp_filename);
 #endif
@@ -1204,12 +1259,7 @@ __gnat_tmp_name (char *tmp_filename)
 
 DIR* __gnat_opendir (char *name)
 {
-#if defined (RTX)
-  /* Not supported in RTX */
-
-  return NULL;
-
-#elif defined (__MINGW32__)
+#if defined (__MINGW32__)
   TCHAR wname[GNAT_MAX_PATH_LEN];
 
   S2WSC (wname, name, GNAT_MAX_PATH_LEN);
@@ -1223,15 +1273,17 @@ DIR* __gnat_opendir (char *name)
 /* Read the next entry in a directory.  The returned string points somewhere
    in the buffer.  */
 
+#if defined (__sun__)
+/* For Solaris, be sure to use the 64-bit version, otherwise NFS reads may
+   fail with EOVERFLOW if the server uses 64-bit cookies.  */
+#define dirent dirent64
+#define readdir readdir64
+#endif
+
 char *
 __gnat_readdir (DIR *dirp, char *buffer, int *len)
 {
-#if defined (RTX)
-  /* Not supported in RTX */
-
-  return NULL;
-
-#elif defined (__MINGW32__)
+#if defined (__MINGW32__)
   struct _tdirent *dirent = _treaddir ((_TDIR*)dirp);
 
   if (dirent != NULL)
@@ -1273,12 +1325,7 @@ __gnat_readdir (DIR *dirp, char *buffer, int *len)
 
 int __gnat_closedir (DIR *dirp)
 {
-#if defined (RTX)
-  /* Not supported in RTX */
-
-  return 0;
-
-#elif defined (__MINGW32__)
+#if defined (__MINGW32__)
   return _tclosedir ((_TDIR*)dirp);
 
 #else
@@ -1298,7 +1345,7 @@ __gnat_readdir_is_thread_safe (void)
 #endif
 }
 
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>.  */
 static const unsigned long long w32_epoch_offset = 11644473600ULL;
 
@@ -1346,7 +1393,7 @@ OS_Time
 __gnat_file_time_name_attr (char* name, struct file_attributes* attr)
 {
    if (attr->timestamp == (OS_Time)-2) {
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
       BOOL res;
       WIN32_FILE_ATTRIBUTE_DATA fad;
       __time64_t ret = -1;
@@ -1377,7 +1424,7 @@ OS_Time
 __gnat_file_time_fd_attr (int fd, struct file_attributes* attr)
 {
    if (attr->timestamp == (OS_Time)-2) {
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
      HANDLE h = (HANDLE) _get_osfhandle (fd);
      time_t ret = win32_filetime (h);
      attr->timestamp = (OS_Time) ret;
@@ -1407,7 +1454,7 @@ __gnat_set_file_time_name (char *name, time_t time_stamp)
 
 /* Code to implement __gnat_set_file_time_name for these systems.  */
 
-#elif defined (_WIN32) && !defined (RTX)
+#elif defined (_WIN32)
   union
   {
     FILETIME ft_time;
@@ -1440,7 +1487,7 @@ __gnat_set_file_time_name (char *name, time_t time_stamp)
   utimbuf.modtime = time_stamp;
 
   /* Set access time to now in local time.  */
-  t = time ((time_t) 0);
+  t = time (NULL);
   utimbuf.actime = mktime (localtime (&t));
 
   utime (name, &utimbuf);
@@ -1458,8 +1505,7 @@ __gnat_get_libraries_from_registry (void)
 
   result[0] = '\0';
 
-#if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS) \
-  && ! defined (RTX)
+#if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
 
   HKEY reg_key;
   DWORD name_size, value_size;
@@ -1638,7 +1684,7 @@ __gnat_is_absolute_path (char *name, int length)
 #else
   return (length != 0) &&
      (*name == '/' || *name == DIR_SEPARATOR
-#if defined (WINNT)
+#if defined (WINNT) || defined(__DJGPP__)
       || (length > 1 && ISALPHA (name[0]) && name[1] == ':')
 #endif
          );
@@ -1691,7 +1737,7 @@ __gnat_is_directory (char *name)
    return __gnat_is_directory_attr (name, &attr);
 }
 
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
 
 /* Returns the same constant as GetDriveType but takes a pathname as
    argument. */
@@ -1879,14 +1925,14 @@ __gnat_can_use_acl (TCHAR *wname)
   return __gnat_use_acl && GetDriveTypeFromPath (wname) != DRIVE_REMOTE;
 }
 
-#endif /* defined (_WIN32) && !defined (RTX) */
+#endif /* defined (_WIN32) */
 
 int
 __gnat_is_readable_file_attr (char* name, struct file_attributes* attr)
 {
    if (attr->readable == ATTR_UNSET)
      {
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
        TCHAR wname [GNAT_MAX_PATH_LEN + 2];
        GENERIC_MAPPING GenericMapping;
 
@@ -1909,6 +1955,29 @@ __gnat_is_readable_file_attr (char* name, struct file_attributes* attr)
    return attr->readable;
 }
 
+int
+__gnat_is_read_accessible_file (char *name)
+{
+#if defined (_WIN32)
+   TCHAR wname [GNAT_MAX_PATH_LEN + 2];
+
+   S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
+
+   return !_waccess (wname, 4);
+
+#elif defined (__vxworks)
+   int fd;
+
+   if ((fd = open (name, O_RDONLY, 0)) < 0)
+     return 0;
+   close (fd);
+   return 1;
+
+#else
+   return !access (name, R_OK);
+#endif
+}
+
 int
 __gnat_is_readable_file (char *name)
 {
@@ -1923,7 +1992,7 @@ __gnat_is_writable_file_attr (char* name, struct file_attributes* attr)
 {
    if (attr->writable == ATTR_UNSET)
      {
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
        TCHAR wname [GNAT_MAX_PATH_LEN + 2];
        GENERIC_MAPPING GenericMapping;
 
@@ -1959,12 +2028,35 @@ __gnat_is_writable_file (char *name)
    return __gnat_is_writable_file_attr (name, &attr);
 }
 
+int
+__gnat_is_write_accessible_file (char *name)
+{
+#if defined (_WIN32)
+   TCHAR wname [GNAT_MAX_PATH_LEN + 2];
+
+   S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
+
+   return !_waccess (wname, 2);
+
+#elif defined (__vxworks)
+   int fd;
+
+   if ((fd = open (name, O_WRONLY, 0)) < 0)
+     return 0;
+   close (fd);
+   return 1;
+
+#else
+   return !access (name, W_OK);
+#endif
+}
+
 int
 __gnat_is_executable_file_attr (char* name, struct file_attributes* attr)
 {
    if (attr->executable == ATTR_UNSET)
      {
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
        TCHAR wname [GNAT_MAX_PATH_LEN + 2];
        GENERIC_MAPPING GenericMapping;
 
@@ -2011,7 +2103,7 @@ __gnat_is_executable_file (char *name)
 void
 __gnat_set_writable (char *name)
 {
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
   TCHAR wname [GNAT_MAX_PATH_LEN + 2];
 
   S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
@@ -2021,8 +2113,7 @@ __gnat_set_writable (char *name)
 
   SetFileAttributes
     (wname, GetFileAttributes (wname) & ~FILE_ATTRIBUTE_READONLY);
-#elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
-  ! defined(__nucleus__)
+#elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
   GNAT_STRUCT_STAT statbuf;
 
   if (GNAT_STAT (name, &statbuf) == 0)
@@ -2041,7 +2132,7 @@ __gnat_set_writable (char *name)
 void
 __gnat_set_executable (char *name, int mode ATTRIBUTE_UNUSED)
 {
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
   TCHAR wname [GNAT_MAX_PATH_LEN + 2];
 
   S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
@@ -2049,8 +2140,7 @@ __gnat_set_executable (char *name, int mode ATTRIBUTE_UNUSED)
   if (__gnat_can_use_acl (wname))
     __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_EXECUTE);
 
-#elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
-  ! defined(__nucleus__)
+#elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
   GNAT_STRUCT_STAT statbuf;
 
   if (GNAT_STAT (name, &statbuf) == 0)
@@ -2069,7 +2159,7 @@ __gnat_set_executable (char *name, int mode ATTRIBUTE_UNUSED)
 void
 __gnat_set_non_writable (char *name)
 {
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
   TCHAR wname [GNAT_MAX_PATH_LEN + 2];
 
   S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
@@ -2082,8 +2172,7 @@ __gnat_set_non_writable (char *name)
 
   SetFileAttributes
     (wname, GetFileAttributes (wname) | FILE_ATTRIBUTE_READONLY);
-#elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
-  ! defined(__nucleus__)
+#elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
   GNAT_STRUCT_STAT statbuf;
 
   if (GNAT_STAT (name, &statbuf) == 0)
@@ -2097,7 +2186,7 @@ __gnat_set_non_writable (char *name)
 void
 __gnat_set_readable (char *name)
 {
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
   TCHAR wname [GNAT_MAX_PATH_LEN + 2];
 
   S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
@@ -2105,8 +2194,7 @@ __gnat_set_readable (char *name)
   if (__gnat_can_use_acl (wname))
     __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_READ);
 
-#elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
-  ! defined(__nucleus__)
+#elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
   GNAT_STRUCT_STAT statbuf;
 
   if (GNAT_STAT (name, &statbuf) == 0)
@@ -2119,7 +2207,7 @@ __gnat_set_readable (char *name)
 void
 __gnat_set_non_readable (char *name)
 {
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
   TCHAR wname [GNAT_MAX_PATH_LEN + 2];
 
   S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
@@ -2127,8 +2215,7 @@ __gnat_set_non_readable (char *name)
   if (__gnat_can_use_acl (wname))
     __gnat_set_OWNER_ACL (wname, DENY_ACCESS, FILE_GENERIC_READ);
 
-#elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
-  ! defined(__nucleus__)
+#elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
   GNAT_STRUCT_STAT statbuf;
 
   if (GNAT_STAT (name, &statbuf) == 0)
@@ -2144,7 +2231,7 @@ __gnat_is_symbolic_link_attr (char* name ATTRIBUTE_UNUSED,
 {
    if (attr->symbolic_link == ATTR_UNSET)
      {
-#if defined (__vxworks) || defined (__nucleus__)
+#if defined (__vxworks)
        attr->symbolic_link = 0;
 
 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
@@ -2168,7 +2255,7 @@ __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED)
    return __gnat_is_symbolic_link_attr (name, &attr);
 }
 
-#if defined (sun) && defined (__SVR4)
+#if defined (__sun__)
 /* Using fork on Solaris will duplicate all the threads. fork1, which
    duplicates only the active thread, must be used instead, or spawning
    subprocess from a program with tasking will lead into numerous problems.  */
@@ -2182,11 +2269,10 @@ __gnat_portable_spawn (char *args[] ATTRIBUTE_UNUSED)
   int finished ATTRIBUTE_UNUSED;
   int pid ATTRIBUTE_UNUSED;
 
-#if defined (__vxworks) || defined(__nucleus__) || defined(RTX) \
-  || defined(__PikeOS__)
+#if defined (__vxworks) || defined(__PikeOS__)
   return -1;
 
-#elif defined (_WIN32)
+#elif defined (__DJGPP__) || defined (_WIN32)
   /* args[0] must be quotes as it could contain a full pathname with spaces */
   char *args_0 = args[0];
   args[0] = (char *)xmalloc (strlen (args_0) + 3);
@@ -2256,7 +2342,7 @@ __gnat_dup2 (int oldfd ATTRIBUTE_UNUSED, int newfd ATTRIBUTE_UNUSED)
      RTPs.  */
   return -1;
 #elif defined (__PikeOS__)
-  /* Not supported.  */
+  /* Not supported. */
   return -1;
 #elif defined (_WIN32)
   /* Special case when oldfd and newfd are identical and are the standard
@@ -2276,9 +2362,14 @@ __gnat_number_of_cpus (void)
 {
   int cores = 1;
 
-#if defined (linux) || defined (sun) || defined (AIX) || defined (__APPLE__)
+#if defined (__linux__) || defined (__sun__) || defined (_AIX) \
+  || defined (__APPLE__) || defined (__FreeBSD__) || defined (__OpenBSD__) \
+  || defined (__DragonFly__) || defined (__NetBSD__)
   cores = (int) sysconf (_SC_NPROCESSORS_ONLN);
 
+#elif defined (__QNX__)
+  cores = (int) _syspage_ptr->num_cpu;
+
 #elif defined (__hpux__)
   struct pst_dynamic psd;
   if (pstat_getdynamic (&psd, sizeof (psd), 1, 0) != -1)
@@ -2301,7 +2392,7 @@ __gnat_number_of_cpus (void)
 
 /* WIN32 code to implement a wait call that wait for any child process.  */
 
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
 
 /* Synchronization code, to be thread safe.  */
 
@@ -2311,20 +2402,29 @@ __gnat_number_of_cpus (void)
    for locking and unlocking tasks since we do not support multiple
    threads on this configuration (Cert run time on native Windows). */
 
-static void dummy (void)
-{
-}
-
-void (*Lock_Task) ()   = &dummy;
-void (*Unlock_Task) () = &dummy;
+static void EnterCS (void) {}
+static void LeaveCS (void) {}
+static void SignalListChanged (void) {}
 
 #else
 
-#define Lock_Task system__soft_links__lock_task
-extern void (*Lock_Task) (void);
+CRITICAL_SECTION ProcListCS;
+HANDLE ProcListEvt = NULL;
 
-#define Unlock_Task system__soft_links__unlock_task
-extern void (*Unlock_Task) (void);
+static void EnterCS (void)
+{
+  EnterCriticalSection(&ProcListCS);
+}
+
+static void LeaveCS (void)
+{
+  LeaveCriticalSection(&ProcListCS);
+}
+
+static void SignalListChanged (void)
+{
+  SetEvent (ProcListEvt);
+}
 
 #endif
 
@@ -2335,7 +2435,7 @@ static void
 add_handle (HANDLE h, int pid)
 {
   /* -------------------- critical section -------------------- */
-  (*Lock_Task) ();
+  EnterCS();
 
   if (plist_length == plist_max_length)
     {
@@ -2350,14 +2450,19 @@ add_handle (HANDLE h, int pid)
   PID_LIST[plist_length] = pid;
   ++plist_length;
 
-  (*Unlock_Task) ();
+  SignalListChanged();
+  LeaveCS();
   /* -------------------- critical section -------------------- */
 }
 
-static void
-remove_handle (HANDLE h, int pid)
+int
+__gnat_win32_remove_handle (HANDLE h, int pid)
 {
   int j;
+  int found = 0;
+
+  /* -------------------- critical section -------------------- */
+  EnterCS();
 
   for (j = 0; j < plist_length; j++)
     {
@@ -2367,21 +2472,18 @@ remove_handle (HANDLE h, int pid)
           --plist_length;
           HANDLES_LIST[j] = HANDLES_LIST[plist_length];
           PID_LIST[j] = PID_LIST[plist_length];
+          found = 1;
           break;
         }
     }
-}
 
-void
-__gnat_win32_remove_handle (HANDLE h, int pid)
-{
+  LeaveCS();
   /* -------------------- critical section -------------------- */
-  (*Lock_Task) ();
 
-  remove_handle(h, pid);
+  if (found)
+    SignalListChanged();
 
-  (*Unlock_Task) ();
-  /* -------------------- critical section -------------------- */
+  return found;
 }
 
 static void
@@ -2466,35 +2568,96 @@ win32_wait (int *status)
   DWORD exitcode, pid;
   HANDLE *hl;
   HANDLE h;
+  int *pidl;
   DWORD res;
   int hl_len;
+  int found;
+  int pos;
 
-  /* -------------------- critical section -------------------- */
-  (*Lock_Task) ();
+ START_WAIT:
 
   if (plist_length == 0)
     {
       errno = ECHILD;
-      (*Unlock_Task) ();
       return -1;
     }
 
+  /* -------------------- critical section -------------------- */
+  EnterCS();
+
+  /* ??? We can't wait for more than MAXIMUM_WAIT_OBJECTS due to a Win32
+     limitation */
+  if (plist_length < MAXIMUM_WAIT_OBJECTS)
   hl_len = plist_length;
+  else
+    {
+      errno = EINVAL;
+      return -1;
+    }
 
+#ifdef CERT
   hl = (HANDLE *) xmalloc (sizeof (HANDLE) * hl_len);
-
   memmove (hl, HANDLES_LIST, sizeof (HANDLE) * hl_len);
+  pidl = (int *) xmalloc (sizeof (int) * hl_len);
+  memmove (pidl, PID_LIST, sizeof (int) * hl_len);
+#else
+  /* Note that index 0 contains the event handle that is signaled when the
+     process list has changed */
+  hl = (HANDLE *) xmalloc (sizeof (HANDLE) * (hl_len + 1));
+  hl[0] = ProcListEvt;
+  memmove (&hl[1], HANDLES_LIST, sizeof (HANDLE) * hl_len);
+  pidl = (int *) xmalloc (sizeof (int) * (hl_len + 1));
+  memmove (&pidl[1], PID_LIST, sizeof (int) * hl_len);
+  hl_len++;
+#endif
+
+  LeaveCS();
+  /* -------------------- critical section -------------------- */
 
   res = WaitForMultipleObjects (hl_len, hl, FALSE, INFINITE);
-  h = hl[res - WAIT_OBJECT_0];
 
+  /* If there was an error, exit now */
+  if (res == WAIT_FAILED)
+    {
+      free (hl);
+      free (pidl);
+      errno = EINVAL;
+      return -1;
+    }
+
+  /* if the ProcListEvt has been signaled then the list of processes has been
+     updated to add or remove a handle, just loop over */
+
+  if (res - WAIT_OBJECT_0 == 0)
+    {
+      free (hl);
+      free (pidl);
+      goto START_WAIT;
+    }
+
+  /* Handle two distinct groups of return codes: finished waits and abandoned
+     waits */
+
+  if (res < WAIT_ABANDONED_0)
+    pos = res - WAIT_OBJECT_0;
+  else
+    pos = res - WAIT_ABANDONED_0;
+
+  h = hl[pos];
   GetExitCodeProcess (h, &exitcode);
-  pid = PID_LIST [res - WAIT_OBJECT_0];
-  remove_handle (h, -1);
+  pid = pidl [pos];
+
+  found = __gnat_win32_remove_handle (h, -1);
 
-  (*Unlock_Task) ();
-  /* -------------------- critical section -------------------- */
   free (hl);
+  free (pidl);
+
+  /* if not found another process waiting has already handled this process */
+
+  if (!found)
+    {
+      goto START_WAIT;
+    }
 
   *status = (int) exitcode;
   return (int) pid;
@@ -2506,11 +2669,16 @@ int
 __gnat_portable_no_block_spawn (char *args[] ATTRIBUTE_UNUSED)
 {
 
-#if defined (__vxworks) || defined (__nucleus__) || defined (RTX) \
-  || defined (__PikeOS__)
+#if defined (__vxworks) || defined (__PikeOS__)
   /* Not supported.  */
   return -1;
 
+#elif defined(__DJGPP__)
+  if (spawnvp (P_WAIT, args[0], args) != 0)
+    return -1;
+  else
+    return 0;
+
 #elif defined (_WIN32)
 
   HANDLE h = NULL;
@@ -2547,14 +2715,16 @@ __gnat_portable_wait (int *process_status)
   int status = 0;
   int pid = 0;
 
-#if defined (__vxworks) || defined (__nucleus__) || defined (RTX) \
-  || defined (__PikeOS__)
+#if defined (__vxworks) || defined (__PikeOS__)
   /* Not sure what to do here, so do nothing but return zero.  */
 
 #elif defined (_WIN32)
 
   pid = win32_wait (&status);
 
+#elif defined (__DJGPP__)
+  /* Child process has already ended in case of DJGPP.
+     No need to do anything. Just return success. */
 #else
 
   pid = waitpid (-1, &status, 0);
@@ -2565,12 +2735,48 @@ __gnat_portable_wait (int *process_status)
   return pid;
 }
 
+int
+__gnat_portable_no_block_wait (int *process_status)
+{
+  int status = 0;
+  int pid = 0;
+
+#if defined (__vxworks) || defined (__PikeOS__) || defined (_WIN32)
+  /* Not supported. */
+  status = -1;
+
+#else
+
+  pid = waitpid (-1, &status, WNOHANG);
+  status = status & 0xffff;
+#endif
+
+  *process_status = status;
+  return pid;
+}
+
 void
 __gnat_os_exit (int status)
 {
   exit (status);
 }
 
+int
+__gnat_current_process_id (void)
+{
+#if defined (__vxworks) || defined (__PikeOS__)
+  return -1;
+
+#elif defined (_WIN32)
+
+  return (int)GetCurrentProcessId();
+
+#else
+
+  return (int)getpid();
+#endif
+}
+
 /* Locate file on path, that matches a predicate */
 
 char *
@@ -2699,12 +2905,12 @@ __gnat_locate_regular_file (char *file_name, char *path_val)
 char *
 __gnat_locate_exec (char *exec_name, char *path_val)
 {
+  const unsigned int len = strlen (HOST_EXECUTABLE_SUFFIX);
   char *ptr;
-  if (!strstr (exec_name, HOST_EXECUTABLE_SUFFIX))
+
+  if (len > 0 && !strstr (exec_name, HOST_EXECUTABLE_SUFFIX))
     {
-      char *full_exec_name =
-        (char *) alloca
-         (strlen (exec_name) + strlen (HOST_EXECUTABLE_SUFFIX) + 1);
+      char *full_exec_name = (char *) alloca (strlen (exec_name) + len + 1);
 
       strcpy (full_exec_name, exec_name);
       strcat (full_exec_name, HOST_EXECUTABLE_SUFFIX);
@@ -2725,7 +2931,7 @@ __gnat_locate_exec_on_path (char *exec_name)
 {
   char *apath_val;
 
-#if defined (_WIN32) && !defined (RTX)
+#if defined (_WIN32)
   TCHAR *wpath_val = _tgetenv (_T("PATH"));
   TCHAR *wapath_val;
   /* In Win32 systems we expand the PATH as for XP environment
@@ -2747,16 +2953,19 @@ __gnat_locate_exec_on_path (char *exec_name)
   apath_val = (char *) alloca (EXPAND_BUFFER_SIZE);
 
   WS2SC (apath_val, wapath_val, EXPAND_BUFFER_SIZE);
-  return __gnat_locate_exec (exec_name, apath_val);
 
 #else
-  char *path_val = getenv ("PATH");
+  const char *path_val = getenv ("PATH");
+
+  /* If PATH is not defined, proceed with __gnat_locate_exec anyway, so we can
+     find files that contain directory names.  */
 
-  if (path_val == NULL) return NULL;
+  if (path_val == NULL) path_val = "";
   apath_val = (char *) alloca (strlen (path_val) + 1);
   strcpy (apath_val, path_val);
-  return __gnat_locate_exec (exec_name, apath_val);
 #endif
+
+  return __gnat_locate_exec (exec_name, apath_val);
 }
 
 /* Dummy functions for Osint import for non-VMS systems.
@@ -2858,17 +3067,18 @@ char __gnat_environment_char = '$';
    mode = 1  : In this mode, time stamps and read/write/execute attributes are
                copied.
 
+   mode = 2  : In this mode, only read/write/execute attributes are copied
+
    Returns 0 if operation was successful and -1 in case of error. */
 
 int
 __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED, char *to ATTRIBUTE_UNUSED,
                      int mode ATTRIBUTE_UNUSED)
 {
-#if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) || \
-  defined (__nucleus__)
+#if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
   return -1;
 
-#elif defined (_WIN32) && !defined (RTX)
+#elif defined (_WIN32)
   TCHAR wfrom [GNAT_MAX_PATH_LEN + 2];
   TCHAR wto [GNAT_MAX_PATH_LEN + 2];
   BOOL res;
@@ -2878,39 +3088,46 @@ __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED, char *to ATTRIBUTE_UNUSED,
   S2WSC (wfrom, from, GNAT_MAX_PATH_LEN + 2);
   S2WSC (wto, to, GNAT_MAX_PATH_LEN + 2);
 
-  /* retrieve from times */
+  /*  Do we need to copy the timestamp ? */
 
-  hfrom = CreateFile
-    (wfrom, GENERIC_READ, 0, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
+  if (mode != 2) {
+     /* retrieve from times */
 
-  if (hfrom == INVALID_HANDLE_VALUE)
-    return -1;
+     hfrom = CreateFile
+       (wfrom, GENERIC_READ, 0, NULL, OPEN_EXISTING,
+        FILE_ATTRIBUTE_NORMAL, NULL);
 
-  res = GetFileTime (hfrom, &fct, &flat, &flwt);
+     if (hfrom == INVALID_HANDLE_VALUE)
+       return -1;
 
-  CloseHandle (hfrom);
+     res = GetFileTime (hfrom, &fct, &flat, &flwt);
 
-  if (res == 0)
-    return -1;
+     CloseHandle (hfrom);
 
-  /* retrieve from times */
+     if (res == 0)
+       return -1;
 
-  hto = CreateFile
-    (wto, GENERIC_WRITE, 0, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
+     /* retrieve from times */
 
-  if (hto == INVALID_HANDLE_VALUE)
-    return -1;
+     hto = CreateFile
+       (wto, GENERIC_WRITE, 0, NULL, OPEN_EXISTING,
+        FILE_ATTRIBUTE_NORMAL, NULL);
 
-  res = SetFileTime (hto, NULL, &flat, &flwt);
+     if (hto == INVALID_HANDLE_VALUE)
+       return -1;
 
-  CloseHandle (hto);
+     res = SetFileTime (hto, NULL, &flat, &flwt);
 
-  if (res == 0)
-    return -1;
+     CloseHandle (hto);
+
+     if (res == 0)
+       return -1;
+  }
 
+  /* Do we need to copy the permissions ? */
   /* Set file attributes in full mode. */
 
-  if (mode == 1)
+  if (mode != 0)
     {
       DWORD attribs = GetFileAttributes (wfrom);
 
@@ -2928,26 +3145,24 @@ __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED, char *to ATTRIBUTE_UNUSED,
   GNAT_STRUCT_STAT fbuf;
   struct utimbuf tbuf;
 
-  if (GNAT_STAT (from, &fbuf) == -1)
-    {
-      return -1;
-    }
+  if (GNAT_STAT (from, &fbuf) == -1) {
+     return -1;
+  }
 
-  tbuf.actime = fbuf.st_atime;
-  tbuf.modtime = fbuf.st_mtime;
+  /* Do we need to copy timestamp ? */
+  if (mode != 2) {
+     tbuf.actime = fbuf.st_atime;
+     tbuf.modtime = fbuf.st_mtime;
 
-  if (utime (to, &tbuf) == -1)
-    {
-      return -1;
-    }
+     if (utime (to, &tbuf) == -1) {
+        return -1;
+     }
+  }
 
-  if (mode == 1)
-    {
-      if (chmod (to, fbuf.st_mode) == -1)
-       {
+  /* Do we need to copy file permissions ? */
+  if (mode != 0 && (chmod (to, fbuf.st_mode) == -1)) {
          return -1;
-       }
-    }
+  }
 
   return 0;
 #endif
@@ -3022,48 +3237,7 @@ __gnat_sals_init_using_constructors (void)
 #endif
 }
 
-#ifdef RTX
-
-/* In RTX mode, the procedure to get the time (as file time) is different
-   in RTSS mode and Win32 mode. In order to avoid duplicating an Ada file,
-   we introduce an intermediate procedure to link against the corresponding
-   one in each situation. */
-
-extern void GetTimeAsFileTime (LPFILETIME pTime);
-
-void GetTimeAsFileTime (LPFILETIME pTime)
-{
-#ifdef RTSS
-  RtGetRtssTimeAsFileTime (pTime); /* RTSS interface */
-#else
-  GetSystemTimeAsFileTime (pTime); /* w32 interface */
-#endif
-}
-
-#ifdef RTSS
-/* Add symbol that is required to link. It would otherwise be taken from
-   libgcc.a and it would try to use the gcc constructors that are not
-   supported by Microsoft linker. */
-
-extern void __main (void);
-
-void __main (void)
-{
-}
-#endif /* RTSS */
-#endif /* RTX */
-
-#if defined (__ANDROID__)
-
-#include <pthread.h>
-
-void *
-__gnat_lwp_self (void)
-{
-   return (void *) pthread_self ();
-}
-
-#elif defined (linux)
+#if defined (__linux__) || defined (__ANDROID__)
 /* There is no function in the glibc to retrieve the LWP of the current
    thread. We need to do a system call in order to retrieve this
    information. */
@@ -3073,7 +3247,41 @@ __gnat_lwp_self (void)
 {
    return (void *) syscall (__NR_gettid);
 }
+#endif
+
+#if defined (__APPLE__)
+# if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ >= 1060
+#  include <mach/thread_info.h>
+#  include <mach/mach_init.h>
+#  include <mach/thread_act.h>
+# else
+#  include <pthread.h>
+# endif
+
+/* System-wide thread identifier.  Note it could be truncated on 32 bit
+   hosts.
+   Previously was: pthread_mach_thread_np (pthread_self ()).  */
+void *
+__gnat_lwp_self (void)
+{
+#if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ >= 1060
+  thread_identifier_info_data_t data;
+  mach_msg_type_number_t count = THREAD_IDENTIFIER_INFO_COUNT;
+  kern_return_t kret;
+
+  kret = thread_info (mach_thread_self (), THREAD_IDENTIFIER_INFO,
+                     (thread_info_t) &data, &count);
+  if (kret == KERN_SUCCESS)
+    return (void *)(uintptr_t)data.thread_id;
+  else
+    return 0;
+#else
+  return (void *)pthread_mach_thread_np (pthread_self ());
+#endif
+}
+#endif
 
+#if defined (__linux__)
 #include <sched.h>
 
 /* glibc versions earlier than 2.7 do not define the routines to handle
@@ -3152,7 +3360,7 @@ __gnat_cpu_set (int cpu, size_t count ATTRIBUTE_UNUSED, cpu_set_t *set)
   CPU_SET (cpu - 1, set);
 }
 #endif /* !CPU_ALLOC */
-#endif /* linux */
+#endif /* __linux__ */
 
 /* Return the load address of the executable, or 0 if not known.  In the
    specific case of error, (void *)-1 can be returned. Beware: this unit may
@@ -3161,8 +3369,6 @@ __gnat_cpu_set (int cpu, size_t count ATTRIBUTE_UNUSED, cpu_set_t *set)
 
 #if defined (__APPLE__)
 #include <mach-o/dyld.h>
-#elif 0 && defined (__linux__)
-#include <link.h>
 #endif
 
 const void *
@@ -3182,6 +3388,136 @@ __gnat_get_executable_load_address (void)
 #endif
 }
 
+void
+__gnat_kill (int pid, int sig, int close ATTRIBUTE_UNUSED)
+{
+#if defined(_WIN32)
+  HANDLE h = OpenProcess (PROCESS_ALL_ACCESS, FALSE, pid);
+  if (h == NULL)
+    return;
+  if (sig == 9)
+    {
+      TerminateProcess (h, 1);
+    }
+  else if (sig == SIGINT)
+    GenerateConsoleCtrlEvent (CTRL_C_EVENT, pid);
+  else if (sig == SIGBREAK)
+    GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid);
+  /* ??? The last two alternatives don't really work. SIGBREAK requires setting
+     up process groups at start time which we don't do; treating SIGINT is just
+     not possible apparently. So we really only support signal 9. Fortunately
+     that's all we use in GNAT.Expect */
+
+  CloseHandle (h);
+#elif defined (__vxworks)
+  /* Not implemented */
+#else
+  kill (pid, sig);
+#endif
+}
+
+void __gnat_killprocesstree (int pid, int sig_num)
+{
+#if defined(_WIN32)
+  PROCESSENTRY32 pe;
+
+  memset(&pe, 0, sizeof(PROCESSENTRY32));
+  pe.dwSize = sizeof(PROCESSENTRY32);
+
+  HANDLE hSnap = CreateToolhelp32Snapshot (TH32CS_SNAPPROCESS, 0);
+
+  /*  cannot take snapshot, just kill the parent process */
+
+  if (hSnap == INVALID_HANDLE_VALUE)
+    {
+      __gnat_kill (pid, sig_num, 1);
+      return;
+    }
+
+  if (Process32First(hSnap, &pe))
+    {
+      BOOL bContinue = TRUE;
+
+      /* kill child processes first */
+
+      while (bContinue)
+        {
+          if (pe.th32ParentProcessID == (DWORD)pid)
+            __gnat_killprocesstree (pe.th32ProcessID, sig_num);
+
+          bContinue = Process32Next (hSnap, &pe);
+        }
+    }
+
+  CloseHandle (hSnap);
+
+  /* kill process */
+
+  __gnat_kill (pid, sig_num, 1);
+
+#elif defined (__vxworks)
+  /* not implemented */
+
+#elif defined (__linux__)
+  DIR *dir;
+  struct dirent *d;
+
+  /*  read all processes' pid and ppid */
+
+  dir = opendir ("/proc");
+
+  /*  cannot open proc, just kill the parent process */
+
+  if (!dir)
+    {
+      __gnat_kill (pid, sig_num, 1);
+      return;
+    }
+
+  /* kill child processes first */
+
+  while ((d = readdir (dir)) != NULL)
+    {
+      if ((d->d_type & DT_DIR) == DT_DIR)
+        {
+          char statfile[64];
+          int _pid, _ppid;
+
+          /* read /proc/<PID>/stat */
+
+          if (strlen (d->d_name) >= sizeof (statfile) - strlen ("/proc//stat"))
+            continue;
+          strcpy (statfile, "/proc/");
+          strcat (statfile, d->d_name);
+          strcat (statfile, "/stat");
+
+          FILE *fd = fopen (statfile, "r");
+
+          if (fd)
+            {
+              const int match = fscanf (fd, "%d %*s %*s %d", &_pid, &_ppid);
+              fclose (fd);
+
+              if (match == 2 && _ppid == pid)
+                __gnat_killprocesstree (_pid, sig_num);
+            }
+        }
+    }
+
+  closedir (dir);
+
+  /* kill process */
+
+  __gnat_kill (pid, sig_num, 1);
+#else
+  __gnat_kill (pid, sig_num, 1);
+#endif
+  /* Note on Solaris it is possible to read /proc/<PID>/status.
+     The 5th and 6th words are the pid and the 7th and 8th the ppid.
+     See: /usr/include/sys/procfs.h (struct pstatus).
+  */
+}
+
 #ifdef __cplusplus
 }
 #endif