OSDN Git Service

2011-05-25 Kai Tietz <ktietz@redhat.com>
[pf3gnuchains/gcc-fork.git] / gcc / ada / adaint.c
index 3ac773d..bea33f6 100644 (file)
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2009, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-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- *
 
 #endif /* VxWorks */
 
+#if (defined (__mips) && defined (__sgi)) || defined (__APPLE__)
+#include <unistd.h>
+#endif
+
+#if defined (__hpux__)
+#include <sys/param.h>
+#include <sys/pstat.h>
+#endif
+
 #ifdef VMS
 #define _POSIX_EXIT 1
 #define HOST_EXECUTABLE_SUFFIX ".exe"
@@ -132,7 +141,7 @@ UINT CurrentCodePage;
 #include <sys/wait.h>
 #endif
 
-#if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
+#if defined (_WIN32)
 #elif defined (VMS)
 
 /* Header files and definitions for __gnat_set_file_time_name.  */
@@ -179,15 +188,19 @@ struct vstring
   char string[NAM$C_MAXRSS+1];
 };
 
+#define SYI$_ACTIVECPU_CNT 0x111e
+extern int LIB$GETSYI (int *, unsigned int *);
+
 #else
 #include <utime.h>
 #endif
 
-#if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
+#if defined (_WIN32)
 #include <process.h>
 #endif
 
 #if defined (_WIN32)
+
 #include <dir.h>
 #include <windows.h>
 #include <accctrl.h>
@@ -204,14 +217,6 @@ struct vstring
    external file mapped to LF in internal file), but in Unix-like systems,
    no text translation is required, so these flags have no effect.  */
 
-#if defined (__EMX__)
-#include <os2.h>
-#endif
-
-#if defined (MSDOS)
-#include <dos.h>
-#endif
-
 #ifndef O_BINARY
 #define O_BINARY 0
 #endif
@@ -274,9 +279,7 @@ char __gnat_path_separator = PATH_SEPARATOR;
        as well. This is only a temporary work-around for 3.11b.  */
 
 #ifndef GNAT_LIBRARY_TEMPLATE
-#if defined (__EMX__)
-#define GNAT_LIBRARY_TEMPLATE "*.a"
-#elif defined (VMS)
+#if defined (VMS)
 #define GNAT_LIBRARY_TEMPLATE "*.olb"
 #else
 #define GNAT_LIBRARY_TEMPLATE "lib*.a"
@@ -293,10 +296,7 @@ const int __gnat_vmsp = 1;
 const int __gnat_vmsp = 0;
 #endif
 
-#ifdef __EMX__
-#define GNAT_MAX_PATH_LEN MAX_PATH
-
-#elif defined (VMS)
+#if defined (VMS)
 #define GNAT_MAX_PATH_LEN 256 /* PATH_MAX */
 
 #elif defined (__vxworks) || defined (__OPENNT) || defined(__nucleus__)
@@ -323,6 +323,12 @@ const int __gnat_vmsp = 0;
 
 #endif
 
+/* Used for Ada bindings */
+const int __gnat_size_of_file_attributes = sizeof (struct file_attributes);
+
+/* Reset the file attributes as if no system call had been performed */
+void __gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr);
+
 /* The __gnat_max_path_len variable is used to export the maximum
    length of a path name to Ada code. max_path_len is also provided
    for compatibility with older GNAT versions, please do not use
@@ -331,6 +337,10 @@ const int __gnat_vmsp = 0;
 int __gnat_max_path_len = GNAT_MAX_PATH_LEN;
 int max_path_len = GNAT_MAX_PATH_LEN;
 
+/* Control whether we can use ACL on Windows.  */
+
+int __gnat_use_acl = 1;
+
 /* The following macro HAVE_READDIR_R should be defined if the
    system provides the routine readdir_r.  */
 #undef HAVE_READDIR_R
@@ -366,6 +376,26 @@ to_ptr32 (char **ptr64)
 #define MAYBE_TO_PTR32(argv) argv
 #endif
 
+static const char ATTR_UNSET = 127;
+
+void
+__gnat_reset_attributes
+  (struct file_attributes* attr)
+{
+  attr->exists     = ATTR_UNSET;
+
+  attr->writable   = ATTR_UNSET;
+  attr->readable   = ATTR_UNSET;
+  attr->executable = ATTR_UNSET;
+
+  attr->regular    = ATTR_UNSET;
+  attr->symbolic_link = ATTR_UNSET;
+  attr->directory = ATTR_UNSET;
+
+  attr->timestamp = (OS_Time)-2;
+  attr->file_length = -1;
+}
+
 OS_Time
 __gnat_current_time
   (void)
@@ -447,8 +477,8 @@ __gnat_readlink (char *path ATTRIBUTE_UNUSED,
                 char *buf ATTRIBUTE_UNUSED,
                 size_t bufsiz ATTRIBUTE_UNUSED)
 {
-#if defined (MSDOS) || defined (_WIN32) || defined (__EMX__) \
-  || defined (VMS) || defined(__vxworks) || defined (__nucleus__)
+#if defined (_WIN32) || defined (VMS) \
+    || defined(__vxworks) || defined (__nucleus__)
   return -1;
 #else
   return readlink (path, buf, bufsiz);
@@ -463,8 +493,8 @@ int
 __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED,
                char *newpath ATTRIBUTE_UNUSED)
 {
-#if defined (MSDOS) || defined (_WIN32) || defined (__EMX__) \
-  || defined (VMS) || defined(__vxworks) || defined (__nucleus__)
+#if defined (_WIN32) || defined (VMS) \
+    || defined(__vxworks) || defined (__nucleus__)
   return -1;
 #else
   return symlink (oldpath, newpath);
@@ -473,8 +503,8 @@ __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED,
 
 /* Try to lock a file, return 1 if success.  */
 
-#if defined (__vxworks) || defined (__nucleus__) || defined (MSDOS) \
-  || defined (_WIN32) || defined (__EMX__) || defined (VMS)
+#if defined (__vxworks) || defined (__nucleus__) \
+  || defined (_WIN32) || defined (VMS)
 
 /* Version that does not use link. */
 
@@ -516,7 +546,7 @@ __gnat_try_lock (char *dir, char *file)
 {
   char full_path[256];
   char temp_file[256];
-  struct stat stat_result;
+  GNAT_STRUCT_STAT stat_result;
   int fd;
 
   sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
@@ -546,9 +576,7 @@ __gnat_try_lock (char *dir, char *file)
 int
 __gnat_get_maximum_file_name_length (void)
 {
-#if defined (MSDOS)
-  return 8;
-#elif defined (VMS)
+#if defined (VMS)
   if (getenv ("GNAT$EXTENDED_FILE_SPECIFICATIONS"))
     return -1;
   else
@@ -563,21 +591,36 @@ __gnat_get_maximum_file_name_length (void)
 int
 __gnat_get_file_names_case_sensitive (void)
 {
-#if defined (__EMX__) || defined (MSDOS) || defined (VMS) || defined (WINNT)
-  return 0;
+  const char *sensitive = getenv ("GNAT_FILE_NAME_CASE_SENSITIVE");
+
+  if (sensitive != NULL
+      && (sensitive[0] == '0' || sensitive[0] == '1')
+      && sensitive[1] == '\0')
+    return sensitive[0] - '0';
+  else
+#if defined (VMS) || defined (WINNT) || defined (__APPLE__)
+    return 0;
 #else
-  return 1;
+    return 1;
+#endif
+}
+
+/* Return nonzero if environment variables are case sensitive.  */
+
+int
+__gnat_get_env_vars_case_sensitive (void)
+{
+#if defined (VMS) || defined (WINNT)
+ return 0;
+#else
+ return 1;
 #endif
 }
 
 char
 __gnat_get_default_identifier_character_set (void)
 {
-#if defined (__EMX__) || defined (MSDOS)
-  return 'p';
-#else
   return '1';
-#endif
 }
 
 /* Return the current working directory.  */
@@ -644,12 +687,7 @@ __gnat_get_executable_suffix_ptr (int *len, const char **value)
 void
 __gnat_get_debuggable_suffix_ptr (int *len, const char **value)
 {
-#ifndef MSDOS
   *value = HOST_EXECUTABLE_SUFFIX;
-#else
-  /* On DOS, the extensionless COFF file is what gdb likes.  */
-  *value = "";
-#endif
 
   if (*value == 0)
     *len = 0;
@@ -662,12 +700,13 @@ __gnat_get_debuggable_suffix_ptr (int *len, const char **value)
 /* Returns the OS filename and corresponding encoding.  */
 
 void
-__gnat_os_filename (char *filename, char *w_filename ATTRIBUTE_UNUSED,
+__gnat_os_filename (char *filename ATTRIBUTE_UNUSED,
+                   char *w_filename ATTRIBUTE_UNUSED,
                    char *os_name, int *o_length,
                    char *encoding ATTRIBUTE_UNUSED, int *e_length)
 {
 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
-  WS2SC (os_name, (TCHAR *)w_filename, o_length);
+  WS2SC (os_name, (TCHAR *)w_filename, (DWORD)*o_length);
   *o_length = strlen (os_name);
   strcpy (encoding, "encoding=utf8");
   *e_length = strlen (encoding);
@@ -742,6 +781,9 @@ __gnat_rmdir (char *path)
     S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
     return _trmdir (wpath);
   }
+#elif defined (VTHREADS)
+  /* rmdir not available */
+  return -1;
 #else
   return rmdir (path);
 #endif
@@ -767,12 +809,15 @@ __gnat_fopen (char *path, char *mode, int encoding ATTRIBUTE_UNUSED)
 #elif defined (VMS)
   return decc$fopen (path, mode);
 #else
-  return fopen (path, mode);
+  return GNAT_FOPEN (path, mode);
 #endif
 }
 
 FILE *
-__gnat_freopen (char *path, char *mode, FILE *stream, int encoding ATTRIBUTE_UNUSED)
+__gnat_freopen (char *path,
+               char *mode,
+               FILE *stream,
+               int encoding ATTRIBUTE_UNUSED)
 {
 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
   TCHAR wpath[GNAT_MAX_PATH_LEN];
@@ -824,7 +869,7 @@ __gnat_open_read (char *path, int fmode)
   return fd < 0 ? -1 : fd;
 }
 
-#if defined (__EMX__) || defined (__MINGW32__)
+#if defined (__MINGW32__)
 #define PERM (S_IREAD | S_IWRITE)
 #elif defined (VMS)
 /* Excerpt from DECC C RTL Reference Manual:
@@ -914,6 +959,28 @@ __gnat_create_output_file (char *path)
 }
 
 int
+__gnat_create_output_file_new (char *path)
+{
+  int fd;
+#if defined (VMS)
+  fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM,
+             "rfm=stmlf", "ctx=rec", "rat=none", "rop=nlk",
+             "shr=del,get,put,upd");
+#elif defined (__MINGW32__)
+  {
+    TCHAR wpath[GNAT_MAX_PATH_LEN];
+
+    S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
+    fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM);
+  }
+#else
+  fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM);
+#endif
+
+  return fd < 0 ? -1 : fd;
+}
+
+int
 __gnat_open_append (char *path, int fmode)
 {
   int fd;
@@ -1005,34 +1072,82 @@ __gnat_open_new_temp (char *path, int fmode)
   return fd < 0 ? -1 : fd;
 }
 
-/* Return the number of bytes in the specified file.  */
+/****************************************************************
+ ** Perform a call to GNAT_STAT or GNAT_FSTAT, and extract as much information
+ ** as possible from it, storing the result in a cache for later reuse
+ ****************************************************************/
 
-long
-__gnat_file_length (int fd)
+void
+__gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr)
 {
+  GNAT_STRUCT_STAT statbuf;
   int ret;
-  struct stat statbuf;
 
-  ret = fstat (fd, &statbuf);
-  if (ret || !S_ISREG (statbuf.st_mode))
-    return 0;
+  if (fd != -1)
+    ret = GNAT_FSTAT (fd, &statbuf);
+  else
+    ret = __gnat_stat (name, &statbuf);
+
+  attr->regular   = (!ret && S_ISREG (statbuf.st_mode));
+  attr->directory = (!ret && S_ISDIR (statbuf.st_mode));
 
-  return (statbuf.st_size);
+  if (!attr->regular)
+    attr->file_length = 0;
+  else
+    /* st_size may be 32 bits, or 64 bits which is converted to long. We
+       don't return a useful value for files larger than 2 gigabytes in
+       either case. */
+    attr->file_length = statbuf.st_size;  /* all systems */
+
+  attr->exists = !ret;
+
+#if !defined (_WIN32) || defined (RTX)
+  /* 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));
+  attr->executable = (!ret && (statbuf.st_mode & S_IXUSR));
+#endif
+
+  if (ret != 0) {
+     attr->timestamp = (OS_Time)-1;
+  } else {
+#ifdef VMS
+     /* VMS has file versioning.  */
+     attr->timestamp = (OS_Time)statbuf.st_ctime;
+#else
+     attr->timestamp = (OS_Time)statbuf.st_mtime;
+#endif
+  }
 }
 
-/* Return the number of bytes in the specified named file.  */
+/****************************************************************
+ ** Return the number of bytes in the specified file
+ ****************************************************************/
 
 long
-__gnat_named_file_length (char *name)
+__gnat_file_length_attr (int fd, char* name, struct file_attributes* attr)
 {
-  int ret;
-  struct stat statbuf;
+  if (attr->file_length == -1) {
+    __gnat_stat_to_attr (fd, name, attr);
+  }
 
-  ret = __gnat_stat (name, &statbuf);
-  if (ret || !S_ISREG (statbuf.st_mode))
-    return 0;
+  return attr->file_length;
+}
+
+long
+__gnat_file_length (int fd)
+{
+  struct file_attributes attr;
+  __gnat_reset_attributes (&attr);
+  return __gnat_file_length_attr (fd, NULL, &attr);
+}
 
-  return (statbuf.st_size);
+long
+__gnat_named_file_length (char *name)
+{
+  struct file_attributes attr;
+  __gnat_reset_attributes (&attr);
+  return __gnat_file_length_attr (-1, name, &attr);
 }
 
 /* Create a temporary filename and put it in string pointed to by
@@ -1222,142 +1337,78 @@ win32_filetime (HANDLE h)
     return (time_t) (t_write.ull_time / 10000000ULL - w32_epoch_offset);
   return (time_t) 0;
 }
+
+/* As above but starting from a FILETIME.  */
+static void
+f2t (const FILETIME *ft, time_t *t)
+{
+  union
+  {
+    FILETIME ft_time;
+    unsigned long long ull_time;
+  } t_write;
+
+  t_write.ft_time = *ft;
+  *t = (time_t) (t_write.ull_time / 10000000ULL - w32_epoch_offset);
+}
 #endif
 
 /* Return a GNAT time stamp given a file name.  */
 
 OS_Time
-__gnat_file_time_name (char *name)
+__gnat_file_time_name_attr (char* name, struct file_attributes* attr)
 {
+   if (attr->timestamp == (OS_Time)-2) {
+#if defined (_WIN32) && !defined (RTX)
+      BOOL res;
+      WIN32_FILE_ATTRIBUTE_DATA fad;
+      time_t ret = -1;
+      TCHAR wname[GNAT_MAX_PATH_LEN];
+      S2WSC (wname, name, GNAT_MAX_PATH_LEN);
 
-#if defined (__EMX__) || defined (MSDOS)
-  int fd = open (name, O_RDONLY | O_BINARY);
-  time_t ret = __gnat_file_time_fd (fd);
-  close (fd);
-  return (OS_Time)ret;
-
-#elif defined (_WIN32) && !defined (RTX)
-  time_t ret = -1;
-  TCHAR wname[GNAT_MAX_PATH_LEN];
-
-  S2WSC (wname, name, GNAT_MAX_PATH_LEN);
-
-  HANDLE h = CreateFile
-    (wname, GENERIC_READ, FILE_SHARE_READ, 0,
-     OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
-
-  if (h != INVALID_HANDLE_VALUE)
-    {
-      ret = win32_filetime (h);
-      CloseHandle (h);
-    }
-  return (OS_Time) ret;
-#else
-  struct stat statbuf;
-  if (__gnat_stat (name, &statbuf) != 0) {
-     return (OS_Time)-1;
-  } else {
-#ifdef VMS
-     /* VMS has file versioning.  */
-     return (OS_Time)statbuf.st_ctime;
+      if (res = GetFileAttributesEx (wname, GetFileExInfoStandard, &fad))
+       f2t (&fad.ftLastWriteTime, &ret);
+      attr->timestamp = (OS_Time) ret;
 #else
-     return (OS_Time)statbuf.st_mtime;
+      __gnat_stat_to_attr (-1, name, attr);
 #endif
   }
-#endif
+  return attr->timestamp;
 }
 
-/* Return a GNAT time stamp given a file descriptor.  */
-
 OS_Time
-__gnat_file_time_fd (int fd)
+__gnat_file_time_name (char *name)
 {
-  /* The following workaround code is due to the fact that under EMX and
-     DJGPP fstat attempts to convert time values to GMT rather than keep the
-     actual OS timestamp of the file. By using the OS2/DOS functions directly
-     the GNAT timestamp are independent of this behavior, which is desired to
-     facilitate the distribution of GNAT compiled libraries.  */
-
-#if defined (__EMX__) || defined (MSDOS)
-#ifdef __EMX__
+   struct file_attributes attr;
+   __gnat_reset_attributes (&attr);
+   return __gnat_file_time_name_attr (name, &attr);
+}
 
-  FILESTATUS fs;
-  int ret = DosQueryFileInfo (fd, 1, (unsigned char *) &fs,
-                                sizeof (FILESTATUS));
+/* Return a GNAT time stamp given a file descriptor.  */
 
-  unsigned file_year  = fs.fdateLastWrite.year;
-  unsigned file_month = fs.fdateLastWrite.month;
-  unsigned file_day   = fs.fdateLastWrite.day;
-  unsigned file_hour  = fs.ftimeLastWrite.hours;
-  unsigned file_min   = fs.ftimeLastWrite.minutes;
-  unsigned file_tsec  = fs.ftimeLastWrite.twosecs;
+OS_Time
+__gnat_file_time_fd_attr (int fd, struct file_attributes* attr)
+{
+   if (attr->timestamp == (OS_Time)-2) {
+#if defined (_WIN32) && !defined (RTX)
+     HANDLE h = (HANDLE) _get_osfhandle (fd);
+     time_t ret = win32_filetime (h);
+     attr->timestamp = (OS_Time) ret;
 
 #else
-  struct ftime fs;
-  int ret = getftime (fd, &fs);
-
-  unsigned file_year  = fs.ft_year;
-  unsigned file_month = fs.ft_month;
-  unsigned file_day   = fs.ft_day;
-  unsigned file_hour  = fs.ft_hour;
-  unsigned file_min   = fs.ft_min;
-  unsigned file_tsec  = fs.ft_tsec;
+     __gnat_stat_to_attr (fd, NULL, attr);
 #endif
+   }
 
-  /* Calculate the seconds since epoch from the time components. First count
-     the whole days passed.  The value for years returned by the DOS and OS2
-     functions count years from 1980, so to compensate for the UNIX epoch which
-     begins in 1970 start with 10 years worth of days and add days for each
-     four year period since then.  */
-
-  time_t tot_secs;
-  int cum_days[12] = {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334};
-  int days_passed = 3652 + (file_year / 4) * 1461;
-  int years_since_leap = file_year % 4;
-
-  if (years_since_leap == 1)
-    days_passed += 366;
-  else if (years_since_leap == 2)
-    days_passed += 731;
-  else if (years_since_leap == 3)
-    days_passed += 1096;
-
-  if (file_year > 20)
-    days_passed -= 1;
-
-  days_passed += cum_days[file_month - 1];
-  if (years_since_leap == 0 && file_year != 20 && file_month > 2)
-    days_passed++;
-
-  days_passed += file_day - 1;
-
-  /* OK - have whole days.  Multiply -- then add in other parts.  */
-
-  tot_secs  = days_passed * 86400;
-  tot_secs += file_hour * 3600;
-  tot_secs += file_min * 60;
-  tot_secs += file_tsec * 2;
-  return (OS_Time) tot_secs;
-
-#elif defined (_WIN32) && !defined (RTX)
-  HANDLE h = (HANDLE) _get_osfhandle (fd);
-  time_t ret = win32_filetime (h);
-  return (OS_Time) ret;
-
-#else
-  struct stat statbuf;
+   return attr->timestamp;
+}
 
-  if (fstat (fd, &statbuf) != 0) {
-     return (OS_Time) -1;
-  } else {
-#ifdef VMS
-     /* VMS has file versioning.  */
-     return (OS_Time) statbuf.st_ctime;
-#else
-     return (OS_Time) statbuf.st_mtime;
-#endif
-  }
-#endif
+OS_Time
+__gnat_file_time_fd (int fd)
+{
+   struct file_attributes attr;
+   __gnat_reset_attributes (&attr);
+   return __gnat_file_time_fd_attr (fd, &attr);
 }
 
 /* Set the file time stamp.  */
@@ -1365,7 +1416,7 @@ __gnat_file_time_fd (int fd)
 void
 __gnat_set_file_time_name (char *name, time_t time_stamp)
 {
-#if defined (__EMX__) || defined (MSDOS) || defined (__vxworks)
+#if defined (__vxworks)
 
 /* Code to implement __gnat_set_file_time_name for these systems.  */
 
@@ -1578,7 +1629,9 @@ __gnat_set_file_time_name (char *name, time_t time_stamp)
 char *
 __gnat_get_libraries_from_registry (void)
 {
-  char *result = (char *) "";
+  char *result = (char *) xmalloc (1);
+
+  result[0] = '\0';
 
 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS) \
   && ! defined (RTX)
@@ -1609,7 +1662,7 @@ __gnat_get_libraries_from_registry (void)
   for (index = 0; res == ERROR_SUCCESS; index++)
     {
       value_size = name_size = 256;
-      res = RegEnumValueA (reg_key, index, (TCHAR*)name, &name_size, 0,
+      res = RegEnumValueA (reg_key, index, name, &name_size, 0,
                            &type, (LPBYTE)value, &value_size);
 
       if (res == ERROR_SUCCESS && type == REG_SZ)
@@ -1620,6 +1673,7 @@ __gnat_get_libraries_from_registry (void)
           strcpy (result, old_result);
           strcat (result, value);
           strcat (result, ";");
+          free (old_result);
         }
     }
 
@@ -1632,14 +1686,13 @@ __gnat_get_libraries_from_registry (void)
 }
 
 int
-__gnat_stat (char *name, struct stat *statbuf)
+__gnat_stat (char *name, GNAT_STRUCT_STAT *statbuf)
 {
 #ifdef __MINGW32__
-  /* Under Windows the directory name for the stat function must not be
-     terminated by a directory separator except if just after a drive name.  */
+  WIN32_FILE_ATTRIBUTE_DATA fad;
   TCHAR wname [GNAT_MAX_PATH_LEN + 2];
   int name_len;
-  TCHAR last_char;
+  BOOL res;
 
   S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
   name_len = _tcslen (wname);
@@ -1647,45 +1700,75 @@ __gnat_stat (char *name, struct stat *statbuf)
   if (name_len > GNAT_MAX_PATH_LEN)
     return -1;
 
-  last_char = wname[name_len - 1];
-
-  while (name_len > 1 && (last_char == _T('\\') || last_char == _T('/')))
-    {
-      wname[name_len - 1] = _T('\0');
-      name_len--;
-      last_char = wname[name_len - 1];
+  ZeroMemory (statbuf, sizeof(GNAT_STRUCT_STAT));
+
+  res = GetFileAttributesEx (wname, GetFileExInfoStandard, &fad);
+
+  if (res == FALSE)
+    switch (GetLastError()) {
+      case ERROR_ACCESS_DENIED:
+      case ERROR_SHARING_VIOLATION:
+      case ERROR_LOCK_VIOLATION:
+      case ERROR_SHARING_BUFFER_EXCEEDED:
+       return EACCES;
+      case ERROR_BUFFER_OVERFLOW:
+       return ENAMETOOLONG;
+      case ERROR_NOT_ENOUGH_MEMORY:
+       return ENOMEM;
+      default:
+       return ENOENT;
     }
 
-  /* Only a drive letter followed by ':', we must add a directory separator
-     for the stat routine to work properly.  */
-  if (name_len == 2 && wname[1] == _T(':'))
-    _tcscat (wname, _T("\\"));
+  f2t (&fad.ftCreationTime, &statbuf->st_ctime);
+  f2t (&fad.ftLastWriteTime, &statbuf->st_mtime);
+  f2t (&fad.ftLastAccessTime, &statbuf->st_atime);
 
-  return _tstat (wname, statbuf);
+  statbuf->st_size = (off_t)fad.nFileSizeLow;
+
+  /* We do not have the S_IEXEC attribute, but this is not used on GNAT.  */
+  statbuf->st_mode = S_IREAD;
+
+  if (fad.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY)
+    statbuf->st_mode |= S_IFDIR;
+  else
+    statbuf->st_mode |= S_IFREG;
+
+  if (!(fad.dwFileAttributes & FILE_ATTRIBUTE_READONLY))
+    statbuf->st_mode |= S_IWRITE;
+
+  return 0;
 
 #else
-  return stat (name, statbuf);
+  return GNAT_STAT (name, statbuf);
 #endif
 }
 
+/*************************************************************************
+ ** Check whether a file exists
+ *************************************************************************/
+
 int
-__gnat_file_exists (char *name)
+__gnat_file_exists_attr (char* name, struct file_attributes* attr)
 {
-#ifdef __MINGW32__
-  /*  On Windows do not use __gnat_stat() because a bug in Microsoft
-  _stat() routine. When the system time-zone is set with a negative
-  offset the _stat() routine fails on specific files like CON:  */
-  TCHAR wname [GNAT_MAX_PATH_LEN + 2];
+   if (attr->exists == ATTR_UNSET) {
+      __gnat_stat_to_attr (-1, name, attr);
+   }
 
-  S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
-  return GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
-#else
-  struct stat statbuf;
+   return attr->exists;
+}
 
-  return !__gnat_stat (name, &statbuf);
-#endif
+int
+__gnat_file_exists (char *name)
+{
+   struct file_attributes attr;
+   __gnat_reset_attributes (&attr);
+   return __gnat_file_exists_attr (name, &attr);
 }
 
+/**********************************************************************
+ ** Whether name is an absolute path
+ **********************************************************************/
+
 int
 __gnat_is_absolute_path (char *name, int length)
 {
@@ -1714,7 +1797,7 @@ __gnat_is_absolute_path (char *name, int length)
 #else
   return (length != 0) &&
      (*name == '/' || *name == DIR_SEPARATOR
-#if defined (__EMX__) || defined (MSDOS) || defined (WINNT)
+#if defined (WINNT)
       || (length > 1 && ISALPHA (name[0]) && name[1] == ':')
 #endif
          );
@@ -1722,26 +1805,101 @@ __gnat_is_absolute_path (char *name, int length)
 }
 
 int
+__gnat_is_regular_file_attr (char* name, struct file_attributes* attr)
+{
+   if (attr->regular == ATTR_UNSET) {
+      __gnat_stat_to_attr (-1, name, attr);
+   }
+
+   return attr->regular;
+}
+
+int
 __gnat_is_regular_file (char *name)
 {
-  int ret;
-  struct stat statbuf;
+   struct file_attributes attr;
+   __gnat_reset_attributes (&attr);
+   return __gnat_is_regular_file_attr (name, &attr);
+}
+
+int
+__gnat_is_directory_attr (char* name, struct file_attributes* attr)
+{
+   if (attr->directory == ATTR_UNSET) {
+      __gnat_stat_to_attr (-1, name, attr);
+   }
 
-  ret = __gnat_stat (name, &statbuf);
-  return (!ret && S_ISREG (statbuf.st_mode));
+   return attr->directory;
 }
 
 int
 __gnat_is_directory (char *name)
 {
-  int ret;
-  struct stat statbuf;
-
-  ret = __gnat_stat (name, &statbuf);
-  return (!ret && S_ISDIR (statbuf.st_mode));
+   struct file_attributes attr;
+   __gnat_reset_attributes (&attr);
+   return __gnat_is_directory_attr (name, &attr);
 }
 
 #if defined (_WIN32) && !defined (RTX)
+
+/* Returns the same constant as GetDriveType but takes a pathname as
+   argument. */
+
+static UINT
+GetDriveTypeFromPath (TCHAR *wfullpath)
+{
+  TCHAR wdrv[MAX_PATH];
+  TCHAR wpath[MAX_PATH];
+  TCHAR wfilename[MAX_PATH];
+  TCHAR wext[MAX_PATH];
+
+  _tsplitpath (wfullpath, wdrv, wpath, wfilename, wext);
+
+  if (_tcslen (wdrv) != 0)
+    {
+      /* we have a drive specified. */
+      _tcscat (wdrv, _T("\\"));
+      return GetDriveType (wdrv);
+    }
+  else
+    {
+      /* No drive specified. */
+
+      /* Is this a relative path, if so get current drive type. */
+      if (wpath[0] != _T('\\') ||
+         (_tcslen (wpath) > 2 && wpath[0] == _T('\\') && wpath[1] != _T('\\')))
+       return GetDriveType (NULL);
+
+      UINT result = GetDriveType (wpath);
+
+      /* Cannot guess the drive type, is this \\.\ ? */
+
+      if (result == DRIVE_NO_ROOT_DIR &&
+        _tcslen (wpath) >= 4 && wpath[0] == _T('\\') && wpath[1] == _T('\\')
+         && wpath[2] == _T('.') && wpath[3] == _T('\\'))
+       {
+         if (_tcslen (wpath) == 4)
+           _tcscat (wpath, wfilename);
+
+         LPTSTR p = &wpath[4];
+         LPTSTR b = _tcschr (p, _T('\\'));
+
+         if (b != NULL)
+           { /* logical drive \\.\c\dir\file */
+             *b++ = _T(':');
+             *b++ = _T('\\');
+             *b = _T('\0');
+           }
+         else
+           _tcscat (p, _T(":\\"));
+
+         return GetDriveType (p);
+       }
+
+      return result;
+    }
+}
+
 /*  This MingW section contains code to work with ACL. */
 static int
 __gnat_check_OWNER_ACL
@@ -1753,8 +1911,8 @@ __gnat_check_OWNER_ACL
   PRIVILEGE_SET PrivilegeSet;
   DWORD dwPrivSetSize = sizeof (PRIVILEGE_SET);
   BOOL fAccessGranted = FALSE;
-  HANDLE hToken;
-  DWORD nLength;
+  HANDLE hToken = NULL;
+  DWORD nLength = 0;
   SECURITY_DESCRIPTOR* pSD = NULL;
 
   GetFileSecurity
@@ -1772,14 +1930,14 @@ __gnat_check_OWNER_ACL
       (wname, OWNER_SECURITY_INFORMATION |
        GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION,
        pSD, nLength, &nLength))
-    return 0;
+    goto error;
 
   if (!ImpersonateSelf (SecurityImpersonation))
-    return 0;
+    goto error;
 
   if (!OpenThreadToken
       (GetCurrentThread(), TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, &hToken))
-    return 0;
+    goto error;
 
   /*  Undoes the effect of ImpersonateSelf. */
 
@@ -1800,9 +1958,17 @@ __gnat_check_OWNER_ACL
        &dwPrivSetSize,       /* size of PrivilegeSet buffer */
        &dwAccessAllowed,     /* receives mask of allowed access rights */
        &fAccessGranted))
-    return 0;
+    goto error;
 
+  CloseHandle (hToken);
+  HeapFree (GetProcessHeap (), 0, pSD);
   return fAccessGranted;
+
+ error:
+  if (hToken)
+    CloseHandle (hToken);
+  HeapFree (GetProcessHeap (), 0, pSD);
+  return 0;
 }
 
 static void
@@ -1811,9 +1977,9 @@ __gnat_set_OWNER_ACL
  DWORD AccessMode,
  DWORD AccessPermissions)
 {
-  ACL* pOldDACL = NULL;
-  ACL* pNewDACL = NULL;
-  SECURITY_DESCRIPTOR* pSD = NULL;
+  PACL pOldDACL = NULL;
+  PACL pNewDACL = NULL;
+  PSECURITY_DESCRIPTOR pSD = NULL;
   EXPLICIT_ACCESS ea;
   TCHAR username [100];
   DWORD unsize = 100;
@@ -1852,80 +2018,126 @@ __gnat_set_OWNER_ACL
   LocalFree (pSD);
   LocalFree (pNewDACL);
 }
+
+/* Check if it is possible to use ACL for wname, the file must not be on a
+   network drive. */
+
+static int
+__gnat_can_use_acl (TCHAR *wname)
+{
+  return __gnat_use_acl && GetDriveTypeFromPath (wname) != DRIVE_REMOTE;
+}
+
 #endif /* defined (_WIN32) && !defined (RTX) */
 
 int
-__gnat_is_readable_file (char *name)
+__gnat_is_readable_file_attr (char* name, struct file_attributes* attr)
 {
+   if (attr->readable == ATTR_UNSET) {
 #if defined (_WIN32) && !defined (RTX)
-  TCHAR wname [GNAT_MAX_PATH_LEN + 2];
-  GENERIC_MAPPING GenericMapping;
+     TCHAR wname [GNAT_MAX_PATH_LEN + 2];
+     GENERIC_MAPPING GenericMapping;
 
-  S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
+     S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
-  ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
-  GenericMapping.GenericRead = GENERIC_READ;
-
-  return __gnat_check_OWNER_ACL (wname, FILE_READ_DATA, GenericMapping);
+     if (__gnat_can_use_acl (wname))
+     {
+        ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
+        GenericMapping.GenericRead = GENERIC_READ;
+       attr->readable =
+         __gnat_check_OWNER_ACL (wname, FILE_READ_DATA, GenericMapping);
+     }
+     else
+        attr->readable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
 #else
-  int ret;
-  int mode;
-  struct stat statbuf;
-
-  ret = stat (name, &statbuf);
-  mode = statbuf.st_mode & S_IRUSR;
-  return (!ret && mode);
+     __gnat_stat_to_attr (-1, name, attr);
 #endif
+   }
+
+   return attr->readable;
 }
 
 int
-__gnat_is_writable_file (char *name)
+__gnat_is_readable_file (char *name)
 {
+   struct file_attributes attr;
+   __gnat_reset_attributes (&attr);
+   return __gnat_is_readable_file_attr (name, &attr);
+}
+
+int
+__gnat_is_writable_file_attr (char* name, struct file_attributes* attr)
+{
+   if (attr->writable == ATTR_UNSET) {
 #if defined (_WIN32) && !defined (RTX)
-  TCHAR wname [GNAT_MAX_PATH_LEN + 2];
-  GENERIC_MAPPING GenericMapping;
+     TCHAR wname [GNAT_MAX_PATH_LEN + 2];
+     GENERIC_MAPPING GenericMapping;
 
-  S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
+     S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
-  ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
-  GenericMapping.GenericWrite = GENERIC_WRITE;
+     if (__gnat_can_use_acl (wname))
+       {
+         ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
+         GenericMapping.GenericWrite = GENERIC_WRITE;
 
-  return __gnat_check_OWNER_ACL
-    (wname, FILE_WRITE_DATA | FILE_APPEND_DATA, GenericMapping)
-    && !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
-#else
-  int ret;
-  int mode;
-  struct stat statbuf;
+         attr->writable = __gnat_check_OWNER_ACL
+            (wname, FILE_WRITE_DATA | FILE_APPEND_DATA, GenericMapping)
+            && !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
+       }
+     else
+       attr->writable = !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
 
-  ret = stat (name, &statbuf);
-  mode = statbuf.st_mode & S_IWUSR;
-  return (!ret && mode);
+#else
+     __gnat_stat_to_attr (-1, name, attr);
 #endif
+   }
+
+   return attr->writable;
 }
 
 int
-__gnat_is_executable_file (char *name)
+__gnat_is_writable_file (char *name)
+{
+   struct file_attributes attr;
+   __gnat_reset_attributes (&attr);
+   return __gnat_is_writable_file_attr (name, &attr);
+}
+
+int
+__gnat_is_executable_file_attr (char* name, struct file_attributes* attr)
 {
+   if (attr->executable == ATTR_UNSET) {
 #if defined (_WIN32) && !defined (RTX)
-  TCHAR wname [GNAT_MAX_PATH_LEN + 2];
-  GENERIC_MAPPING GenericMapping;
+     TCHAR wname [GNAT_MAX_PATH_LEN + 2];
+     GENERIC_MAPPING GenericMapping;
 
-  S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
+     S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
-  ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
-  GenericMapping.GenericExecute = GENERIC_EXECUTE;
+     if (__gnat_can_use_acl (wname))
+       {
+         ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
+         GenericMapping.GenericExecute = GENERIC_EXECUTE;
 
-  return __gnat_check_OWNER_ACL (wname, FILE_EXECUTE, GenericMapping);
+         attr->executable =
+           __gnat_check_OWNER_ACL (wname, FILE_EXECUTE, GenericMapping);
+       }
+     else
+       attr->executable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES
+         && _tcsstr (wname, _T(".exe")) - wname == (int) (_tcslen (wname) - 4);
 #else
-  int ret;
-  int mode;
-  struct stat statbuf;
-
-  ret = stat (name, &statbuf);
-  mode = statbuf.st_mode & S_IXUSR;
-  return (!ret && mode);
+     __gnat_stat_to_attr (-1, name, attr);
 #endif
+   }
+
+   return attr->executable;
+}
+
+int
+__gnat_is_executable_file (char *name)
+{
+   struct file_attributes attr;
+   __gnat_reset_attributes (&attr);
+   return __gnat_is_executable_file_attr (name, &attr);
 }
 
 void
@@ -1936,13 +2148,15 @@ __gnat_set_writable (char *name)
 
   S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
-  __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_WRITE);
+  if (__gnat_can_use_acl (wname))
+    __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_WRITE);
+
   SetFileAttributes
     (wname, GetFileAttributes (wname) & ~FILE_ATTRIBUTE_READONLY);
 #elif ! defined (__vxworks) && ! defined(__nucleus__)
-  struct stat statbuf;
+  GNAT_STRUCT_STAT statbuf;
 
-  if (stat (name, &statbuf) == 0)
+  if (GNAT_STAT (name, &statbuf) == 0)
     {
       statbuf.st_mode = statbuf.st_mode | S_IWUSR;
       chmod (name, statbuf.st_mode);
@@ -1958,11 +2172,13 @@ __gnat_set_executable (char *name)
 
   S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
-  __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_EXECUTE);
+  if (__gnat_can_use_acl (wname))
+    __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_EXECUTE);
+
 #elif ! defined (__vxworks) && ! defined(__nucleus__)
-  struct stat statbuf;
+  GNAT_STRUCT_STAT statbuf;
 
-  if (stat (name, &statbuf) == 0)
+  if (GNAT_STAT (name, &statbuf) == 0)
     {
       statbuf.st_mode = statbuf.st_mode | S_IXUSR;
       chmod (name, statbuf.st_mode);
@@ -1978,16 +2194,18 @@ __gnat_set_non_writable (char *name)
 
   S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
-  __gnat_set_OWNER_ACL
-    (wname, DENY_ACCESS,
-     FILE_WRITE_DATA | FILE_APPEND_DATA |
-     FILE_WRITE_EA | FILE_WRITE_ATTRIBUTES);
+  if (__gnat_can_use_acl (wname))
+    __gnat_set_OWNER_ACL
+      (wname, DENY_ACCESS,
+       FILE_WRITE_DATA | FILE_APPEND_DATA |
+       FILE_WRITE_EA | FILE_WRITE_ATTRIBUTES);
+
   SetFileAttributes
     (wname, GetFileAttributes (wname) | FILE_ATTRIBUTE_READONLY);
 #elif ! defined (__vxworks) && ! defined(__nucleus__)
-  struct stat statbuf;
+  GNAT_STRUCT_STAT statbuf;
 
-  if (stat (name, &statbuf) == 0)
+  if (GNAT_STAT (name, &statbuf) == 0)
     {
       statbuf.st_mode = statbuf.st_mode & 07577;
       chmod (name, statbuf.st_mode);
@@ -2003,11 +2221,13 @@ __gnat_set_readable (char *name)
 
   S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
-  __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_READ);
+  if (__gnat_can_use_acl (wname))
+    __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_READ);
+
 #elif ! defined (__vxworks) && ! defined(__nucleus__)
-  struct stat statbuf;
+  GNAT_STRUCT_STAT statbuf;
 
-  if (stat (name, &statbuf) == 0)
+  if (GNAT_STAT (name, &statbuf) == 0)
     {
       chmod (name, statbuf.st_mode | S_IREAD);
     }
@@ -2022,11 +2242,13 @@ __gnat_set_non_readable (char *name)
 
   S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
-  __gnat_set_OWNER_ACL (wname, DENY_ACCESS, FILE_GENERIC_READ);
+  if (__gnat_can_use_acl (wname))
+    __gnat_set_OWNER_ACL (wname, DENY_ACCESS, FILE_GENERIC_READ);
+
 #elif ! defined (__vxworks) && ! defined(__nucleus__)
-  struct stat statbuf;
+  GNAT_STRUCT_STAT statbuf;
 
-  if (stat (name, &statbuf) == 0)
+  if (GNAT_STAT (name, &statbuf) == 0)
     {
       chmod (name, statbuf.st_mode & (~S_IREAD));
     }
@@ -2034,21 +2256,31 @@ __gnat_set_non_readable (char *name)
 }
 
 int
-__gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED)
+__gnat_is_symbolic_link_attr (char* name, struct file_attributes* attr)
 {
+   if (attr->symbolic_link == ATTR_UNSET) {
 #if defined (__vxworks) || defined (__nucleus__)
-  return 0;
+      attr->symbolic_link = 0;
 
 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
-  int ret;
-  struct stat statbuf;
-
-  ret = lstat (name, &statbuf);
-  return (!ret && S_ISLNK (statbuf.st_mode));
-
+      int ret;
+      GNAT_STRUCT_STAT statbuf;
+      ret = GNAT_LSTAT (name, &statbuf);
+      attr->symbolic_link = (!ret && S_ISLNK (statbuf.st_mode));
 #else
-  return 0;
+      attr->symbolic_link = 0;
 #endif
+   }
+   return attr->symbolic_link;
+}
+
+int
+__gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED)
+{
+   struct file_attributes attr;
+   __gnat_reset_attributes (&attr);
+   return __gnat_is_symbolic_link_attr (name, &attr);
+
 }
 
 #if defined (sun) && defined (__SVR4)
@@ -2068,7 +2300,7 @@ __gnat_portable_spawn (char *args[])
 #if defined (__vxworks) || defined(__nucleus__) || defined(RTX)
   return -1;
 
-#elif defined (MSDOS) || defined (_WIN32)
+#elif 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);
@@ -2089,12 +2321,6 @@ __gnat_portable_spawn (char *args[])
 
 #else
 
-#ifdef __EMX__
-  pid = spawnvp (P_NOWAIT, args[0], args);
-  if (pid == -1)
-    return -1;
-
-#else
   pid = fork ();
   if (pid < 0)
     return -1;
@@ -2109,7 +2335,6 @@ __gnat_portable_spawn (char *args[])
        _exit (1);
 #endif
     }
-#endif
 
   /* The parent.  */
   finished = waitpid (pid, &status, 0);
@@ -2153,6 +2378,41 @@ __gnat_dup2 (int oldfd, int newfd)
 #endif
 }
 
+int
+__gnat_number_of_cpus (void)
+{
+  int cores = 1;
+
+#if defined (linux) || defined (sun) || defined (AIX) \
+    || (defined (__alpha__)  && defined (_osf_)) || defined (__APPLE__)
+  cores = (int) sysconf (_SC_NPROCESSORS_ONLN);
+
+#elif (defined (__mips) && defined (__sgi))
+  cores = (int) sysconf (_SC_NPROC_ONLN);
+
+#elif defined (__hpux__)
+  struct pst_dynamic psd;
+  if (pstat_getdynamic (&psd, sizeof (psd), 1, 0) != -1)
+    cores = (int) psd.psd_proc_cnt;
+
+#elif defined (_WIN32)
+  SYSTEM_INFO sysinfo;
+  GetSystemInfo (&sysinfo);
+  cores = (int) sysinfo.dwNumberOfProcessors;
+
+#elif defined (VMS)
+  int code = SYI$_ACTIVECPU_CNT;
+  unsigned int res;
+  int status;
+
+  status = LIB$GETSYI (&code, &res);
+  if ((status & 1) != 0)
+    cores = res;
+#endif
+
+  return cores;
+}
+
 /* WIN32 code to implement a wait call that wait for any child process.  */
 
 #if defined (_WIN32) && !defined (RTX)
@@ -2180,71 +2440,59 @@ extern void (*Unlock_Task) (void);
 
 #endif
 
-typedef struct _process_list
-{
-  HANDLE h;
-  struct _process_list *next;
-} Process_List;
-
-static Process_List *PLIST = NULL;
-
-static int plist_length = 0;
+static HANDLE *HANDLES_LIST = NULL;
+static int *PID_LIST = NULL, plist_length = 0, plist_max_length = 0;
 
 static void
-add_handle (HANDLE h)
+add_handle (HANDLE h, int pid)
 {
-  Process_List *pl;
-
-  pl = (Process_List *) xmalloc (sizeof (Process_List));
 
   /* -------------------- critical section -------------------- */
   (*Lock_Task) ();
 
-  pl->h = h;
-  pl->next = PLIST;
-  PLIST = pl;
+  if (plist_length == plist_max_length)
+    {
+      plist_max_length += 1000;
+      HANDLES_LIST =
+        xrealloc (HANDLES_LIST, sizeof (HANDLE) * plist_max_length);
+      PID_LIST =
+        xrealloc (PID_LIST, sizeof (int) * plist_max_length);
+    }
+
+  HANDLES_LIST[plist_length] = h;
+  PID_LIST[plist_length] = pid;
   ++plist_length;
 
   (*Unlock_Task) ();
   /* -------------------- critical section -------------------- */
 }
 
-static void
-remove_handle (HANDLE h)
+void
+__gnat_win32_remove_handle (HANDLE h, int pid)
 {
-  Process_List *pl;
-  Process_List *prev = NULL;
+  int j;
 
   /* -------------------- critical section -------------------- */
   (*Lock_Task) ();
 
-  pl = PLIST;
-  while (pl)
+  for (j = 0; j < plist_length; j++)
     {
-      if (pl->h == h)
+      if ((HANDLES_LIST[j] == h) || (PID_LIST[j] == pid))
         {
-          if (pl == PLIST)
-           PLIST = pl->next;
-          else
-           prev->next = pl->next;
-          free (pl);
+          CloseHandle (h);
+          --plist_length;
+          HANDLES_LIST[j] = HANDLES_LIST[plist_length];
+          PID_LIST[j] = PID_LIST[plist_length];
           break;
         }
-      else
-        {
-          prev = pl;
-          pl = pl->next;
-        }
     }
 
-  --plist_length;
-
   (*Unlock_Task) ();
   /* -------------------- critical section -------------------- */
 }
 
-static int
-win32_no_block_spawn (char *command, char *args[])
+static void
+win32_no_block_spawn (char *command, char *args[], HANDLE *h, int *pid)
 {
   BOOL result;
   STARTUPINFO SI;
@@ -2308,23 +2556,25 @@ win32_no_block_spawn (char *command, char *args[])
 
   if (result == TRUE)
     {
-      add_handle (PI.hProcess);
       CloseHandle (PI.hThread);
-      return (int) PI.hProcess;
+      *h = PI.hProcess;
+      *pid = PI.dwProcessId;
     }
   else
-    return -1;
+    {
+      *h = NULL;
+      *pid = 0;
+    }
 }
 
 static int
 win32_wait (int *status)
 {
-  DWORD exitcode;
+  DWORD exitcode, pid;
   HANDLE *hl;
   HANDLE h;
   DWORD res;
   int k;
-  Process_List *pl;
   int hl_len;
 
   if (plist_length == 0)
@@ -2342,27 +2592,22 @@ win32_wait (int *status)
 
   hl = (HANDLE *) xmalloc (sizeof (HANDLE) * hl_len);
 
-  pl = PLIST;
-  while (pl)
-    {
-      hl[k++] = pl->h;
-      pl = pl->next;
-    }
+  memmove (hl, HANDLES_LIST, sizeof (HANDLE) * hl_len);
 
   (*Unlock_Task) ();
   /* -------------------- critical section -------------------- */
 
   res = WaitForMultipleObjects (hl_len, hl, FALSE, INFINITE);
   h = hl[res - WAIT_OBJECT_0];
-  free (hl);
-
-  remove_handle (h);
 
   GetExitCodeProcess (h, &exitcode);
-  CloseHandle (h);
+  pid = PID_LIST [res - WAIT_OBJECT_0];
+  __gnat_win32_remove_handle (h, -1);
+
+  free (hl);
 
   *status = (int) exitcode;
-  return (int) h;
+  return (int) pid;
 }
 
 #endif
@@ -2370,31 +2615,27 @@ win32_wait (int *status)
 int
 __gnat_portable_no_block_spawn (char *args[])
 {
-  int pid = 0;
 
 #if defined (__vxworks) || defined (__nucleus__) || defined (RTX)
   return -1;
 
-#elif defined (__EMX__) || defined (MSDOS)
+#elif defined (_WIN32)
 
-  /* ??? For PC machines I (Franco) don't know the system calls to implement
-     this routine. So I'll fake it as follows. This routine will behave
-     exactly like the blocking portable_spawn and will systematically return
-     a pid of 0 unless the spawned task did not complete successfully, in
-     which case we return a pid of -1.  To synchronize with this the
-     portable_wait below systematically returns a pid of 0 and reports that
-     the subprocess terminated successfully. */
+  HANDLE h = NULL;
+  int pid;
 
-  if (spawnvp (P_WAIT, args[0], args) != 0)
+  win32_no_block_spawn (args[0], args, &h, &pid);
+  if (h != NULL)
+    {
+      add_handle (h, pid);
+      return pid;
+    }
+  else
     return -1;
 
-#elif defined (_WIN32)
-
-  pid = win32_no_block_spawn (args[0], args);
-  return pid;
-
 #else
-  pid = fork ();
+
+  int pid = fork ();
 
   if (pid == 0)
     {
@@ -2407,9 +2648,9 @@ __gnat_portable_no_block_spawn (char *args[])
 #endif
     }
 
-#endif
-
   return pid;
+
+  #endif
 }
 
 int
@@ -2419,16 +2660,12 @@ __gnat_portable_wait (int *process_status)
   int pid = 0;
 
 #if defined (__vxworks) || defined (__nucleus__) || defined (RTX)
-  /* Not sure what to do here, so do same as __EMX__ case, i.e., nothing but
-     return zero.  */
+  /* Not sure what to do here, so do nothing but return zero.  */
 
 #elif defined (_WIN32)
 
   pid = win32_wait (&status);
 
-#elif defined (__EMX__) || defined (MSDOS)
-  /* ??? See corresponding comment in portable_no_block_spawn.  */
-
 #else
 
   pid = waitpid (-1, &status, 0);
@@ -2500,16 +2737,11 @@ __gnat_locate_regular_file (char *file_name, char *path_val)
 
   {
     /* The result has to be smaller than path_val + file_name.  */
-    char *file_path = (char *) alloca (strlen (path_val) + strlen (file_name) + 2);
+    char *file_path =
+      (char *) alloca (strlen (path_val) + strlen (file_name) + 2);
 
     for (;;)
       {
-        for (; *path_val == PATH_SEPARATOR; path_val++)
-          ;
-
-      if (*path_val == 0)
-        return 0;
-
       /* Skip the starting quote */
 
       if (*path_val == '"')
@@ -2518,7 +2750,14 @@ __gnat_locate_regular_file (char *file_name, char *path_val)
       for (ptr = file_path; *path_val && *path_val != PATH_SEPARATOR; )
        *ptr++ = *path_val++;
 
-      ptr--;
+      /* If directory is empty, it is the current directory*/
+
+      if (ptr == file_path)
+        {
+         *ptr = '.';
+        }
+      else
+        ptr--;
 
       /* Skip the ending quote */
 
@@ -2532,6 +2771,13 @@ __gnat_locate_regular_file (char *file_name, char *path_val)
 
       if (__gnat_is_regular_file (file_path))
         return xstrdup (file_path);
+
+      if (*path_val == 0)
+        return 0;
+
+      /* Skip path separator */
+
+      path_val++;
       }
   }
 
@@ -2548,8 +2794,9 @@ __gnat_locate_exec (char *exec_name, char *path_val)
   char *ptr;
   if (!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) + strlen (HOST_EXECUTABLE_SUFFIX) + 1);
 
       strcpy (full_exec_name, exec_name);
       strcat (full_exec_name, HOST_EXECUTABLE_SUFFIX);
@@ -3120,7 +3367,8 @@ __gnat_to_canonical_file_list_init
 char *
 __gnat_to_canonical_file_list_next (void)
 {
-  return (char *) "";
+  static char empty[] = "";
+  return empty;
 }
 
 void
@@ -3165,14 +3413,6 @@ __gnat_adjust_os_resource_limits (void)
 
 #endif
 
-/* For EMX, we cannot include dummy in libgcc, since it is too difficult
-   to coordinate this with the EMX distribution. Consequently, we put the
-   definition of dummy which is used for exception handling, here.  */
-
-#if defined (__EMX__)
-void __dummy () {}
-#endif
-
 #if defined (__mips_vxworks)
 int
 _flush_cache()
@@ -3188,6 +3428,7 @@ _flush_cache()
       && ! (defined (linux) && defined (__ia64__)) \
       && ! (defined (linux) && defined (powerpc)) \
       && ! defined (__FreeBSD__) \
+      && ! defined (__Lynx__) \
       && ! defined (__hpux__) \
       && ! defined (__APPLE__) \
       && ! defined (_AIX) \
@@ -3252,11 +3493,68 @@ __gnat_copy_attribs (char *from, char *to, int mode)
 {
 #if defined (VMS) || defined (__vxworks) || defined (__nucleus__)
   return -1;
+
+#elif defined (_WIN32) && !defined (RTX)
+  TCHAR wfrom [GNAT_MAX_PATH_LEN + 2];
+  TCHAR wto [GNAT_MAX_PATH_LEN + 2];
+  BOOL res;
+  FILETIME fct, flat, flwt;
+  HANDLE hfrom, hto;
+
+  S2WSC (wfrom, from, GNAT_MAX_PATH_LEN + 2);
+  S2WSC (wto, to, GNAT_MAX_PATH_LEN + 2);
+
+  /* retrieve from times */
+
+  hfrom = CreateFile
+    (wfrom, GENERIC_READ, 0, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
+
+  if (hfrom == INVALID_HANDLE_VALUE)
+    return -1;
+
+  res = GetFileTime (hfrom, &fct, &flat, &flwt);
+
+  CloseHandle (hfrom);
+
+  if (res == 0)
+    return -1;
+
+  /* retrieve from times */
+
+  hto = CreateFile
+    (wto, GENERIC_WRITE, 0, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
+
+  if (hto == INVALID_HANDLE_VALUE)
+    return -1;
+
+  res = SetFileTime (hto, NULL, &flat, &flwt);
+
+  CloseHandle (hto);
+
+  if (res == 0)
+    return -1;
+
+  /* Set file attributes in full mode. */
+
+  if (mode == 1)
+    {
+      DWORD attribs = GetFileAttributes (wfrom);
+
+      if (attribs == INVALID_FILE_ATTRIBUTES)
+       return -1;
+
+      res = SetFileAttributes (wto, attribs);
+      if (res == 0)
+       return -1;
+    }
+
+  return 0;
+
 #else
-  struct stat fbuf;
+  GNAT_STRUCT_STAT fbuf;
   struct utimbuf tbuf;
 
-  if (stat (from, &fbuf) == -1)
+  if (GNAT_STAT (from, &fbuf) == -1)
     {
       return -1;
     }
@@ -3317,7 +3615,7 @@ __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED,
     return -1;
   if (close_on_exec_p)
     return ! SetHandleInformation (h, HANDLE_FLAG_INHERIT, 0);
-  return ! SetHandleInformation (h, HANDLE_FLAG_INHERIT, 
+  return ! SetHandleInformation (h, HANDLE_FLAG_INHERIT,
     HANDLE_FLAG_INHERIT);
 #else
   /* TODO: Unimplemented. */
@@ -3328,7 +3626,7 @@ __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED,
 /* Indicates if platforms supports automatic initialization through the
    constructor mechanism */
 int
-__gnat_binder_supports_auto_init ()
+__gnat_binder_supports_auto_init (void)
 {
 #ifdef VMS
    return 0;
@@ -3340,7 +3638,7 @@ __gnat_binder_supports_auto_init ()
 /* Indicates that Stand-Alone Libraries are automatically initialized through
    the constructor mechanism */
 int
-__gnat_sals_init_using_constructors ()
+__gnat_sals_init_using_constructors (void)
 {
 #if defined (__vxworks) || defined (__Lynx__) || defined (VMS)
    return 0;
@@ -3378,39 +3676,13 @@ void __main (void) {}
 #endif
 #endif
 
-#if defined (linux) || defined(__GLIBC__)
-/* pthread affinity support */
-
-int __gnat_pthread_setaffinity_np (pthread_t th,
-                                  size_t cpusetsize,
-                                  const void *cpuset);
-
-#ifdef CPU_SETSIZE
-#include <pthread.h>
-int
-__gnat_pthread_setaffinity_np (pthread_t th,
-                              size_t cpusetsize,
-                              const cpu_set_t *cpuset)
-{
-  return pthread_setaffinity_np (th, cpusetsize, cpuset);
-}
-#else
-int
-__gnat_pthread_setaffinity_np (pthread_t th ATTRIBUTE_UNUSED,
-                              size_t cpusetsize ATTRIBUTE_UNUSED,
-                              const void *cpuset ATTRIBUTE_UNUSED)
-{
-  return 0;
-}
-#endif
-#endif
-
 #if defined (linux)
 /* 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. */
 #include <sys/syscall.h>
-void *__gnat_lwp_self (void) {
+void *__gnat_lwp_self (void)
+{
    return (void *) syscall (__NR_gettid);
 }
 #endif