OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc3/] [gcc/] [ada/] [adaint.c] - Diff between revs 281 and 516

Only display areas with differences | Details | Blame | View Log

Rev 281 Rev 516
/****************************************************************************
/****************************************************************************
 *                                                                          *
 *                                                                          *
 *                         GNAT COMPILER COMPONENTS                         *
 *                         GNAT COMPILER COMPONENTS                         *
 *                                                                          *
 *                                                                          *
 *                               A D A I N T                                *
 *                               A D A I N T                                *
 *                                                                          *
 *                                                                          *
 *                          C Implementation File                           *
 *                          C Implementation File                           *
 *                                                                          *
 *                                                                          *
 *          Copyright (C) 1992-2009, Free Software Foundation, Inc.         *
 *          Copyright (C) 1992-2009, Free Software Foundation, Inc.         *
 *                                                                          *
 *                                                                          *
 * GNAT is free software;  you can  redistribute it  and/or modify it under *
 * 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- *
 * 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- *
 * 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- *
 * sion.  GNAT is distributed in the hope that it will be useful, but WITH- *
 * OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY *
 * OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY *
 * or FITNESS FOR A PARTICULAR PURPOSE.                                     *
 * or FITNESS FOR A PARTICULAR PURPOSE.                                     *
 *                                                                          *
 *                                                                          *
 * As a special exception under Section 7 of GPL version 3, you are granted *
 * As a special exception under Section 7 of GPL version 3, you are granted *
 * additional permissions described in the GCC Runtime Library Exception,   *
 * additional permissions described in the GCC Runtime Library Exception,   *
 * version 3.1, as published by the Free Software Foundation.               *
 * version 3.1, as published by the Free Software Foundation.               *
 *                                                                          *
 *                                                                          *
 * You should have received a copy of the GNU General Public License and    *
 * 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;     *
 * a copy of the GCC Runtime Library Exception along with this program;     *
 * see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    *
 * see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    *
 * <http://www.gnu.org/licenses/>.                                          *
 * <http://www.gnu.org/licenses/>.                                          *
 *                                                                          *
 *                                                                          *
 * GNAT was originally developed  by the GNAT team at  New York University. *
 * GNAT was originally developed  by the GNAT team at  New York University. *
 * Extensive contributions were provided by Ada Core Technologies Inc.      *
 * Extensive contributions were provided by Ada Core Technologies Inc.      *
 *                                                                          *
 *                                                                          *
 ****************************************************************************/
 ****************************************************************************/
 
 
/* This file contains those routines named by Import pragmas in
/* This file contains those routines named by Import pragmas in
   packages in the GNAT hierarchy (especially GNAT.OS_Lib) and in
   packages in the GNAT hierarchy (especially GNAT.OS_Lib) and in
   package Osint.  Many of the subprograms in OS_Lib import standard
   package Osint.  Many of the subprograms in OS_Lib import standard
   library calls directly. This file contains all other routines.  */
   library calls directly. This file contains all other routines.  */
 
 
#ifdef __vxworks
#ifdef __vxworks
 
 
/* No need to redefine exit here.  */
/* No need to redefine exit here.  */
#undef exit
#undef exit
 
 
/* We want to use the POSIX variants of include files.  */
/* We want to use the POSIX variants of include files.  */
#define POSIX
#define POSIX
#include "vxWorks.h"
#include "vxWorks.h"
 
 
#if defined (__mips_vxworks)
#if defined (__mips_vxworks)
#include "cacheLib.h"
#include "cacheLib.h"
#endif /* __mips_vxworks */
#endif /* __mips_vxworks */
 
 
#endif /* VxWorks */
#endif /* VxWorks */
 
 
#ifdef VMS
#ifdef VMS
#define _POSIX_EXIT 1
#define _POSIX_EXIT 1
#define HOST_EXECUTABLE_SUFFIX ".exe"
#define HOST_EXECUTABLE_SUFFIX ".exe"
#define HOST_OBJECT_SUFFIX ".obj"
#define HOST_OBJECT_SUFFIX ".obj"
#endif
#endif
 
 
#ifdef IN_RTS
#ifdef IN_RTS
#include "tconfig.h"
#include "tconfig.h"
#include "tsystem.h"
#include "tsystem.h"
 
 
#include <sys/stat.h>
#include <sys/stat.h>
#include <fcntl.h>
#include <fcntl.h>
#include <time.h>
#include <time.h>
#ifdef VMS
#ifdef VMS
#include <unixio.h>
#include <unixio.h>
#endif
#endif
 
 
/* We don't have libiberty, so use malloc.  */
/* We don't have libiberty, so use malloc.  */
#define xmalloc(S) malloc (S)
#define xmalloc(S) malloc (S)
#define xrealloc(V,S) realloc (V,S)
#define xrealloc(V,S) realloc (V,S)
#else
#else
#include "config.h"
#include "config.h"
#include "system.h"
#include "system.h"
#include "version.h"
#include "version.h"
#endif
#endif
 
 
#if defined (__MINGW32__)
#if defined (__MINGW32__)
 
 
#if defined (RTX)
#if defined (RTX)
#include <windows.h>
#include <windows.h>
#include <Rtapi.h>
#include <Rtapi.h>
#else
#else
#include "mingw32.h"
#include "mingw32.h"
 
 
/* Current code page to use, set in initialize.c.  */
/* Current code page to use, set in initialize.c.  */
UINT CurrentCodePage;
UINT CurrentCodePage;
#endif
#endif
 
 
#include <sys/utime.h>
#include <sys/utime.h>
 
 
/* For isalpha-like tests in the compiler, we're expected to resort to
/* 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
   safe-ctype.h/ISALPHA.  This isn't available for the runtime library
   build, so we fallback on ctype.h/isalpha there.  */
   build, so we fallback on ctype.h/isalpha there.  */
 
 
#ifdef IN_RTS
#ifdef IN_RTS
#include <ctype.h>
#include <ctype.h>
#define ISALPHA isalpha
#define ISALPHA isalpha
#endif
#endif
 
 
#elif defined (__Lynx__)
#elif defined (__Lynx__)
 
 
/* Lynx utime.h only defines the entities of interest to us if
/* Lynx utime.h only defines the entities of interest to us if
   defined (VMOS_DEV), so ... */
   defined (VMOS_DEV), so ... */
#define VMOS_DEV
#define VMOS_DEV
#include <utime.h>
#include <utime.h>
#undef VMOS_DEV
#undef VMOS_DEV
 
 
#elif !defined (VMS)
#elif !defined (VMS)
#include <utime.h>
#include <utime.h>
#endif
#endif
 
 
/* wait.h processing */
/* wait.h processing */
#ifdef __MINGW32__
#ifdef __MINGW32__
#if OLD_MINGW
#if OLD_MINGW
#include <sys/wait.h>
#include <sys/wait.h>
#endif
#endif
#elif defined (__vxworks) && defined (__RTP__)
#elif defined (__vxworks) && defined (__RTP__)
#include <wait.h>
#include <wait.h>
#elif defined (__Lynx__)
#elif defined (__Lynx__)
/* ??? We really need wait.h and it includes resource.h on Lynx.  GCC
/* ??? We really need wait.h and it includes resource.h on Lynx.  GCC
   has a resource.h header as well, included instead of the lynx
   has a resource.h header as well, included instead of the lynx
   version in our setup, causing lots of errors.  We don't really need
   version in our setup, causing lots of errors.  We don't really need
   the lynx contents of this file, so just workaround the issue by
   the lynx contents of this file, so just workaround the issue by
   preventing the inclusion of the GCC header from doing anything.  */
   preventing the inclusion of the GCC header from doing anything.  */
#define GCC_RESOURCE_H
#define GCC_RESOURCE_H
#include <sys/wait.h>
#include <sys/wait.h>
#elif defined (__nucleus__)
#elif defined (__nucleus__)
/* No wait() or waitpid() calls available */
/* No wait() or waitpid() calls available */
#else
#else
/* Default case */
/* Default case */
#include <sys/wait.h>
#include <sys/wait.h>
#endif
#endif
 
 
#if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
#if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
#elif defined (VMS)
#elif defined (VMS)
 
 
/* Header files and definitions for __gnat_set_file_time_name.  */
/* Header files and definitions for __gnat_set_file_time_name.  */
 
 
#define __NEW_STARLET 1
#define __NEW_STARLET 1
#include <vms/rms.h>
#include <vms/rms.h>
#include <vms/atrdef.h>
#include <vms/atrdef.h>
#include <vms/fibdef.h>
#include <vms/fibdef.h>
#include <vms/stsdef.h>
#include <vms/stsdef.h>
#include <vms/iodef.h>
#include <vms/iodef.h>
#include <errno.h>
#include <errno.h>
#include <vms/descrip.h>
#include <vms/descrip.h>
#include <string.h>
#include <string.h>
#include <unixlib.h>
#include <unixlib.h>
 
 
/* Use native 64-bit arithmetic.  */
/* Use native 64-bit arithmetic.  */
#define unix_time_to_vms(X,Y) \
#define unix_time_to_vms(X,Y) \
  { unsigned long long reftime, tmptime = (X); \
  { unsigned long long reftime, tmptime = (X); \
    $DESCRIPTOR (unixtime,"1-JAN-1970 0:00:00.00"); \
    $DESCRIPTOR (unixtime,"1-JAN-1970 0:00:00.00"); \
    SYS$BINTIM (&unixtime, &reftime); \
    SYS$BINTIM (&unixtime, &reftime); \
    Y = tmptime * 10000000 + reftime; }
    Y = tmptime * 10000000 + reftime; }
 
 
/* descrip.h doesn't have everything ... */
/* descrip.h doesn't have everything ... */
typedef struct fibdef* __fibdef_ptr32 __attribute__ (( mode (SI) ));
typedef struct fibdef* __fibdef_ptr32 __attribute__ (( mode (SI) ));
struct dsc$descriptor_fib
struct dsc$descriptor_fib
{
{
  unsigned int fib$l_len;
  unsigned int fib$l_len;
  __fibdef_ptr32 fib$l_addr;
  __fibdef_ptr32 fib$l_addr;
};
};
 
 
/* I/O Status Block.  */
/* I/O Status Block.  */
struct IOSB
struct IOSB
{
{
  unsigned short status, count;
  unsigned short status, count;
  unsigned int devdep;
  unsigned int devdep;
};
};
 
 
static char *tryfile;
static char *tryfile;
 
 
/* Variable length string.  */
/* Variable length string.  */
struct vstring
struct vstring
{
{
  short length;
  short length;
  char string[NAM$C_MAXRSS+1];
  char string[NAM$C_MAXRSS+1];
};
};
 
 
#else
#else
#include <utime.h>
#include <utime.h>
#endif
#endif
 
 
#if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
#if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
#include <process.h>
#include <process.h>
#endif
#endif
 
 
#if defined (_WIN32)
#if defined (_WIN32)
 
 
#include <dir.h>
#include <dir.h>
#include <windows.h>
#include <windows.h>
#include <accctrl.h>
#include <accctrl.h>
#include <aclapi.h>
#include <aclapi.h>
#undef DIR_SEPARATOR
#undef DIR_SEPARATOR
#define DIR_SEPARATOR '\\'
#define DIR_SEPARATOR '\\'
#endif
#endif
 
 
#include "adaint.h"
#include "adaint.h"
 
 
/* Define symbols O_BINARY and O_TEXT as harmless zeroes if they are not
/* Define symbols O_BINARY and O_TEXT as harmless zeroes if they are not
   defined in the current system. On DOS-like systems these flags control
   defined in the current system. On DOS-like systems these flags control
   whether the file is opened/created in text-translation mode (CR/LF in
   whether the file is opened/created in text-translation mode (CR/LF in
   external file mapped to LF in internal file), but in Unix-like systems,
   external file mapped to LF in internal file), but in Unix-like systems,
   no text translation is required, so these flags have no effect.  */
   no text translation is required, so these flags have no effect.  */
 
 
#if defined (__EMX__)
#if defined (__EMX__)
#include <os2.h>
#include <os2.h>
#endif
#endif
 
 
#if defined (MSDOS)
#if defined (MSDOS)
#include <dos.h>
#include <dos.h>
#endif
#endif
 
 
#ifndef O_BINARY
#ifndef O_BINARY
#define O_BINARY 0
#define O_BINARY 0
#endif
#endif
 
 
#ifndef O_TEXT
#ifndef O_TEXT
#define O_TEXT 0
#define O_TEXT 0
#endif
#endif
 
 
#ifndef HOST_EXECUTABLE_SUFFIX
#ifndef HOST_EXECUTABLE_SUFFIX
#define HOST_EXECUTABLE_SUFFIX ""
#define HOST_EXECUTABLE_SUFFIX ""
#endif
#endif
 
 
#ifndef HOST_OBJECT_SUFFIX
#ifndef HOST_OBJECT_SUFFIX
#define HOST_OBJECT_SUFFIX ".o"
#define HOST_OBJECT_SUFFIX ".o"
#endif
#endif
 
 
#ifndef PATH_SEPARATOR
#ifndef PATH_SEPARATOR
#define PATH_SEPARATOR ':'
#define PATH_SEPARATOR ':'
#endif
#endif
 
 
#ifndef DIR_SEPARATOR
#ifndef DIR_SEPARATOR
#define DIR_SEPARATOR '/'
#define DIR_SEPARATOR '/'
#endif
#endif
 
 
/* Check for cross-compilation */
/* Check for cross-compilation */
#if defined (CROSS_COMPILE) || defined (CROSS_DIRECTORY_STRUCTURE)
#if defined (CROSS_COMPILE) || defined (CROSS_DIRECTORY_STRUCTURE)
#define IS_CROSS 1
#define IS_CROSS 1
int __gnat_is_cross_compiler = 1;
int __gnat_is_cross_compiler = 1;
#else
#else
#undef IS_CROSS
#undef IS_CROSS
int __gnat_is_cross_compiler = 0;
int __gnat_is_cross_compiler = 0;
#endif
#endif
 
 
char __gnat_dir_separator = DIR_SEPARATOR;
char __gnat_dir_separator = DIR_SEPARATOR;
 
 
char __gnat_path_separator = PATH_SEPARATOR;
char __gnat_path_separator = PATH_SEPARATOR;
 
 
/* The GNAT_LIBRARY_TEMPLATE contains a list of expressions that define
/* The GNAT_LIBRARY_TEMPLATE contains a list of expressions that define
   the base filenames that libraries specified with -lsomelib options
   the base filenames that libraries specified with -lsomelib options
   may have. This is used by GNATMAKE to check whether an executable
   may have. This is used by GNATMAKE to check whether an executable
   is up-to-date or not. The syntax is
   is up-to-date or not. The syntax is
 
 
     library_template ::= { pattern ; } pattern NUL
     library_template ::= { pattern ; } pattern NUL
     pattern          ::= [ prefix ] * [ postfix ]
     pattern          ::= [ prefix ] * [ postfix ]
 
 
   These should only specify names of static libraries as it makes
   These should only specify names of static libraries as it makes
   no sense to determine at link time if dynamic-link libraries are
   no sense to determine at link time if dynamic-link libraries are
   up to date or not. Any libraries that are not found are supposed
   up to date or not. Any libraries that are not found are supposed
   to be up-to-date:
   to be up-to-date:
 
 
     * if they are needed but not present, the link
     * if they are needed but not present, the link
       will fail,
       will fail,
 
 
     * otherwise they are libraries in the system paths and so
     * otherwise they are libraries in the system paths and so
       they are considered part of the system and not checked
       they are considered part of the system and not checked
       for that reason.
       for that reason.
 
 
   ??? This should be part of a GNAT host-specific compiler
   ??? This should be part of a GNAT host-specific compiler
       file instead of being included in all user applications
       file instead of being included in all user applications
       as well. This is only a temporary work-around for 3.11b.  */
       as well. This is only a temporary work-around for 3.11b.  */
 
 
#ifndef GNAT_LIBRARY_TEMPLATE
#ifndef GNAT_LIBRARY_TEMPLATE
#if defined (__EMX__)
#if defined (__EMX__)
#define GNAT_LIBRARY_TEMPLATE "*.a"
#define GNAT_LIBRARY_TEMPLATE "*.a"
#elif defined (VMS)
#elif defined (VMS)
#define GNAT_LIBRARY_TEMPLATE "*.olb"
#define GNAT_LIBRARY_TEMPLATE "*.olb"
#else
#else
#define GNAT_LIBRARY_TEMPLATE "lib*.a"
#define GNAT_LIBRARY_TEMPLATE "lib*.a"
#endif
#endif
#endif
#endif
 
 
const char *__gnat_library_template = GNAT_LIBRARY_TEMPLATE;
const char *__gnat_library_template = GNAT_LIBRARY_TEMPLATE;
 
 
/* This variable is used in hostparm.ads to say whether the host is a VMS
/* This variable is used in hostparm.ads to say whether the host is a VMS
   system.  */
   system.  */
#ifdef VMS
#ifdef VMS
const int __gnat_vmsp = 1;
const int __gnat_vmsp = 1;
#else
#else
const int __gnat_vmsp = 0;
const int __gnat_vmsp = 0;
#endif
#endif
 
 
#ifdef __EMX__
#ifdef __EMX__
#define GNAT_MAX_PATH_LEN MAX_PATH
#define GNAT_MAX_PATH_LEN MAX_PATH
 
 
#elif defined (VMS)
#elif defined (VMS)
#define GNAT_MAX_PATH_LEN 256 /* PATH_MAX */
#define GNAT_MAX_PATH_LEN 256 /* PATH_MAX */
 
 
#elif defined (__vxworks) || defined (__OPENNT) || defined(__nucleus__)
#elif defined (__vxworks) || defined (__OPENNT) || defined(__nucleus__)
#define GNAT_MAX_PATH_LEN PATH_MAX
#define GNAT_MAX_PATH_LEN PATH_MAX
 
 
#else
#else
 
 
#if defined (__MINGW32__)
#if defined (__MINGW32__)
#include "mingw32.h"
#include "mingw32.h"
 
 
#if OLD_MINGW
#if OLD_MINGW
#include <sys/param.h>
#include <sys/param.h>
#endif
#endif
 
 
#else
#else
#include <sys/param.h>
#include <sys/param.h>
#endif
#endif
 
 
#ifdef MAXPATHLEN
#ifdef MAXPATHLEN
#define GNAT_MAX_PATH_LEN MAXPATHLEN
#define GNAT_MAX_PATH_LEN MAXPATHLEN
#else
#else
#define GNAT_MAX_PATH_LEN 256
#define GNAT_MAX_PATH_LEN 256
#endif
#endif
 
 
#endif
#endif
 
 
/* Used for Ada bindings */
/* Used for Ada bindings */
const int __gnat_size_of_file_attributes = sizeof (struct file_attributes);
const int __gnat_size_of_file_attributes = sizeof (struct file_attributes);
 
 
/* Reset the file attributes as if no system call had been performed */
/* 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);
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
/* 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
   length of a path name to Ada code. max_path_len is also provided
   for compatibility with older GNAT versions, please do not use
   for compatibility with older GNAT versions, please do not use
   it. */
   it. */
 
 
int __gnat_max_path_len = GNAT_MAX_PATH_LEN;
int __gnat_max_path_len = GNAT_MAX_PATH_LEN;
int max_path_len = GNAT_MAX_PATH_LEN;
int max_path_len = GNAT_MAX_PATH_LEN;
 
 
/* Control whether we can use ACL on Windows.  */
/* Control whether we can use ACL on Windows.  */
 
 
int __gnat_use_acl = 1;
int __gnat_use_acl = 1;
 
 
/* The following macro HAVE_READDIR_R should be defined if the
/* The following macro HAVE_READDIR_R should be defined if the
   system provides the routine readdir_r.  */
   system provides the routine readdir_r.  */
#undef HAVE_READDIR_R
#undef HAVE_READDIR_R


#if defined(VMS) && defined (__LONG_POINTERS)
#if defined(VMS) && defined (__LONG_POINTERS)
 
 
/* Return a 32 bit pointer to an array of 32 bit pointers
/* Return a 32 bit pointer to an array of 32 bit pointers
   given a 64 bit pointer to an array of 64 bit pointers */
   given a 64 bit pointer to an array of 64 bit pointers */
 
 
typedef __char_ptr32 *__char_ptr_char_ptr32 __attribute__ ((mode (SI)));
typedef __char_ptr32 *__char_ptr_char_ptr32 __attribute__ ((mode (SI)));
 
 
static __char_ptr_char_ptr32
static __char_ptr_char_ptr32
to_ptr32 (char **ptr64)
to_ptr32 (char **ptr64)
{
{
  int argc;
  int argc;
  __char_ptr_char_ptr32 short_argv;
  __char_ptr_char_ptr32 short_argv;
 
 
  for (argc=0; ptr64[argc]; argc++);
  for (argc=0; ptr64[argc]; argc++);
 
 
  /* Reallocate argv with 32 bit pointers. */
  /* Reallocate argv with 32 bit pointers. */
  short_argv = (__char_ptr_char_ptr32) decc$malloc
  short_argv = (__char_ptr_char_ptr32) decc$malloc
    (sizeof (__char_ptr32) * (argc + 1));
    (sizeof (__char_ptr32) * (argc + 1));
 
 
  for (argc=0; ptr64[argc]; argc++)
  for (argc=0; ptr64[argc]; argc++)
    short_argv[argc] = (__char_ptr32) decc$strdup (ptr64[argc]);
    short_argv[argc] = (__char_ptr32) decc$strdup (ptr64[argc]);
 
 
  short_argv[argc] = (__char_ptr32) 0;
  short_argv[argc] = (__char_ptr32) 0;
  return short_argv;
  return short_argv;
 
 
}
}
#define MAYBE_TO_PTR32(argv) to_ptr32 (argv)
#define MAYBE_TO_PTR32(argv) to_ptr32 (argv)
#else
#else
#define MAYBE_TO_PTR32(argv) argv
#define MAYBE_TO_PTR32(argv) argv
#endif
#endif
 
 
const char ATTR_UNSET = 127;
const char ATTR_UNSET = 127;
 
 
void
void
__gnat_reset_attributes
__gnat_reset_attributes
  (struct file_attributes* attr)
  (struct file_attributes* attr)
{
{
  attr->exists     = ATTR_UNSET;
  attr->exists     = ATTR_UNSET;
 
 
  attr->writable   = ATTR_UNSET;
  attr->writable   = ATTR_UNSET;
  attr->readable   = ATTR_UNSET;
  attr->readable   = ATTR_UNSET;
  attr->executable = ATTR_UNSET;
  attr->executable = ATTR_UNSET;
 
 
  attr->regular    = ATTR_UNSET;
  attr->regular    = ATTR_UNSET;
  attr->symbolic_link = ATTR_UNSET;
  attr->symbolic_link = ATTR_UNSET;
  attr->directory = ATTR_UNSET;
  attr->directory = ATTR_UNSET;
 
 
  attr->timestamp = (OS_Time)-2;
  attr->timestamp = (OS_Time)-2;
  attr->file_length = -1;
  attr->file_length = -1;
}
}
 
 
OS_Time
OS_Time
__gnat_current_time
__gnat_current_time
  (void)
  (void)
{
{
  time_t res = time (NULL);
  time_t res = time (NULL);
  return (OS_Time) res;
  return (OS_Time) res;
}
}
 
 
/* Return the current local time as a string in the ISO 8601 format of
/* Return the current local time as a string in the ISO 8601 format of
   "YYYY-MM-DD HH:MM:SS.SS". The returned string is 22 + 1 (NULL) characters
   "YYYY-MM-DD HH:MM:SS.SS". The returned string is 22 + 1 (NULL) characters
   long. */
   long. */
 
 
void
void
__gnat_current_time_string
__gnat_current_time_string
  (char *result)
  (char *result)
{
{
  const char *format = "%Y-%m-%d %H:%M:%S";
  const char *format = "%Y-%m-%d %H:%M:%S";
  /* Format string necessary to describe the ISO 8601 format */
  /* Format string necessary to describe the ISO 8601 format */
 
 
  const time_t t_val = time (NULL);
  const time_t t_val = time (NULL);
 
 
  strftime (result, 22, format, localtime (&t_val));
  strftime (result, 22, format, localtime (&t_val));
  /* Convert the local time into a string following the ISO format, copying
  /* Convert the local time into a string following the ISO format, copying
     at most 22 characters into the result string. */
     at most 22 characters into the result string. */
 
 
  result [19] = '.';
  result [19] = '.';
  result [20] = '0';
  result [20] = '0';
  result [21] = '0';
  result [21] = '0';
  /* The sub-seconds are manually set to zero since type time_t lacks the
  /* The sub-seconds are manually set to zero since type time_t lacks the
     precision necessary for nanoseconds. */
     precision necessary for nanoseconds. */
}
}
 
 
void
void
__gnat_to_gm_time
__gnat_to_gm_time
  (OS_Time *p_time,
  (OS_Time *p_time,
   int *p_year,
   int *p_year,
   int *p_month,
   int *p_month,
   int *p_day,
   int *p_day,
   int *p_hours,
   int *p_hours,
   int *p_mins,
   int *p_mins,
   int *p_secs)
   int *p_secs)
{
{
  struct tm *res;
  struct tm *res;
  time_t time = (time_t) *p_time;
  time_t time = (time_t) *p_time;
 
 
#ifdef _WIN32
#ifdef _WIN32
  /* On Windows systems, the time is sometimes rounded up to the nearest
  /* On Windows systems, the time is sometimes rounded up to the nearest
     even second, so if the number of seconds is odd, increment it.  */
     even second, so if the number of seconds is odd, increment it.  */
  if (time & 1)
  if (time & 1)
    time++;
    time++;
#endif
#endif
 
 
#ifdef VMS
#ifdef VMS
  res = localtime (&time);
  res = localtime (&time);
#else
#else
  res = gmtime (&time);
  res = gmtime (&time);
#endif
#endif
 
 
  if (res)
  if (res)
    {
    {
      *p_year = res->tm_year;
      *p_year = res->tm_year;
      *p_month = res->tm_mon;
      *p_month = res->tm_mon;
      *p_day = res->tm_mday;
      *p_day = res->tm_mday;
      *p_hours = res->tm_hour;
      *p_hours = res->tm_hour;
      *p_mins = res->tm_min;
      *p_mins = res->tm_min;
      *p_secs = res->tm_sec;
      *p_secs = res->tm_sec;
    }
    }
  else
  else
    *p_year = *p_month = *p_day = *p_hours = *p_mins = *p_secs = 0;
    *p_year = *p_month = *p_day = *p_hours = *p_mins = *p_secs = 0;
}
}
 
 
/* Place the contents of the symbolic link named PATH in the buffer BUF,
/* Place the contents of the symbolic link named PATH in the buffer BUF,
   which has size BUFSIZ.  If PATH is a symbolic link, then return the number
   which has size BUFSIZ.  If PATH is a symbolic link, then return the number
   of characters of its content in BUF.  Otherwise, return -1.
   of characters of its content in BUF.  Otherwise, return -1.
   For systems not supporting symbolic links, always return -1.  */
   For systems not supporting symbolic links, always return -1.  */
 
 
int
int
__gnat_readlink (char *path ATTRIBUTE_UNUSED,
__gnat_readlink (char *path ATTRIBUTE_UNUSED,
                 char *buf ATTRIBUTE_UNUSED,
                 char *buf ATTRIBUTE_UNUSED,
                 size_t bufsiz ATTRIBUTE_UNUSED)
                 size_t bufsiz ATTRIBUTE_UNUSED)
{
{
#if defined (MSDOS) || defined (_WIN32) || defined (__EMX__) \
#if defined (MSDOS) || defined (_WIN32) || defined (__EMX__) \
  || defined (VMS) || defined(__vxworks) || defined (__nucleus__)
  || defined (VMS) || defined(__vxworks) || defined (__nucleus__)
  return -1;
  return -1;
#else
#else
  return readlink (path, buf, bufsiz);
  return readlink (path, buf, bufsiz);
#endif
#endif
}
}
 
 
/* Creates a symbolic link named NEWPATH which contains the string OLDPATH.
/* Creates a symbolic link named NEWPATH which contains the string OLDPATH.
   If NEWPATH exists it will NOT be overwritten.
   If NEWPATH exists it will NOT be overwritten.
   For systems not supporting symbolic links, always return -1.  */
   For systems not supporting symbolic links, always return -1.  */
 
 
int
int
__gnat_symlink (char *oldpath ATTRIBUTE_UNUSED,
__gnat_symlink (char *oldpath ATTRIBUTE_UNUSED,
                char *newpath ATTRIBUTE_UNUSED)
                char *newpath ATTRIBUTE_UNUSED)
{
{
#if defined (MSDOS) || defined (_WIN32) || defined (__EMX__) \
#if defined (MSDOS) || defined (_WIN32) || defined (__EMX__) \
  || defined (VMS) || defined(__vxworks) || defined (__nucleus__)
  || defined (VMS) || defined(__vxworks) || defined (__nucleus__)
  return -1;
  return -1;
#else
#else
  return symlink (oldpath, newpath);
  return symlink (oldpath, newpath);
#endif
#endif
}
}
 
 
/* Try to lock a file, return 1 if success.  */
/* Try to lock a file, return 1 if success.  */
 
 
#if defined (__vxworks) || defined (__nucleus__) || defined (MSDOS) \
#if defined (__vxworks) || defined (__nucleus__) || defined (MSDOS) \
  || defined (_WIN32) || defined (__EMX__) || defined (VMS)
  || defined (_WIN32) || defined (__EMX__) || defined (VMS)
 
 
/* Version that does not use link. */
/* Version that does not use link. */
 
 
int
int
__gnat_try_lock (char *dir, char *file)
__gnat_try_lock (char *dir, char *file)
{
{
  int fd;
  int fd;
#ifdef __MINGW32__
#ifdef __MINGW32__
  TCHAR wfull_path[GNAT_MAX_PATH_LEN];
  TCHAR wfull_path[GNAT_MAX_PATH_LEN];
  TCHAR wfile[GNAT_MAX_PATH_LEN];
  TCHAR wfile[GNAT_MAX_PATH_LEN];
  TCHAR wdir[GNAT_MAX_PATH_LEN];
  TCHAR wdir[GNAT_MAX_PATH_LEN];
 
 
  S2WSC (wdir, dir, GNAT_MAX_PATH_LEN);
  S2WSC (wdir, dir, GNAT_MAX_PATH_LEN);
  S2WSC (wfile, file, GNAT_MAX_PATH_LEN);
  S2WSC (wfile, file, GNAT_MAX_PATH_LEN);
 
 
  _stprintf (wfull_path, _T("%s%c%s"), wdir, _T(DIR_SEPARATOR), wfile);
  _stprintf (wfull_path, _T("%s%c%s"), wdir, _T(DIR_SEPARATOR), wfile);
  fd = _topen (wfull_path, O_CREAT | O_EXCL, 0600);
  fd = _topen (wfull_path, O_CREAT | O_EXCL, 0600);
#else
#else
  char full_path[256];
  char full_path[256];
 
 
  sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
  sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
  fd = open (full_path, O_CREAT | O_EXCL, 0600);
  fd = open (full_path, O_CREAT | O_EXCL, 0600);
#endif
#endif
 
 
  if (fd < 0)
  if (fd < 0)
    return 0;
    return 0;
 
 
  close (fd);
  close (fd);
  return 1;
  return 1;
}
}
 
 
#else
#else
 
 
/* Version using link(), more secure over NFS.  */
/* Version using link(), more secure over NFS.  */
/* See TN 6913-016 for discussion ??? */
/* See TN 6913-016 for discussion ??? */
 
 
int
int
__gnat_try_lock (char *dir, char *file)
__gnat_try_lock (char *dir, char *file)
{
{
  char full_path[256];
  char full_path[256];
  char temp_file[256];
  char temp_file[256];
  GNAT_STRUCT_STAT stat_result;
  GNAT_STRUCT_STAT stat_result;
  int fd;
  int fd;
 
 
  sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
  sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
  sprintf (temp_file, "%s%cTMP-%ld-%ld",
  sprintf (temp_file, "%s%cTMP-%ld-%ld",
           dir, DIR_SEPARATOR, (long)getpid(), (long)getppid ());
           dir, DIR_SEPARATOR, (long)getpid(), (long)getppid ());
 
 
  /* Create the temporary file and write the process number.  */
  /* Create the temporary file and write the process number.  */
  fd = open (temp_file, O_CREAT | O_WRONLY, 0600);
  fd = open (temp_file, O_CREAT | O_WRONLY, 0600);
  if (fd < 0)
  if (fd < 0)
    return 0;
    return 0;
 
 
  close (fd);
  close (fd);
 
 
  /* Link it with the new file.  */
  /* Link it with the new file.  */
  link (temp_file, full_path);
  link (temp_file, full_path);
 
 
  /* Count the references on the old one. If we have a count of two, then
  /* Count the references on the old one. If we have a count of two, then
     the link did succeed. Remove the temporary file before returning.  */
     the link did succeed. Remove the temporary file before returning.  */
  __gnat_stat (temp_file, &stat_result);
  __gnat_stat (temp_file, &stat_result);
  unlink (temp_file);
  unlink (temp_file);
  return stat_result.st_nlink == 2;
  return stat_result.st_nlink == 2;
}
}
#endif
#endif
 
 
/* Return the maximum file name length.  */
/* Return the maximum file name length.  */
 
 
int
int
__gnat_get_maximum_file_name_length (void)
__gnat_get_maximum_file_name_length (void)
{
{
#if defined (MSDOS)
#if defined (MSDOS)
  return 8;
  return 8;
#elif defined (VMS)
#elif defined (VMS)
  if (getenv ("GNAT$EXTENDED_FILE_SPECIFICATIONS"))
  if (getenv ("GNAT$EXTENDED_FILE_SPECIFICATIONS"))
    return -1;
    return -1;
  else
  else
    return 39;
    return 39;
#else
#else
  return -1;
  return -1;
#endif
#endif
}
}
 
 
/* Return nonzero if file names are case sensitive.  */
/* Return nonzero if file names are case sensitive.  */
 
 
int
int
__gnat_get_file_names_case_sensitive (void)
__gnat_get_file_names_case_sensitive (void)
{
{
#if defined (__EMX__) || defined (MSDOS) || defined (VMS) || defined (WINNT)
#if defined (__EMX__) || defined (MSDOS) || defined (VMS) || defined (WINNT)
  return 0;
  return 0;
#else
#else
  return 1;
  return 1;
#endif
#endif
}
}
 
 
char
char
__gnat_get_default_identifier_character_set (void)
__gnat_get_default_identifier_character_set (void)
{
{
#if defined (__EMX__) || defined (MSDOS)
#if defined (__EMX__) || defined (MSDOS)
  return 'p';
  return 'p';
#else
#else
  return '1';
  return '1';
#endif
#endif
}
}
 
 
/* Return the current working directory.  */
/* Return the current working directory.  */
 
 
void
void
__gnat_get_current_dir (char *dir, int *length)
__gnat_get_current_dir (char *dir, int *length)
{
{
#if defined (__MINGW32__)
#if defined (__MINGW32__)
  TCHAR wdir[GNAT_MAX_PATH_LEN];
  TCHAR wdir[GNAT_MAX_PATH_LEN];
 
 
  _tgetcwd (wdir, *length);
  _tgetcwd (wdir, *length);
 
 
  WS2SC (dir, wdir, GNAT_MAX_PATH_LEN);
  WS2SC (dir, wdir, GNAT_MAX_PATH_LEN);
 
 
#elif defined (VMS)
#elif defined (VMS)
   /* Force Unix style, which is what GNAT uses internally.  */
   /* Force Unix style, which is what GNAT uses internally.  */
   getcwd (dir, *length, 0);
   getcwd (dir, *length, 0);
#else
#else
   getcwd (dir, *length);
   getcwd (dir, *length);
#endif
#endif
 
 
   *length = strlen (dir);
   *length = strlen (dir);
 
 
   if (dir [*length - 1] != DIR_SEPARATOR)
   if (dir [*length - 1] != DIR_SEPARATOR)
     {
     {
       dir [*length] = DIR_SEPARATOR;
       dir [*length] = DIR_SEPARATOR;
       ++(*length);
       ++(*length);
     }
     }
   dir[*length] = '\0';
   dir[*length] = '\0';
}
}
 
 
/* Return the suffix for object files.  */
/* Return the suffix for object files.  */
 
 
void
void
__gnat_get_object_suffix_ptr (int *len, const char **value)
__gnat_get_object_suffix_ptr (int *len, const char **value)
{
{
  *value = HOST_OBJECT_SUFFIX;
  *value = HOST_OBJECT_SUFFIX;
 
 
  if (*value == 0)
  if (*value == 0)
    *len = 0;
    *len = 0;
  else
  else
    *len = strlen (*value);
    *len = strlen (*value);
 
 
  return;
  return;
}
}
 
 
/* Return the suffix for executable files.  */
/* Return the suffix for executable files.  */
 
 
void
void
__gnat_get_executable_suffix_ptr (int *len, const char **value)
__gnat_get_executable_suffix_ptr (int *len, const char **value)
{
{
  *value = HOST_EXECUTABLE_SUFFIX;
  *value = HOST_EXECUTABLE_SUFFIX;
  if (!*value)
  if (!*value)
    *len = 0;
    *len = 0;
  else
  else
    *len = strlen (*value);
    *len = strlen (*value);
 
 
  return;
  return;
}
}
 
 
/* Return the suffix for debuggable files. Usually this is the same as the
/* Return the suffix for debuggable files. Usually this is the same as the
   executable extension.  */
   executable extension.  */
 
 
void
void
__gnat_get_debuggable_suffix_ptr (int *len, const char **value)
__gnat_get_debuggable_suffix_ptr (int *len, const char **value)
{
{
#ifndef MSDOS
#ifndef MSDOS
  *value = HOST_EXECUTABLE_SUFFIX;
  *value = HOST_EXECUTABLE_SUFFIX;
#else
#else
  /* On DOS, the extensionless COFF file is what gdb likes.  */
  /* On DOS, the extensionless COFF file is what gdb likes.  */
  *value = "";
  *value = "";
#endif
#endif
 
 
  if (*value == 0)
  if (*value == 0)
    *len = 0;
    *len = 0;
  else
  else
    *len = strlen (*value);
    *len = strlen (*value);
 
 
  return;
  return;
}
}
 
 
/* Returns the OS filename and corresponding encoding.  */
/* Returns the OS filename and corresponding encoding.  */
 
 
void
void
__gnat_os_filename (char *filename ATTRIBUTE_UNUSED,
__gnat_os_filename (char *filename ATTRIBUTE_UNUSED,
                    char *w_filename ATTRIBUTE_UNUSED,
                    char *w_filename ATTRIBUTE_UNUSED,
                    char *os_name, int *o_length,
                    char *os_name, int *o_length,
                    char *encoding ATTRIBUTE_UNUSED, int *e_length)
                    char *encoding ATTRIBUTE_UNUSED, int *e_length)
{
{
#if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
#if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
  WS2SC (os_name, (TCHAR *)w_filename, (DWORD)*o_length);
  WS2SC (os_name, (TCHAR *)w_filename, (DWORD)*o_length);
  *o_length = strlen (os_name);
  *o_length = strlen (os_name);
  strcpy (encoding, "encoding=utf8");
  strcpy (encoding, "encoding=utf8");
  *e_length = strlen (encoding);
  *e_length = strlen (encoding);
#else
#else
  strcpy (os_name, filename);
  strcpy (os_name, filename);
  *o_length = strlen (filename);
  *o_length = strlen (filename);
  *e_length = 0;
  *e_length = 0;
#endif
#endif
}
}
 
 
/* Delete a file.  */
/* Delete a file.  */
 
 
int
int
__gnat_unlink (char *path)
__gnat_unlink (char *path)
{
{
#if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
#if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
  {
  {
    TCHAR wpath[GNAT_MAX_PATH_LEN];
    TCHAR wpath[GNAT_MAX_PATH_LEN];
 
 
    S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
    S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
    return _tunlink (wpath);
    return _tunlink (wpath);
  }
  }
#else
#else
  return unlink (path);
  return unlink (path);
#endif
#endif
}
}
 
 
/* Rename a file.  */
/* Rename a file.  */
 
 
int
int
__gnat_rename (char *from, char *to)
__gnat_rename (char *from, char *to)
{
{
#if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
#if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
  {
  {
    TCHAR wfrom[GNAT_MAX_PATH_LEN], wto[GNAT_MAX_PATH_LEN];
    TCHAR wfrom[GNAT_MAX_PATH_LEN], wto[GNAT_MAX_PATH_LEN];
 
 
    S2WSC (wfrom, from, GNAT_MAX_PATH_LEN);
    S2WSC (wfrom, from, GNAT_MAX_PATH_LEN);
    S2WSC (wto, to, GNAT_MAX_PATH_LEN);
    S2WSC (wto, to, GNAT_MAX_PATH_LEN);
    return _trename (wfrom, wto);
    return _trename (wfrom, wto);
  }
  }
#else
#else
  return rename (from, to);
  return rename (from, to);
#endif
#endif
}
}
 
 
/* Changing directory.  */
/* Changing directory.  */
 
 
int
int
__gnat_chdir (char *path)
__gnat_chdir (char *path)
{
{
#if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
#if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
  {
  {
    TCHAR wpath[GNAT_MAX_PATH_LEN];
    TCHAR wpath[GNAT_MAX_PATH_LEN];
 
 
    S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
    S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
    return _tchdir (wpath);
    return _tchdir (wpath);
  }
  }
#else
#else
  return chdir (path);
  return chdir (path);
#endif
#endif
}
}
 
 
/* Removing a directory.  */
/* Removing a directory.  */
 
 
int
int
__gnat_rmdir (char *path)
__gnat_rmdir (char *path)
{
{
#if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
#if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
  {
  {
    TCHAR wpath[GNAT_MAX_PATH_LEN];
    TCHAR wpath[GNAT_MAX_PATH_LEN];
 
 
    S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
    S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
    return _trmdir (wpath);
    return _trmdir (wpath);
  }
  }
#elif defined (VTHREADS)
#elif defined (VTHREADS)
  /* rmdir not available */
  /* rmdir not available */
  return -1;
  return -1;
#else
#else
  return rmdir (path);
  return rmdir (path);
#endif
#endif
}
}
 
 
FILE *
FILE *
__gnat_fopen (char *path, char *mode, int encoding ATTRIBUTE_UNUSED)
__gnat_fopen (char *path, char *mode, int encoding ATTRIBUTE_UNUSED)
{
{
#if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
#if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
  TCHAR wpath[GNAT_MAX_PATH_LEN];
  TCHAR wpath[GNAT_MAX_PATH_LEN];
  TCHAR wmode[10];
  TCHAR wmode[10];
 
 
  S2WS (wmode, mode, 10);
  S2WS (wmode, mode, 10);
 
 
  if (encoding == Encoding_Unspecified)
  if (encoding == Encoding_Unspecified)
    S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
    S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
  else if (encoding == Encoding_UTF8)
  else if (encoding == Encoding_UTF8)
    S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
    S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
  else
  else
    S2WS (wpath, path, GNAT_MAX_PATH_LEN);
    S2WS (wpath, path, GNAT_MAX_PATH_LEN);
 
 
  return _tfopen (wpath, wmode);
  return _tfopen (wpath, wmode);
#elif defined (VMS)
#elif defined (VMS)
  return decc$fopen (path, mode);
  return decc$fopen (path, mode);
#else
#else
  return GNAT_FOPEN (path, mode);
  return GNAT_FOPEN (path, mode);
#endif
#endif
}
}
 
 
FILE *
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)
#if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
  TCHAR wpath[GNAT_MAX_PATH_LEN];
  TCHAR wpath[GNAT_MAX_PATH_LEN];
  TCHAR wmode[10];
  TCHAR wmode[10];
 
 
  S2WS (wmode, mode, 10);
  S2WS (wmode, mode, 10);
 
 
  if (encoding == Encoding_Unspecified)
  if (encoding == Encoding_Unspecified)
    S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
    S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
  else if (encoding == Encoding_UTF8)
  else if (encoding == Encoding_UTF8)
    S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
    S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
  else
  else
    S2WS (wpath, path, GNAT_MAX_PATH_LEN);
    S2WS (wpath, path, GNAT_MAX_PATH_LEN);
 
 
  return _tfreopen (wpath, wmode, stream);
  return _tfreopen (wpath, wmode, stream);
#elif defined (VMS)
#elif defined (VMS)
  return decc$freopen (path, mode, stream);
  return decc$freopen (path, mode, stream);
#else
#else
  return freopen (path, mode, stream);
  return freopen (path, mode, stream);
#endif
#endif
}
}
 
 
int
int
__gnat_open_read (char *path, int fmode)
__gnat_open_read (char *path, int fmode)
{
{
  int fd;
  int fd;
  int o_fmode = O_BINARY;
  int o_fmode = O_BINARY;
 
 
  if (fmode)
  if (fmode)
    o_fmode = O_TEXT;
    o_fmode = O_TEXT;
 
 
#if defined (VMS)
#if defined (VMS)
  /* Optional arguments mbc,deq,fop increase read performance.  */
  /* Optional arguments mbc,deq,fop increase read performance.  */
  fd = open (path, O_RDONLY | o_fmode, 0444,
  fd = open (path, O_RDONLY | o_fmode, 0444,
             "mbc=16", "deq=64", "fop=tef");
             "mbc=16", "deq=64", "fop=tef");
#elif defined (__vxworks)
#elif defined (__vxworks)
  fd = open (path, O_RDONLY | o_fmode, 0444);
  fd = open (path, O_RDONLY | o_fmode, 0444);
#elif defined (__MINGW32__)
#elif defined (__MINGW32__)
 {
 {
   TCHAR wpath[GNAT_MAX_PATH_LEN];
   TCHAR wpath[GNAT_MAX_PATH_LEN];
 
 
   S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
   S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
   fd = _topen (wpath, O_RDONLY | o_fmode, 0444);
   fd = _topen (wpath, O_RDONLY | o_fmode, 0444);
 }
 }
#else
#else
  fd = open (path, O_RDONLY | o_fmode);
  fd = open (path, O_RDONLY | o_fmode);
#endif
#endif
 
 
  return fd < 0 ? -1 : fd;
  return fd < 0 ? -1 : fd;
}
}
 
 
#if defined (__EMX__) || defined (__MINGW32__)
#if defined (__EMX__) || defined (__MINGW32__)
#define PERM (S_IREAD | S_IWRITE)
#define PERM (S_IREAD | S_IWRITE)
#elif defined (VMS)
#elif defined (VMS)
/* Excerpt from DECC C RTL Reference Manual:
/* Excerpt from DECC C RTL Reference Manual:
   To create files with OpenVMS RMS default protections using the UNIX
   To create files with OpenVMS RMS default protections using the UNIX
   system-call functions umask, mkdir, creat, and open, call mkdir, creat,
   system-call functions umask, mkdir, creat, and open, call mkdir, creat,
   and open with a file-protection mode argument of 0777 in a program
   and open with a file-protection mode argument of 0777 in a program
   that never specifically calls umask. These default protections include
   that never specifically calls umask. These default protections include
   correctly establishing protections based on ACLs, previous versions of
   correctly establishing protections based on ACLs, previous versions of
   files, and so on. */
   files, and so on. */
#define PERM 0777
#define PERM 0777
#else
#else
#define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
#define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
#endif
#endif
 
 
int
int
__gnat_open_rw (char *path, int fmode)
__gnat_open_rw (char *path, int fmode)
{
{
  int fd;
  int fd;
  int o_fmode = O_BINARY;
  int o_fmode = O_BINARY;
 
 
  if (fmode)
  if (fmode)
    o_fmode = O_TEXT;
    o_fmode = O_TEXT;
 
 
#if defined (VMS)
#if defined (VMS)
  fd = open (path, O_RDWR | o_fmode, PERM,
  fd = open (path, O_RDWR | o_fmode, PERM,
             "mbc=16", "deq=64", "fop=tef");
             "mbc=16", "deq=64", "fop=tef");
#elif defined (__MINGW32__)
#elif defined (__MINGW32__)
  {
  {
    TCHAR wpath[GNAT_MAX_PATH_LEN];
    TCHAR wpath[GNAT_MAX_PATH_LEN];
 
 
    S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
    S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
    fd = _topen (wpath, O_RDWR | o_fmode, PERM);
    fd = _topen (wpath, O_RDWR | o_fmode, PERM);
  }
  }
#else
#else
  fd = open (path, O_RDWR | o_fmode, PERM);
  fd = open (path, O_RDWR | o_fmode, PERM);
#endif
#endif
 
 
  return fd < 0 ? -1 : fd;
  return fd < 0 ? -1 : fd;
}
}
 
 
int
int
__gnat_open_create (char *path, int fmode)
__gnat_open_create (char *path, int fmode)
{
{
  int fd;
  int fd;
  int o_fmode = O_BINARY;
  int o_fmode = O_BINARY;
 
 
  if (fmode)
  if (fmode)
    o_fmode = O_TEXT;
    o_fmode = O_TEXT;
 
 
#if defined (VMS)
#if defined (VMS)
  fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM,
  fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM,
             "mbc=16", "deq=64", "fop=tef");
             "mbc=16", "deq=64", "fop=tef");
#elif defined (__MINGW32__)
#elif defined (__MINGW32__)
  {
  {
    TCHAR wpath[GNAT_MAX_PATH_LEN];
    TCHAR wpath[GNAT_MAX_PATH_LEN];
 
 
    S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
    S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
    fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM);
    fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM);
  }
  }
#else
#else
  fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM);
  fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM);
#endif
#endif
 
 
  return fd < 0 ? -1 : fd;
  return fd < 0 ? -1 : fd;
}
}
 
 
int
int
__gnat_create_output_file (char *path)
__gnat_create_output_file (char *path)
{
{
  int fd;
  int fd;
#if defined (VMS)
#if defined (VMS)
  fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM,
  fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM,
             "rfm=stmlf", "ctx=rec", "rat=none", "rop=nlk",
             "rfm=stmlf", "ctx=rec", "rat=none", "rop=nlk",
             "shr=del,get,put,upd");
             "shr=del,get,put,upd");
#elif defined (__MINGW32__)
#elif defined (__MINGW32__)
  {
  {
    TCHAR wpath[GNAT_MAX_PATH_LEN];
    TCHAR wpath[GNAT_MAX_PATH_LEN];
 
 
    S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
    S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
    fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM);
    fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM);
  }
  }
#else
#else
  fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM);
  fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM);
#endif
#endif
 
 
  return fd < 0 ? -1 : fd;
  return fd < 0 ? -1 : fd;
}
}
 
 
int
int
__gnat_create_output_file_new (char *path)
__gnat_create_output_file_new (char *path)
{
{
  int fd;
  int fd;
#if defined (VMS)
#if defined (VMS)
  fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM,
  fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM,
             "rfm=stmlf", "ctx=rec", "rat=none", "rop=nlk",
             "rfm=stmlf", "ctx=rec", "rat=none", "rop=nlk",
             "shr=del,get,put,upd");
             "shr=del,get,put,upd");
#elif defined (__MINGW32__)
#elif defined (__MINGW32__)
  {
  {
    TCHAR wpath[GNAT_MAX_PATH_LEN];
    TCHAR wpath[GNAT_MAX_PATH_LEN];
 
 
    S2WSC (wpath, path, 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);
    fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM);
  }
  }
#else
#else
  fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM);
  fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM);
#endif
#endif
 
 
  return fd < 0 ? -1 : fd;
  return fd < 0 ? -1 : fd;
}
}
 
 
int
int
__gnat_open_append (char *path, int fmode)
__gnat_open_append (char *path, int fmode)
{
{
  int fd;
  int fd;
  int o_fmode = O_BINARY;
  int o_fmode = O_BINARY;
 
 
  if (fmode)
  if (fmode)
    o_fmode = O_TEXT;
    o_fmode = O_TEXT;
 
 
#if defined (VMS)
#if defined (VMS)
  fd = open (path, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM,
  fd = open (path, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM,
             "mbc=16", "deq=64", "fop=tef");
             "mbc=16", "deq=64", "fop=tef");
#elif defined (__MINGW32__)
#elif defined (__MINGW32__)
  {
  {
    TCHAR wpath[GNAT_MAX_PATH_LEN];
    TCHAR wpath[GNAT_MAX_PATH_LEN];
 
 
    S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
    S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
    fd = _topen (wpath, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM);
    fd = _topen (wpath, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM);
  }
  }
#else
#else
  fd = open (path, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM);
  fd = open (path, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM);
#endif
#endif
 
 
  return fd < 0 ? -1 : fd;
  return fd < 0 ? -1 : fd;
}
}
 
 
/*  Open a new file.  Return error (-1) if the file already exists.  */
/*  Open a new file.  Return error (-1) if the file already exists.  */
 
 
int
int
__gnat_open_new (char *path, int fmode)
__gnat_open_new (char *path, int fmode)
{
{
  int fd;
  int fd;
  int o_fmode = O_BINARY;
  int o_fmode = O_BINARY;
 
 
  if (fmode)
  if (fmode)
    o_fmode = O_TEXT;
    o_fmode = O_TEXT;
 
 
#if defined (VMS)
#if defined (VMS)
  fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM,
  fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM,
             "mbc=16", "deq=64", "fop=tef");
             "mbc=16", "deq=64", "fop=tef");
#elif defined (__MINGW32__)
#elif defined (__MINGW32__)
  {
  {
    TCHAR wpath[GNAT_MAX_PATH_LEN];
    TCHAR wpath[GNAT_MAX_PATH_LEN];
 
 
    S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
    S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
    fd = _topen (wpath, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
    fd = _topen (wpath, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
  }
  }
#else
#else
  fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
  fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
#endif
#endif
 
 
  return fd < 0 ? -1 : fd;
  return fd < 0 ? -1 : fd;
}
}
 
 
/* Open a new temp file.  Return error (-1) if the file already exists.
/* Open a new temp file.  Return error (-1) if the file already exists.
   Special options for VMS allow the file to be shared between parent and child
   Special options for VMS allow the file to be shared between parent and child
   processes, however they really slow down output.  Used in gnatchop.  */
   processes, however they really slow down output.  Used in gnatchop.  */
 
 
int
int
__gnat_open_new_temp (char *path, int fmode)
__gnat_open_new_temp (char *path, int fmode)
{
{
  int fd;
  int fd;
  int o_fmode = O_BINARY;
  int o_fmode = O_BINARY;
 
 
  strcpy (path, "GNAT-XXXXXX");
  strcpy (path, "GNAT-XXXXXX");
 
 
#if (defined (__FreeBSD__) || defined (__NetBSD__) || defined (__OpenBSD__) \
#if (defined (__FreeBSD__) || defined (__NetBSD__) || defined (__OpenBSD__) \
  || defined (linux) || defined(__GLIBC__)) && !defined (__vxworks)
  || defined (linux) || defined(__GLIBC__)) && !defined (__vxworks)
  return mkstemp (path);
  return mkstemp (path);
#elif defined (__Lynx__)
#elif defined (__Lynx__)
  mktemp (path);
  mktemp (path);
#elif defined (__nucleus__)
#elif defined (__nucleus__)
  return -1;
  return -1;
#else
#else
  if (mktemp (path) == NULL)
  if (mktemp (path) == NULL)
    return -1;
    return -1;
#endif
#endif
 
 
  if (fmode)
  if (fmode)
    o_fmode = O_TEXT;
    o_fmode = O_TEXT;
 
 
#if defined (VMS)
#if defined (VMS)
  fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM,
  fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM,
             "rfm=stmlf", "ctx=rec", "rat=none", "shr=del,get,put,upd",
             "rfm=stmlf", "ctx=rec", "rat=none", "shr=del,get,put,upd",
             "mbc=16", "deq=64", "fop=tef");
             "mbc=16", "deq=64", "fop=tef");
#else
#else
  fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
  fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
#endif
#endif
 
 
  return fd < 0 ? -1 : fd;
  return fd < 0 ? -1 : fd;
}
}
 
 
/****************************************************************
/****************************************************************
 ** Perform a call to GNAT_STAT or GNAT_FSTAT, and extract as much information
 ** 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
 ** as possible from it, storing the result in a cache for later reuse
 ****************************************************************/
 ****************************************************************/
 
 
void
void
__gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr)
__gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr)
{
{
  GNAT_STRUCT_STAT statbuf;
  GNAT_STRUCT_STAT statbuf;
  int ret;
  int ret;
 
 
  if (fd != -1)
  if (fd != -1)
    ret = GNAT_FSTAT (fd, &statbuf);
    ret = GNAT_FSTAT (fd, &statbuf);
  else
  else
    ret = __gnat_stat (name, &statbuf);
    ret = __gnat_stat (name, &statbuf);
 
 
  attr->regular   = (!ret && S_ISREG (statbuf.st_mode));
  attr->regular   = (!ret && S_ISREG (statbuf.st_mode));
  attr->directory = (!ret && S_ISDIR (statbuf.st_mode));
  attr->directory = (!ret && S_ISDIR (statbuf.st_mode));
 
 
  if (!attr->regular)
  if (!attr->regular)
    attr->file_length = 0;
    attr->file_length = 0;
  else
  else
    /* st_size may be 32 bits, or 64 bits which is converted to long. We
    /* 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
       don't return a useful value for files larger than 2 gigabytes in
       either case. */
       either case. */
    attr->file_length = statbuf.st_size;  /* all systems */
    attr->file_length = statbuf.st_size;  /* all systems */
 
 
#ifndef __MINGW32__
#ifndef __MINGW32__
  /* on Windows requires extra system call, see comment in __gnat_file_exists_attr */
  /* on Windows requires extra system call, see comment in __gnat_file_exists_attr */
  attr->exists = !ret;
  attr->exists = !ret;
#endif
#endif
 
 
#if !defined (_WIN32) || defined (RTX)
#if !defined (_WIN32) || defined (RTX)
  /* on Windows requires extra system call, see __gnat_is_readable_file_attr */
  /* on Windows requires extra system call, see __gnat_is_readable_file_attr */
  attr->readable   = (!ret && (statbuf.st_mode & S_IRUSR));
  attr->readable   = (!ret && (statbuf.st_mode & S_IRUSR));
  attr->writable   = (!ret && (statbuf.st_mode & S_IWUSR));
  attr->writable   = (!ret && (statbuf.st_mode & S_IWUSR));
  attr->executable = (!ret && (statbuf.st_mode & S_IXUSR));
  attr->executable = (!ret && (statbuf.st_mode & S_IXUSR));
#endif
#endif
 
 
#if !defined (__EMX__) && !defined (MSDOS) && (!defined (_WIN32) || defined (RTX))
#if !defined (__EMX__) && !defined (MSDOS) && (!defined (_WIN32) || defined (RTX))
  /* on Windows requires extra system call, see __gnat_file_time_name_attr */
  /* on Windows requires extra system call, see __gnat_file_time_name_attr */
  if (ret != 0) {
  if (ret != 0) {
     attr->timestamp = (OS_Time)-1;
     attr->timestamp = (OS_Time)-1;
  } else {
  } else {
#ifdef VMS
#ifdef VMS
     /* VMS has file versioning.  */
     /* VMS has file versioning.  */
     attr->timestamp = (OS_Time)statbuf.st_ctime;
     attr->timestamp = (OS_Time)statbuf.st_ctime;
#else
#else
     attr->timestamp = (OS_Time)statbuf.st_mtime;
     attr->timestamp = (OS_Time)statbuf.st_mtime;
#endif
#endif
  }
  }
#endif
#endif
 
 
}
}
 
 
/****************************************************************
/****************************************************************
 ** Return the number of bytes in the specified file
 ** Return the number of bytes in the specified file
 ****************************************************************/
 ****************************************************************/
 
 
long
long
__gnat_file_length_attr (int fd, char* name, struct file_attributes* attr)
__gnat_file_length_attr (int fd, char* name, struct file_attributes* attr)
{
{
  if (attr->file_length == -1) {
  if (attr->file_length == -1) {
    __gnat_stat_to_attr (fd, name, attr);
    __gnat_stat_to_attr (fd, name, attr);
  }
  }
 
 
  return attr->file_length;
  return attr->file_length;
}
}
 
 
long
long
__gnat_file_length (int fd)
__gnat_file_length (int fd)
{
{
  struct file_attributes attr;
  struct file_attributes attr;
  __gnat_reset_attributes (&attr);
  __gnat_reset_attributes (&attr);
  return __gnat_file_length_attr (fd, NULL, &attr);
  return __gnat_file_length_attr (fd, NULL, &attr);
}
}
 
 
long
long
__gnat_named_file_length (char *name)
__gnat_named_file_length (char *name)
{
{
  struct file_attributes attr;
  struct file_attributes attr;
  __gnat_reset_attributes (&attr);
  __gnat_reset_attributes (&attr);
  return __gnat_file_length_attr (-1, name, &attr);
  return __gnat_file_length_attr (-1, name, &attr);
}
}
 
 
/* Create a temporary filename and put it in string pointed to by
/* Create a temporary filename and put it in string pointed to by
   TMP_FILENAME.  */
   TMP_FILENAME.  */
 
 
void
void
__gnat_tmp_name (char *tmp_filename)
__gnat_tmp_name (char *tmp_filename)
{
{
#ifdef RTX
#ifdef RTX
  /* Variable used to create a series of unique names */
  /* Variable used to create a series of unique names */
  static int counter = 0;
  static int counter = 0;
 
 
  /* RTX in RTSS mode does not support tempnam nor tmpnam so we emulate it */
  /* RTX in RTSS mode does not support tempnam nor tmpnam so we emulate it */
  strcpy (tmp_filename, "c:\\WINDOWS\\Temp\\gnat-");
  strcpy (tmp_filename, "c:\\WINDOWS\\Temp\\gnat-");
  sprintf (&tmp_filename[strlen (tmp_filename)], "%d\0", counter++);
  sprintf (&tmp_filename[strlen (tmp_filename)], "%d\0", counter++);
 
 
#elif defined (__MINGW32__)
#elif defined (__MINGW32__)
  {
  {
    char *pname;
    char *pname;
 
 
    /* tempnam tries to create a temporary file in directory pointed to by
    /* tempnam tries to create a temporary file in directory pointed to by
       TMP environment variable, in c:\temp if TMP is not set, and in
       TMP environment variable, in c:\temp if TMP is not set, and in
       directory specified by P_tmpdir in stdio.h if c:\temp does not
       directory specified by P_tmpdir in stdio.h if c:\temp does not
       exist. The filename will be created with the prefix "gnat-".  */
       exist. The filename will be created with the prefix "gnat-".  */
 
 
    pname = (char *) tempnam ("c:\\temp", "gnat-");
    pname = (char *) tempnam ("c:\\temp", "gnat-");
 
 
    /* if pname is NULL, the file was not created properly, the disk is full
    /* if pname is NULL, the file was not created properly, the disk is full
       or there is no more free temporary files */
       or there is no more free temporary files */
 
 
    if (pname == NULL)
    if (pname == NULL)
      *tmp_filename = '\0';
      *tmp_filename = '\0';
 
 
    /* If pname start with a back slash and not path information it means that
    /* If pname start with a back slash and not path information it means that
       the filename is valid for the current working directory.  */
       the filename is valid for the current working directory.  */
 
 
    else if (pname[0] == '\\')
    else if (pname[0] == '\\')
      {
      {
        strcpy (tmp_filename, ".\\");
        strcpy (tmp_filename, ".\\");
        strcat (tmp_filename, pname+1);
        strcat (tmp_filename, pname+1);
      }
      }
    else
    else
      strcpy (tmp_filename, pname);
      strcpy (tmp_filename, pname);
 
 
    free (pname);
    free (pname);
  }
  }
 
 
#elif defined (linux) || defined (__FreeBSD__) || defined (__NetBSD__) \
#elif defined (linux) || defined (__FreeBSD__) || defined (__NetBSD__) \
  || defined (__OpenBSD__) || defined(__GLIBC__)
  || defined (__OpenBSD__) || defined(__GLIBC__)
#define MAX_SAFE_PATH 1000
#define MAX_SAFE_PATH 1000
  char *tmpdir = getenv ("TMPDIR");
  char *tmpdir = getenv ("TMPDIR");
 
 
  /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
  /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
     a buffer overflow.  */
     a buffer overflow.  */
  if (tmpdir == NULL || strlen (tmpdir) > MAX_SAFE_PATH)
  if (tmpdir == NULL || strlen (tmpdir) > MAX_SAFE_PATH)
    strcpy (tmp_filename, "/tmp/gnat-XXXXXX");
    strcpy (tmp_filename, "/tmp/gnat-XXXXXX");
  else
  else
    sprintf (tmp_filename, "%s/gnat-XXXXXX", tmpdir);
    sprintf (tmp_filename, "%s/gnat-XXXXXX", tmpdir);
 
 
  close (mkstemp(tmp_filename));
  close (mkstemp(tmp_filename));
#else
#else
  tmpnam (tmp_filename);
  tmpnam (tmp_filename);
#endif
#endif
}
}
 
 
/*  Open directory and returns a DIR pointer.  */
/*  Open directory and returns a DIR pointer.  */
 
 
DIR* __gnat_opendir (char *name)
DIR* __gnat_opendir (char *name)
{
{
#if defined (RTX)
#if defined (RTX)
  /* Not supported in RTX */
  /* Not supported in RTX */
 
 
  return NULL;
  return NULL;
 
 
#elif defined (__MINGW32__)
#elif defined (__MINGW32__)
  TCHAR wname[GNAT_MAX_PATH_LEN];
  TCHAR wname[GNAT_MAX_PATH_LEN];
 
 
  S2WSC (wname, name, GNAT_MAX_PATH_LEN);
  S2WSC (wname, name, GNAT_MAX_PATH_LEN);
  return (DIR*)_topendir (wname);
  return (DIR*)_topendir (wname);
 
 
#else
#else
  return opendir (name);
  return opendir (name);
#endif
#endif
}
}
 
 
/* Read the next entry in a directory.  The returned string points somewhere
/* Read the next entry in a directory.  The returned string points somewhere
   in the buffer.  */
   in the buffer.  */
 
 
char *
char *
__gnat_readdir (DIR *dirp, char *buffer, int *len)
__gnat_readdir (DIR *dirp, char *buffer, int *len)
{
{
#if defined (RTX)
#if defined (RTX)
  /* Not supported in RTX */
  /* Not supported in RTX */
 
 
  return NULL;
  return NULL;
 
 
#elif defined (__MINGW32__)
#elif defined (__MINGW32__)
  struct _tdirent *dirent = _treaddir ((_TDIR*)dirp);
  struct _tdirent *dirent = _treaddir ((_TDIR*)dirp);
 
 
  if (dirent != NULL)
  if (dirent != NULL)
    {
    {
      WS2SC (buffer, dirent->d_name, GNAT_MAX_PATH_LEN);
      WS2SC (buffer, dirent->d_name, GNAT_MAX_PATH_LEN);
      *len = strlen (buffer);
      *len = strlen (buffer);
 
 
      return buffer;
      return buffer;
    }
    }
  else
  else
    return NULL;
    return NULL;
 
 
#elif defined (HAVE_READDIR_R)
#elif defined (HAVE_READDIR_R)
  /* If possible, try to use the thread-safe version.  */
  /* If possible, try to use the thread-safe version.  */
  if (readdir_r (dirp, buffer) != NULL)
  if (readdir_r (dirp, buffer) != NULL)
    {
    {
      *len = strlen (((struct dirent*) buffer)->d_name);
      *len = strlen (((struct dirent*) buffer)->d_name);
      return ((struct dirent*) buffer)->d_name;
      return ((struct dirent*) buffer)->d_name;
    }
    }
  else
  else
    return NULL;
    return NULL;
 
 
#else
#else
  struct dirent *dirent = (struct dirent *) readdir (dirp);
  struct dirent *dirent = (struct dirent *) readdir (dirp);
 
 
  if (dirent != NULL)
  if (dirent != NULL)
    {
    {
      strcpy (buffer, dirent->d_name);
      strcpy (buffer, dirent->d_name);
      *len = strlen (buffer);
      *len = strlen (buffer);
      return buffer;
      return buffer;
    }
    }
  else
  else
    return NULL;
    return NULL;
 
 
#endif
#endif
}
}
 
 
/* Close a directory entry.  */
/* Close a directory entry.  */
 
 
int __gnat_closedir (DIR *dirp)
int __gnat_closedir (DIR *dirp)
{
{
#if defined (RTX)
#if defined (RTX)
  /* Not supported in RTX */
  /* Not supported in RTX */
 
 
  return 0;
  return 0;
 
 
#elif defined (__MINGW32__)
#elif defined (__MINGW32__)
  return _tclosedir ((_TDIR*)dirp);
  return _tclosedir ((_TDIR*)dirp);
 
 
#else
#else
  return closedir (dirp);
  return closedir (dirp);
#endif
#endif
}
}
 
 
/* Returns 1 if readdir is thread safe, 0 otherwise.  */
/* Returns 1 if readdir is thread safe, 0 otherwise.  */
 
 
int
int
__gnat_readdir_is_thread_safe (void)
__gnat_readdir_is_thread_safe (void)
{
{
#ifdef HAVE_READDIR_R
#ifdef HAVE_READDIR_R
  return 1;
  return 1;
#else
#else
  return 0;
  return 0;
#endif
#endif
}
}
 
 
#if defined (_WIN32) && !defined (RTX)
#if defined (_WIN32) && !defined (RTX)
/* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>.  */
/* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>.  */
static const unsigned long long w32_epoch_offset = 11644473600ULL;
static const unsigned long long w32_epoch_offset = 11644473600ULL;
 
 
/* Returns the file modification timestamp using Win32 routines which are
/* Returns the file modification timestamp using Win32 routines which are
   immune against daylight saving time change. It is in fact not possible to
   immune against daylight saving time change. It is in fact not possible to
   use fstat for this purpose as the DST modify the st_mtime field of the
   use fstat for this purpose as the DST modify the st_mtime field of the
   stat structure.  */
   stat structure.  */
 
 
static time_t
static time_t
win32_filetime (HANDLE h)
win32_filetime (HANDLE h)
{
{
  union
  union
  {
  {
    FILETIME ft_time;
    FILETIME ft_time;
    unsigned long long ull_time;
    unsigned long long ull_time;
  } t_write;
  } t_write;
 
 
  /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
  /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
     since <Jan 1st 1601>. This function must return the number of seconds
     since <Jan 1st 1601>. This function must return the number of seconds
     since <Jan 1st 1970>.  */
     since <Jan 1st 1970>.  */
 
 
  if (GetFileTime (h, NULL, NULL, &t_write.ft_time))
  if (GetFileTime (h, NULL, NULL, &t_write.ft_time))
    return (time_t) (t_write.ull_time / 10000000ULL - w32_epoch_offset);
    return (time_t) (t_write.ull_time / 10000000ULL - w32_epoch_offset);
  return (time_t) 0;
  return (time_t) 0;
}
}
#endif
#endif
 
 
/* Return a GNAT time stamp given a file name.  */
/* Return a GNAT time stamp given a file name.  */
 
 
OS_Time
OS_Time
__gnat_file_time_name_attr (char* name, struct file_attributes* attr)
__gnat_file_time_name_attr (char* name, struct file_attributes* attr)
{
{
   if (attr->timestamp == (OS_Time)-2) {
   if (attr->timestamp == (OS_Time)-2) {
#if defined (__EMX__) || defined (MSDOS)
#if defined (__EMX__) || defined (MSDOS)
      int fd = open (name, O_RDONLY | O_BINARY);
      int fd = open (name, O_RDONLY | O_BINARY);
      time_t ret = __gnat_file_time_fd (fd);
      time_t ret = __gnat_file_time_fd (fd);
      close (fd);
      close (fd);
      attr->timestamp = (OS_Time)ret;
      attr->timestamp = (OS_Time)ret;
 
 
#elif defined (_WIN32) && !defined (RTX)
#elif defined (_WIN32) && !defined (RTX)
      time_t ret = -1;
      time_t ret = -1;
      TCHAR wname[GNAT_MAX_PATH_LEN];
      TCHAR wname[GNAT_MAX_PATH_LEN];
      S2WSC (wname, name, GNAT_MAX_PATH_LEN);
      S2WSC (wname, name, GNAT_MAX_PATH_LEN);
 
 
      HANDLE h = CreateFile
      HANDLE h = CreateFile
        (wname, GENERIC_READ, FILE_SHARE_READ, 0,
        (wname, GENERIC_READ, FILE_SHARE_READ, 0,
         OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
         OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
 
 
      if (h != INVALID_HANDLE_VALUE) {
      if (h != INVALID_HANDLE_VALUE) {
         ret = win32_filetime (h);
         ret = win32_filetime (h);
         CloseHandle (h);
         CloseHandle (h);
      }
      }
      attr->timestamp = (OS_Time) ret;
      attr->timestamp = (OS_Time) ret;
#else
#else
      __gnat_stat_to_attr (-1, name, attr);
      __gnat_stat_to_attr (-1, name, attr);
#endif
#endif
  }
  }
  return attr->timestamp;
  return attr->timestamp;
}
}
 
 
OS_Time
OS_Time
__gnat_file_time_name (char *name)
__gnat_file_time_name (char *name)
{
{
   struct file_attributes attr;
   struct file_attributes attr;
   __gnat_reset_attributes (&attr);
   __gnat_reset_attributes (&attr);
   return __gnat_file_time_name_attr (name, &attr);
   return __gnat_file_time_name_attr (name, &attr);
}
}
 
 
/* Return a GNAT time stamp given a file descriptor.  */
/* Return a GNAT time stamp given a file descriptor.  */
 
 
OS_Time
OS_Time
__gnat_file_time_fd_attr (int fd, struct file_attributes* attr)
__gnat_file_time_fd_attr (int fd, struct file_attributes* attr)
{
{
   if (attr->timestamp == (OS_Time)-2) {
   if (attr->timestamp == (OS_Time)-2) {
     /* The following workaround code is due to the fact that under EMX and
     /* 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
        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
        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
        the GNAT timestamp are independent of this behavior, which is desired to
        facilitate the distribution of GNAT compiled libraries.  */
        facilitate the distribution of GNAT compiled libraries.  */
 
 
#if defined (__EMX__) || defined (MSDOS)
#if defined (__EMX__) || defined (MSDOS)
#ifdef __EMX__
#ifdef __EMX__
 
 
     FILESTATUS fs;
     FILESTATUS fs;
     int ret = DosQueryFileInfo (fd, 1, (unsigned char *) &fs,
     int ret = DosQueryFileInfo (fd, 1, (unsigned char *) &fs,
                                   sizeof (FILESTATUS));
                                   sizeof (FILESTATUS));
 
 
     unsigned file_year  = fs.fdateLastWrite.year;
     unsigned file_year  = fs.fdateLastWrite.year;
     unsigned file_month = fs.fdateLastWrite.month;
     unsigned file_month = fs.fdateLastWrite.month;
     unsigned file_day   = fs.fdateLastWrite.day;
     unsigned file_day   = fs.fdateLastWrite.day;
     unsigned file_hour  = fs.ftimeLastWrite.hours;
     unsigned file_hour  = fs.ftimeLastWrite.hours;
     unsigned file_min   = fs.ftimeLastWrite.minutes;
     unsigned file_min   = fs.ftimeLastWrite.minutes;
     unsigned file_tsec  = fs.ftimeLastWrite.twosecs;
     unsigned file_tsec  = fs.ftimeLastWrite.twosecs;
 
 
#else
#else
     struct ftime fs;
     struct ftime fs;
     int ret = getftime (fd, &fs);
     int ret = getftime (fd, &fs);
 
 
     unsigned file_year  = fs.ft_year;
     unsigned file_year  = fs.ft_year;
     unsigned file_month = fs.ft_month;
     unsigned file_month = fs.ft_month;
     unsigned file_day   = fs.ft_day;
     unsigned file_day   = fs.ft_day;
     unsigned file_hour  = fs.ft_hour;
     unsigned file_hour  = fs.ft_hour;
     unsigned file_min   = fs.ft_min;
     unsigned file_min   = fs.ft_min;
     unsigned file_tsec  = fs.ft_tsec;
     unsigned file_tsec  = fs.ft_tsec;
#endif
#endif
 
 
     /* Calculate the seconds since epoch from the time components. First count
     /* 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
        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
        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
        begins in 1970 start with 10 years worth of days and add days for each
        four year period since then.  */
        four year period since then.  */
 
 
     time_t tot_secs;
     time_t tot_secs;
     int cum_days[12] = {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334};
     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 days_passed = 3652 + (file_year / 4) * 1461;
     int years_since_leap = file_year % 4;
     int years_since_leap = file_year % 4;
 
 
     if (years_since_leap == 1)
     if (years_since_leap == 1)
       days_passed += 366;
       days_passed += 366;
     else if (years_since_leap == 2)
     else if (years_since_leap == 2)
       days_passed += 731;
       days_passed += 731;
     else if (years_since_leap == 3)
     else if (years_since_leap == 3)
       days_passed += 1096;
       days_passed += 1096;
 
 
     if (file_year > 20)
     if (file_year > 20)
       days_passed -= 1;
       days_passed -= 1;
 
 
     days_passed += cum_days[file_month - 1];
     days_passed += cum_days[file_month - 1];
     if (years_since_leap == 0 && file_year != 20 && file_month > 2)
     if (years_since_leap == 0 && file_year != 20 && file_month > 2)
       days_passed++;
       days_passed++;
 
 
     days_passed += file_day - 1;
     days_passed += file_day - 1;
 
 
     /* OK - have whole days.  Multiply -- then add in other parts.  */
     /* OK - have whole days.  Multiply -- then add in other parts.  */
 
 
     tot_secs  = days_passed * 86400;
     tot_secs  = days_passed * 86400;
     tot_secs += file_hour * 3600;
     tot_secs += file_hour * 3600;
     tot_secs += file_min * 60;
     tot_secs += file_min * 60;
     tot_secs += file_tsec * 2;
     tot_secs += file_tsec * 2;
     attr->timestamp = (OS_Time) tot_secs;
     attr->timestamp = (OS_Time) tot_secs;
 
 
#elif defined (_WIN32) && !defined (RTX)
#elif defined (_WIN32) && !defined (RTX)
     HANDLE h = (HANDLE) _get_osfhandle (fd);
     HANDLE h = (HANDLE) _get_osfhandle (fd);
     time_t ret = win32_filetime (h);
     time_t ret = win32_filetime (h);
     attr->timestamp = (OS_Time) ret;
     attr->timestamp = (OS_Time) ret;
 
 
#else
#else
     __gnat_stat_to_attr (fd, NULL, attr);
     __gnat_stat_to_attr (fd, NULL, attr);
#endif
#endif
   }
   }
 
 
   return attr->timestamp;
   return attr->timestamp;
}
}
 
 
OS_Time
OS_Time
__gnat_file_time_fd (int fd)
__gnat_file_time_fd (int fd)
{
{
   struct file_attributes attr;
   struct file_attributes attr;
   __gnat_reset_attributes (&attr);
   __gnat_reset_attributes (&attr);
   return __gnat_file_time_fd_attr (fd, &attr);
   return __gnat_file_time_fd_attr (fd, &attr);
}
}
 
 
/* Set the file time stamp.  */
/* Set the file time stamp.  */
 
 
void
void
__gnat_set_file_time_name (char *name, time_t time_stamp)
__gnat_set_file_time_name (char *name, time_t time_stamp)
{
{
#if defined (__EMX__) || defined (MSDOS) || defined (__vxworks)
#if defined (__EMX__) || defined (MSDOS) || defined (__vxworks)
 
 
/* Code to implement __gnat_set_file_time_name for these systems.  */
/* Code to implement __gnat_set_file_time_name for these systems.  */
 
 
#elif defined (_WIN32) && !defined (RTX)
#elif defined (_WIN32) && !defined (RTX)
  union
  union
  {
  {
    FILETIME ft_time;
    FILETIME ft_time;
    unsigned long long ull_time;
    unsigned long long ull_time;
  } t_write;
  } t_write;
  TCHAR wname[GNAT_MAX_PATH_LEN];
  TCHAR wname[GNAT_MAX_PATH_LEN];
 
 
  S2WSC (wname, name, GNAT_MAX_PATH_LEN);
  S2WSC (wname, name, GNAT_MAX_PATH_LEN);
 
 
  HANDLE h  = CreateFile
  HANDLE h  = CreateFile
    (wname, GENERIC_WRITE, FILE_SHARE_WRITE, NULL,
    (wname, GENERIC_WRITE, FILE_SHARE_WRITE, NULL,
     OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS,
     OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS,
     NULL);
     NULL);
  if (h == INVALID_HANDLE_VALUE)
  if (h == INVALID_HANDLE_VALUE)
    return;
    return;
  /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
  /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
  t_write.ull_time = ((unsigned long long)time_stamp + w32_epoch_offset);
  t_write.ull_time = ((unsigned long long)time_stamp + w32_epoch_offset);
  /*  Convert to 100 nanosecond units  */
  /*  Convert to 100 nanosecond units  */
  t_write.ull_time *= 10000000ULL;
  t_write.ull_time *= 10000000ULL;
 
 
  SetFileTime(h, NULL, NULL, &t_write.ft_time);
  SetFileTime(h, NULL, NULL, &t_write.ft_time);
  CloseHandle (h);
  CloseHandle (h);
  return;
  return;
 
 
#elif defined (VMS)
#elif defined (VMS)
  struct FAB fab;
  struct FAB fab;
  struct NAM nam;
  struct NAM nam;
 
 
  struct
  struct
    {
    {
      unsigned long long backup, create, expire, revise;
      unsigned long long backup, create, expire, revise;
      unsigned int uic;
      unsigned int uic;
      union
      union
        {
        {
          unsigned short value;
          unsigned short value;
          struct
          struct
            {
            {
              unsigned system : 4;
              unsigned system : 4;
              unsigned owner  : 4;
              unsigned owner  : 4;
              unsigned group  : 4;
              unsigned group  : 4;
              unsigned world  : 4;
              unsigned world  : 4;
            } bits;
            } bits;
        } prot;
        } prot;
    } Fat = { 0, 0, 0, 0, 0, { 0 }};
    } Fat = { 0, 0, 0, 0, 0, { 0 }};
 
 
  ATRDEF atrlst[]
  ATRDEF atrlst[]
    = {
    = {
      { ATR$S_CREDATE,  ATR$C_CREDATE,  &Fat.create },
      { ATR$S_CREDATE,  ATR$C_CREDATE,  &Fat.create },
      { ATR$S_REVDATE,  ATR$C_REVDATE,  &Fat.revise },
      { ATR$S_REVDATE,  ATR$C_REVDATE,  &Fat.revise },
      { ATR$S_EXPDATE,  ATR$C_EXPDATE,  &Fat.expire },
      { ATR$S_EXPDATE,  ATR$C_EXPDATE,  &Fat.expire },
      { ATR$S_BAKDATE,  ATR$C_BAKDATE,  &Fat.backup },
      { ATR$S_BAKDATE,  ATR$C_BAKDATE,  &Fat.backup },
      { ATR$S_FPRO,     ATR$C_FPRO,     &Fat.prot },
      { ATR$S_FPRO,     ATR$C_FPRO,     &Fat.prot },
      { ATR$S_UIC,      ATR$C_UIC,      &Fat.uic },
      { ATR$S_UIC,      ATR$C_UIC,      &Fat.uic },
      { 0, 0, 0}
      { 0, 0, 0}
    };
    };
 
 
  FIBDEF fib;
  FIBDEF fib;
  struct dsc$descriptor_fib fibdsc = {sizeof (fib), (void *) &fib};
  struct dsc$descriptor_fib fibdsc = {sizeof (fib), (void *) &fib};
 
 
  struct IOSB iosb;
  struct IOSB iosb;
 
 
  unsigned long long newtime;
  unsigned long long newtime;
  unsigned long long revtime;
  unsigned long long revtime;
  long status;
  long status;
  short chan;
  short chan;
 
 
  struct vstring file;
  struct vstring file;
  struct dsc$descriptor_s filedsc
  struct dsc$descriptor_s filedsc
    = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) file.string};
    = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) file.string};
  struct vstring device;
  struct vstring device;
  struct dsc$descriptor_s devicedsc
  struct dsc$descriptor_s devicedsc
    = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) device.string};
    = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) device.string};
  struct vstring timev;
  struct vstring timev;
  struct dsc$descriptor_s timedsc
  struct dsc$descriptor_s timedsc
    = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) timev.string};
    = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) timev.string};
  struct vstring result;
  struct vstring result;
  struct dsc$descriptor_s resultdsc
  struct dsc$descriptor_s resultdsc
    = {NAM$C_MAXRSS, DSC$K_DTYPE_VT, DSC$K_CLASS_VS, (void *) result.string};
    = {NAM$C_MAXRSS, DSC$K_DTYPE_VT, DSC$K_CLASS_VS, (void *) result.string};
 
 
  /* Convert parameter name (a file spec) to host file form. Note that this
  /* Convert parameter name (a file spec) to host file form. Note that this
     is needed on VMS to prepare for subsequent calls to VMS RMS library
     is needed on VMS to prepare for subsequent calls to VMS RMS library
     routines. Note that it would not work to call __gnat_to_host_dir_spec
     routines. Note that it would not work to call __gnat_to_host_dir_spec
     as was done in a previous version, since this fails silently unless
     as was done in a previous version, since this fails silently unless
     the feature logical DECC$EFS_CHARSET is enabled, in which case a DNF
     the feature logical DECC$EFS_CHARSET is enabled, in which case a DNF
     (directory not found) condition is signalled.  */
     (directory not found) condition is signalled.  */
  tryfile = (char *) __gnat_to_host_file_spec (name);
  tryfile = (char *) __gnat_to_host_file_spec (name);
 
 
  /* Allocate and initialize a FAB and NAM structures.  */
  /* Allocate and initialize a FAB and NAM structures.  */
  fab = cc$rms_fab;
  fab = cc$rms_fab;
  nam = cc$rms_nam;
  nam = cc$rms_nam;
 
 
  nam.nam$l_esa = file.string;
  nam.nam$l_esa = file.string;
  nam.nam$b_ess = NAM$C_MAXRSS;
  nam.nam$b_ess = NAM$C_MAXRSS;
  nam.nam$l_rsa = result.string;
  nam.nam$l_rsa = result.string;
  nam.nam$b_rss = NAM$C_MAXRSS;
  nam.nam$b_rss = NAM$C_MAXRSS;
  fab.fab$l_fna = tryfile;
  fab.fab$l_fna = tryfile;
  fab.fab$b_fns = strlen (tryfile);
  fab.fab$b_fns = strlen (tryfile);
  fab.fab$l_nam = &nam;
  fab.fab$l_nam = &nam;
 
 
  /* Validate filespec syntax and device existence.  */
  /* Validate filespec syntax and device existence.  */
  status = SYS$PARSE (&fab, 0, 0);
  status = SYS$PARSE (&fab, 0, 0);
  if ((status & 1) != 1)
  if ((status & 1) != 1)
    LIB$SIGNAL (status);
    LIB$SIGNAL (status);
 
 
  file.string[nam.nam$b_esl] = 0;
  file.string[nam.nam$b_esl] = 0;
 
 
  /* Find matching filespec.  */
  /* Find matching filespec.  */
  status = SYS$SEARCH (&fab, 0, 0);
  status = SYS$SEARCH (&fab, 0, 0);
  if ((status & 1) != 1)
  if ((status & 1) != 1)
    LIB$SIGNAL (status);
    LIB$SIGNAL (status);
 
 
  file.string[nam.nam$b_esl] = 0;
  file.string[nam.nam$b_esl] = 0;
  result.string[result.length=nam.nam$b_rsl] = 0;
  result.string[result.length=nam.nam$b_rsl] = 0;
 
 
  /* Get the device name and assign an IO channel.  */
  /* Get the device name and assign an IO channel.  */
  strncpy (device.string, nam.nam$l_dev, nam.nam$b_dev);
  strncpy (device.string, nam.nam$l_dev, nam.nam$b_dev);
  devicedsc.dsc$w_length  = nam.nam$b_dev;
  devicedsc.dsc$w_length  = nam.nam$b_dev;
  chan = 0;
  chan = 0;
  status = SYS$ASSIGN (&devicedsc, &chan, 0, 0, 0);
  status = SYS$ASSIGN (&devicedsc, &chan, 0, 0, 0);
  if ((status & 1) != 1)
  if ((status & 1) != 1)
    LIB$SIGNAL (status);
    LIB$SIGNAL (status);
 
 
  /* Initialize the FIB and fill in the directory id field.  */
  /* Initialize the FIB and fill in the directory id field.  */
  memset (&fib, 0, sizeof (fib));
  memset (&fib, 0, sizeof (fib));
  fib.fib$w_did[0]  = nam.nam$w_did[0];
  fib.fib$w_did[0]  = nam.nam$w_did[0];
  fib.fib$w_did[1]  = nam.nam$w_did[1];
  fib.fib$w_did[1]  = nam.nam$w_did[1];
  fib.fib$w_did[2]  = nam.nam$w_did[2];
  fib.fib$w_did[2]  = nam.nam$w_did[2];
  fib.fib$l_acctl = 0;
  fib.fib$l_acctl = 0;
  fib.fib$l_wcc = 0;
  fib.fib$l_wcc = 0;
  strcpy (file.string, (strrchr (result.string, ']') + 1));
  strcpy (file.string, (strrchr (result.string, ']') + 1));
  filedsc.dsc$w_length = strlen (file.string);
  filedsc.dsc$w_length = strlen (file.string);
  result.string[result.length = 0] = 0;
  result.string[result.length = 0] = 0;
 
 
  /* Open and close the file to fill in the attributes.  */
  /* Open and close the file to fill in the attributes.  */
  status
  status
    = SYS$QIOW (0, chan, IO$_ACCESS|IO$M_ACCESS, &iosb, 0, 0,
    = SYS$QIOW (0, chan, IO$_ACCESS|IO$M_ACCESS, &iosb, 0, 0,
                &fibdsc, &filedsc, &result.length, &resultdsc, &atrlst, 0);
                &fibdsc, &filedsc, &result.length, &resultdsc, &atrlst, 0);
  if ((status & 1) != 1)
  if ((status & 1) != 1)
    LIB$SIGNAL (status);
    LIB$SIGNAL (status);
  if ((iosb.status & 1) != 1)
  if ((iosb.status & 1) != 1)
    LIB$SIGNAL (iosb.status);
    LIB$SIGNAL (iosb.status);
 
 
  result.string[result.length] = 0;
  result.string[result.length] = 0;
  status = SYS$QIOW (0, chan, IO$_DEACCESS, &iosb, 0, 0, &fibdsc, 0, 0, 0,
  status = SYS$QIOW (0, chan, IO$_DEACCESS, &iosb, 0, 0, &fibdsc, 0, 0, 0,
                     &atrlst, 0);
                     &atrlst, 0);
  if ((status & 1) != 1)
  if ((status & 1) != 1)
    LIB$SIGNAL (status);
    LIB$SIGNAL (status);
  if ((iosb.status & 1) != 1)
  if ((iosb.status & 1) != 1)
    LIB$SIGNAL (iosb.status);
    LIB$SIGNAL (iosb.status);
 
 
  {
  {
    time_t t;
    time_t t;
 
 
    /* Set creation time to requested time.  */
    /* Set creation time to requested time.  */
    unix_time_to_vms (time_stamp, newtime);
    unix_time_to_vms (time_stamp, newtime);
 
 
    t = time ((time_t) 0);
    t = time ((time_t) 0);
 
 
    /* Set revision time to now in local time.  */
    /* Set revision time to now in local time.  */
    unix_time_to_vms (t, revtime);
    unix_time_to_vms (t, revtime);
  }
  }
 
 
  /* Reopen the file, modify the times and then close.  */
  /* Reopen the file, modify the times and then close.  */
  fib.fib$l_acctl = FIB$M_WRITE;
  fib.fib$l_acctl = FIB$M_WRITE;
  status
  status
    = SYS$QIOW (0, chan, IO$_ACCESS|IO$M_ACCESS, &iosb, 0, 0,
    = SYS$QIOW (0, chan, IO$_ACCESS|IO$M_ACCESS, &iosb, 0, 0,
                &fibdsc, &filedsc, &result.length, &resultdsc, &atrlst, 0);
                &fibdsc, &filedsc, &result.length, &resultdsc, &atrlst, 0);
  if ((status & 1) != 1)
  if ((status & 1) != 1)
    LIB$SIGNAL (status);
    LIB$SIGNAL (status);
  if ((iosb.status & 1) != 1)
  if ((iosb.status & 1) != 1)
    LIB$SIGNAL (iosb.status);
    LIB$SIGNAL (iosb.status);
 
 
  Fat.create = newtime;
  Fat.create = newtime;
  Fat.revise = revtime;
  Fat.revise = revtime;
 
 
  status = SYS$QIOW (0, chan, IO$_DEACCESS, &iosb, 0, 0,
  status = SYS$QIOW (0, chan, IO$_DEACCESS, &iosb, 0, 0,
                     &fibdsc, 0, 0, 0, &atrlst, 0);
                     &fibdsc, 0, 0, 0, &atrlst, 0);
  if ((status & 1) != 1)
  if ((status & 1) != 1)
    LIB$SIGNAL (status);
    LIB$SIGNAL (status);
  if ((iosb.status & 1) != 1)
  if ((iosb.status & 1) != 1)
    LIB$SIGNAL (iosb.status);
    LIB$SIGNAL (iosb.status);
 
 
  /* Deassign the channel and exit.  */
  /* Deassign the channel and exit.  */
  status = SYS$DASSGN (chan);
  status = SYS$DASSGN (chan);
  if ((status & 1) != 1)
  if ((status & 1) != 1)
    LIB$SIGNAL (status);
    LIB$SIGNAL (status);
#else
#else
  struct utimbuf utimbuf;
  struct utimbuf utimbuf;
  time_t t;
  time_t t;
 
 
  /* Set modification time to requested time.  */
  /* Set modification time to requested time.  */
  utimbuf.modtime = time_stamp;
  utimbuf.modtime = time_stamp;
 
 
  /* Set access time to now in local time.  */
  /* Set access time to now in local time.  */
  t = time ((time_t) 0);
  t = time ((time_t) 0);
  utimbuf.actime = mktime (localtime (&t));
  utimbuf.actime = mktime (localtime (&t));
 
 
  utime (name, &utimbuf);
  utime (name, &utimbuf);
#endif
#endif
}
}
 
 
/* Get the list of installed standard libraries from the
/* Get the list of installed standard libraries from the
   HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
   HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
   key.  */
   key.  */
 
 
char *
char *
__gnat_get_libraries_from_registry (void)
__gnat_get_libraries_from_registry (void)
{
{
  char *result = (char *) xmalloc (1);
  char *result = (char *) xmalloc (1);
 
 
  result[0] = '\0';
  result[0] = '\0';
 
 
#if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS) \
#if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS) \
  && ! defined (RTX)
  && ! defined (RTX)
 
 
  HKEY reg_key;
  HKEY reg_key;
  DWORD name_size, value_size;
  DWORD name_size, value_size;
  char name[256];
  char name[256];
  char value[256];
  char value[256];
  DWORD type;
  DWORD type;
  DWORD index;
  DWORD index;
  LONG res;
  LONG res;
 
 
  /* First open the key.  */
  /* First open the key.  */
  res = RegOpenKeyExA (HKEY_LOCAL_MACHINE, "SOFTWARE", 0, KEY_READ, &reg_key);
  res = RegOpenKeyExA (HKEY_LOCAL_MACHINE, "SOFTWARE", 0, KEY_READ, &reg_key);
 
 
  if (res == ERROR_SUCCESS)
  if (res == ERROR_SUCCESS)
    res = RegOpenKeyExA (reg_key, "Ada Core Technologies", 0,
    res = RegOpenKeyExA (reg_key, "Ada Core Technologies", 0,
                         KEY_READ, &reg_key);
                         KEY_READ, &reg_key);
 
 
  if (res == ERROR_SUCCESS)
  if (res == ERROR_SUCCESS)
    res = RegOpenKeyExA (reg_key, "GNAT", 0, KEY_READ, &reg_key);
    res = RegOpenKeyExA (reg_key, "GNAT", 0, KEY_READ, &reg_key);
 
 
  if (res == ERROR_SUCCESS)
  if (res == ERROR_SUCCESS)
    res = RegOpenKeyExA (reg_key, "Standard Libraries", 0, KEY_READ, &reg_key);
    res = RegOpenKeyExA (reg_key, "Standard Libraries", 0, KEY_READ, &reg_key);
 
 
  /* If the key exists, read out all the values in it and concatenate them
  /* If the key exists, read out all the values in it and concatenate them
     into a path.  */
     into a path.  */
  for (index = 0; res == ERROR_SUCCESS; index++)
  for (index = 0; res == ERROR_SUCCESS; index++)
    {
    {
      value_size = name_size = 256;
      value_size = name_size = 256;
      res = RegEnumValueA (reg_key, index, name, &name_size, 0,
      res = RegEnumValueA (reg_key, index, name, &name_size, 0,
                           &type, (LPBYTE)value, &value_size);
                           &type, (LPBYTE)value, &value_size);
 
 
      if (res == ERROR_SUCCESS && type == REG_SZ)
      if (res == ERROR_SUCCESS && type == REG_SZ)
        {
        {
          char *old_result = result;
          char *old_result = result;
 
 
          result = (char *) xmalloc (strlen (old_result) + value_size + 2);
          result = (char *) xmalloc (strlen (old_result) + value_size + 2);
          strcpy (result, old_result);
          strcpy (result, old_result);
          strcat (result, value);
          strcat (result, value);
          strcat (result, ";");
          strcat (result, ";");
          free (old_result);
          free (old_result);
        }
        }
    }
    }
 
 
  /* Remove the trailing ";".  */
  /* Remove the trailing ";".  */
  if (result[0] != 0)
  if (result[0] != 0)
    result[strlen (result) - 1] = 0;
    result[strlen (result) - 1] = 0;
 
 
#endif
#endif
  return result;
  return result;
}
}
 
 
int
int
__gnat_stat (char *name, GNAT_STRUCT_STAT *statbuf)
__gnat_stat (char *name, GNAT_STRUCT_STAT *statbuf)
{
{
#ifdef __MINGW32__
#ifdef __MINGW32__
  /* Under Windows the directory name for the stat function must not be
  /* Under Windows the directory name for the stat function must not be
     terminated by a directory separator except if just after a drive name
     terminated by a directory separator except if just after a drive name
     or with UNC path without directory (only the name of the shared
     or with UNC path without directory (only the name of the shared
     resource), for example: \\computer\share\  */
     resource), for example: \\computer\share\  */
 
 
  TCHAR wname [GNAT_MAX_PATH_LEN + 2];
  TCHAR wname [GNAT_MAX_PATH_LEN + 2];
  int name_len, k;
  int name_len, k;
  TCHAR last_char;
  TCHAR last_char;
  int dirsep_count = 0;
  int dirsep_count = 0;
 
 
  S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
  S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
  name_len = _tcslen (wname);
  name_len = _tcslen (wname);
 
 
  if (name_len > GNAT_MAX_PATH_LEN)
  if (name_len > GNAT_MAX_PATH_LEN)
    return -1;
    return -1;
 
 
  last_char = wname[name_len - 1];
  last_char = wname[name_len - 1];
 
 
  while (name_len > 1 && (last_char == _T('\\') || last_char == _T('/')))
  while (name_len > 1 && (last_char == _T('\\') || last_char == _T('/')))
    {
    {
      wname[name_len - 1] = _T('\0');
      wname[name_len - 1] = _T('\0');
      name_len--;
      name_len--;
      last_char = wname[name_len - 1];
      last_char = wname[name_len - 1];
    }
    }
 
 
  /* Count back-slashes.  */
  /* Count back-slashes.  */
 
 
  for (k=0; k<name_len; k++)
  for (k=0; k<name_len; k++)
    if (wname[k] == _T('\\') || wname[k] == _T('/'))
    if (wname[k] == _T('\\') || wname[k] == _T('/'))
      dirsep_count++;
      dirsep_count++;
 
 
  /* Only a drive letter followed by ':', we must add a directory separator
  /* Only a drive letter followed by ':', we must add a directory separator
     for the stat routine to work properly.  */
     for the stat routine to work properly.  */
  if ((name_len == 2 && wname[1] == _T(':'))
  if ((name_len == 2 && wname[1] == _T(':'))
      || (name_len > 3 && wname[0] == _T('\\') && wname[1] == _T('\\')
      || (name_len > 3 && wname[0] == _T('\\') && wname[1] == _T('\\')
          && dirsep_count == 3))
          && dirsep_count == 3))
    _tcscat (wname, _T("\\"));
    _tcscat (wname, _T("\\"));
 
 
  return _tstat (wname, (struct _stat *)statbuf);
  return _tstat (wname, (struct _stat *)statbuf);
 
 
#else
#else
  return GNAT_STAT (name, statbuf);
  return GNAT_STAT (name, statbuf);
#endif
#endif
}
}
 
 
/*************************************************************************
/*************************************************************************
 ** Check whether a file exists
 ** Check whether a file exists
 *************************************************************************/
 *************************************************************************/
 
 
int
int
__gnat_file_exists_attr (char* name, struct file_attributes* attr)
__gnat_file_exists_attr (char* name, struct file_attributes* attr)
{
{
   if (attr->exists == ATTR_UNSET) {
   if (attr->exists == ATTR_UNSET) {
#ifdef __MINGW32__
#ifdef __MINGW32__
      /*  On Windows do not use __gnat_stat() because of a bug in Microsoft
      /*  On Windows do not use __gnat_stat() because of a bug in Microsoft
         _stat() routine. When the system time-zone is set with a negative
         _stat() routine. When the system time-zone is set with a negative
         offset the _stat() routine fails on specific files like CON:  */
         offset the _stat() routine fails on specific files like CON:  */
      TCHAR wname [GNAT_MAX_PATH_LEN + 2];
      TCHAR wname [GNAT_MAX_PATH_LEN + 2];
      S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
      S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
      attr->exists = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
      attr->exists = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
#else
#else
      __gnat_stat_to_attr (-1, name, attr);
      __gnat_stat_to_attr (-1, name, attr);
#endif
#endif
   }
   }
 
 
   return attr->exists;
   return attr->exists;
}
}
 
 
int
int
__gnat_file_exists (char *name)
__gnat_file_exists (char *name)
{
{
   struct file_attributes attr;
   struct file_attributes attr;
   __gnat_reset_attributes (&attr);
   __gnat_reset_attributes (&attr);
   return __gnat_file_exists_attr (name, &attr);
   return __gnat_file_exists_attr (name, &attr);
}
}
 
 
/**********************************************************************
/**********************************************************************
 ** Whether name is an absolute path
 ** Whether name is an absolute path
 **********************************************************************/
 **********************************************************************/
 
 
int
int
__gnat_is_absolute_path (char *name, int length)
__gnat_is_absolute_path (char *name, int length)
{
{
#ifdef __vxworks
#ifdef __vxworks
  /* On VxWorks systems, an absolute path can be represented (depending on
  /* On VxWorks systems, an absolute path can be represented (depending on
     the host platform) as either /dir/file, or device:/dir/file, or
     the host platform) as either /dir/file, or device:/dir/file, or
     device:drive_letter:/dir/file. */
     device:drive_letter:/dir/file. */
 
 
  int index;
  int index;
 
 
  if (name[0] == '/')
  if (name[0] == '/')
    return 1;
    return 1;
 
 
  for (index = 0; index < length; index++)
  for (index = 0; index < length; index++)
    {
    {
      if (name[index] == ':' &&
      if (name[index] == ':' &&
          ((name[index + 1] == '/') ||
          ((name[index + 1] == '/') ||
           (isalpha (name[index + 1]) && index + 2 <= length &&
           (isalpha (name[index + 1]) && index + 2 <= length &&
            name[index + 2] == '/')))
            name[index + 2] == '/')))
        return 1;
        return 1;
 
 
      else if (name[index] == '/')
      else if (name[index] == '/')
        return 0;
        return 0;
    }
    }
  return 0;
  return 0;
#else
#else
  return (length != 0) &&
  return (length != 0) &&
     (*name == '/' || *name == DIR_SEPARATOR
     (*name == '/' || *name == DIR_SEPARATOR
#if defined (__EMX__) || defined (MSDOS) || defined (WINNT)
#if defined (__EMX__) || defined (MSDOS) || defined (WINNT)
      || (length > 1 && ISALPHA (name[0]) && name[1] == ':')
      || (length > 1 && ISALPHA (name[0]) && name[1] == ':')
#endif
#endif
          );
          );
#endif
#endif
}
}
 
 
int
int
__gnat_is_regular_file_attr (char* name, struct file_attributes* attr)
__gnat_is_regular_file_attr (char* name, struct file_attributes* attr)
{
{
   if (attr->regular == ATTR_UNSET) {
   if (attr->regular == ATTR_UNSET) {
      __gnat_stat_to_attr (-1, name, attr);
      __gnat_stat_to_attr (-1, name, attr);
   }
   }
 
 
   return attr->regular;
   return attr->regular;
}
}
 
 
int
int
__gnat_is_regular_file (char *name)
__gnat_is_regular_file (char *name)
{
{
   struct file_attributes attr;
   struct file_attributes attr;
   __gnat_reset_attributes (&attr);
   __gnat_reset_attributes (&attr);
   return __gnat_is_regular_file_attr (name, &attr);
   return __gnat_is_regular_file_attr (name, &attr);
}
}
 
 
int
int
__gnat_is_directory_attr (char* name, struct file_attributes* attr)
__gnat_is_directory_attr (char* name, struct file_attributes* attr)
{
{
   if (attr->directory == ATTR_UNSET) {
   if (attr->directory == ATTR_UNSET) {
      __gnat_stat_to_attr (-1, name, attr);
      __gnat_stat_to_attr (-1, name, attr);
   }
   }
 
 
   return attr->directory;
   return attr->directory;
}
}
 
 
int
int
__gnat_is_directory (char *name)
__gnat_is_directory (char *name)
{
{
   struct file_attributes attr;
   struct file_attributes attr;
   __gnat_reset_attributes (&attr);
   __gnat_reset_attributes (&attr);
   return __gnat_is_directory_attr (name, &attr);
   return __gnat_is_directory_attr (name, &attr);
}
}
 
 
#if defined (_WIN32) && !defined (RTX)
#if defined (_WIN32) && !defined (RTX)
 
 
/* Returns the same constant as GetDriveType but takes a pathname as
/* Returns the same constant as GetDriveType but takes a pathname as
   argument. */
   argument. */
 
 
static UINT
static UINT
GetDriveTypeFromPath (TCHAR *wfullpath)
GetDriveTypeFromPath (TCHAR *wfullpath)
{
{
  TCHAR wdrv[MAX_PATH];
  TCHAR wdrv[MAX_PATH];
  TCHAR wpath[MAX_PATH];
  TCHAR wpath[MAX_PATH];
  TCHAR wfilename[MAX_PATH];
  TCHAR wfilename[MAX_PATH];
  TCHAR wext[MAX_PATH];
  TCHAR wext[MAX_PATH];
 
 
  _tsplitpath (wfullpath, wdrv, wpath, wfilename, wext);
  _tsplitpath (wfullpath, wdrv, wpath, wfilename, wext);
 
 
  if (_tcslen (wdrv) != 0)
  if (_tcslen (wdrv) != 0)
    {
    {
      /* we have a drive specified. */
      /* we have a drive specified. */
      _tcscat (wdrv, _T("\\"));
      _tcscat (wdrv, _T("\\"));
      return GetDriveType (wdrv);
      return GetDriveType (wdrv);
    }
    }
  else
  else
    {
    {
      /* No drive specified. */
      /* No drive specified. */
 
 
      /* Is this a relative path, if so get current drive type. */
      /* Is this a relative path, if so get current drive type. */
      if (wpath[0] != _T('\\') ||
      if (wpath[0] != _T('\\') ||
          (_tcslen (wpath) > 2 && wpath[0] == _T('\\') && wpath[1] != _T('\\')))
          (_tcslen (wpath) > 2 && wpath[0] == _T('\\') && wpath[1] != _T('\\')))
        return GetDriveType (NULL);
        return GetDriveType (NULL);
 
 
      UINT result = GetDriveType (wpath);
      UINT result = GetDriveType (wpath);
 
 
      /* Cannot guess the drive type, is this \\.\ ? */
      /* Cannot guess the drive type, is this \\.\ ? */
 
 
      if (result == DRIVE_NO_ROOT_DIR &&
      if (result == DRIVE_NO_ROOT_DIR &&
         _tcslen (wpath) >= 4 && wpath[0] == _T('\\') && wpath[1] == _T('\\')
         _tcslen (wpath) >= 4 && wpath[0] == _T('\\') && wpath[1] == _T('\\')
          && wpath[2] == _T('.') && wpath[3] == _T('\\'))
          && wpath[2] == _T('.') && wpath[3] == _T('\\'))
        {
        {
          if (_tcslen (wpath) == 4)
          if (_tcslen (wpath) == 4)
            _tcscat (wpath, wfilename);
            _tcscat (wpath, wfilename);
 
 
          LPTSTR p = &wpath[4];
          LPTSTR p = &wpath[4];
          LPTSTR b = _tcschr (p, _T('\\'));
          LPTSTR b = _tcschr (p, _T('\\'));
 
 
          if (b != NULL)
          if (b != NULL)
            { /* logical drive \\.\c\dir\file */
            { /* logical drive \\.\c\dir\file */
              *b++ = _T(':');
              *b++ = _T(':');
              *b++ = _T('\\');
              *b++ = _T('\\');
              *b = _T('\0');
              *b = _T('\0');
            }
            }
          else
          else
            _tcscat (p, _T(":\\"));
            _tcscat (p, _T(":\\"));
 
 
          return GetDriveType (p);
          return GetDriveType (p);
        }
        }
 
 
      return result;
      return result;
    }
    }
}
}
 
 
/*  This MingW section contains code to work with ACL. */
/*  This MingW section contains code to work with ACL. */
static int
static int
__gnat_check_OWNER_ACL
__gnat_check_OWNER_ACL
(TCHAR *wname,
(TCHAR *wname,
 DWORD CheckAccessDesired,
 DWORD CheckAccessDesired,
 GENERIC_MAPPING CheckGenericMapping)
 GENERIC_MAPPING CheckGenericMapping)
{
{
  DWORD dwAccessDesired, dwAccessAllowed;
  DWORD dwAccessDesired, dwAccessAllowed;
  PRIVILEGE_SET PrivilegeSet;
  PRIVILEGE_SET PrivilegeSet;
  DWORD dwPrivSetSize = sizeof (PRIVILEGE_SET);
  DWORD dwPrivSetSize = sizeof (PRIVILEGE_SET);
  BOOL fAccessGranted = FALSE;
  BOOL fAccessGranted = FALSE;
  HANDLE hToken = NULL;
  HANDLE hToken = NULL;
  DWORD nLength = 0;
  DWORD nLength = 0;
  SECURITY_DESCRIPTOR* pSD = NULL;
  SECURITY_DESCRIPTOR* pSD = NULL;
 
 
  GetFileSecurity
  GetFileSecurity
    (wname, OWNER_SECURITY_INFORMATION |
    (wname, OWNER_SECURITY_INFORMATION |
     GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION,
     GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION,
     NULL, 0, &nLength);
     NULL, 0, &nLength);
 
 
  if ((pSD = (PSECURITY_DESCRIPTOR) HeapAlloc
  if ((pSD = (PSECURITY_DESCRIPTOR) HeapAlloc
       (GetProcessHeap (), HEAP_ZERO_MEMORY, nLength)) == NULL)
       (GetProcessHeap (), HEAP_ZERO_MEMORY, nLength)) == NULL)
    return 0;
    return 0;
 
 
  /* Obtain the security descriptor. */
  /* Obtain the security descriptor. */
 
 
  if (!GetFileSecurity
  if (!GetFileSecurity
      (wname, OWNER_SECURITY_INFORMATION |
      (wname, OWNER_SECURITY_INFORMATION |
       GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION,
       GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION,
       pSD, nLength, &nLength))
       pSD, nLength, &nLength))
    goto error;
    goto error;
 
 
  if (!ImpersonateSelf (SecurityImpersonation))
  if (!ImpersonateSelf (SecurityImpersonation))
    goto error;
    goto error;
 
 
  if (!OpenThreadToken
  if (!OpenThreadToken
      (GetCurrentThread(), TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, &hToken))
      (GetCurrentThread(), TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, &hToken))
    goto error;
    goto error;
 
 
  /*  Undoes the effect of ImpersonateSelf. */
  /*  Undoes the effect of ImpersonateSelf. */
 
 
  RevertToSelf ();
  RevertToSelf ();
 
 
  /*  We want to test for write permissions. */
  /*  We want to test for write permissions. */
 
 
  dwAccessDesired = CheckAccessDesired;
  dwAccessDesired = CheckAccessDesired;
 
 
  MapGenericMask (&dwAccessDesired, &CheckGenericMapping);
  MapGenericMask (&dwAccessDesired, &CheckGenericMapping);
 
 
  if (!AccessCheck
  if (!AccessCheck
      (pSD ,                 /* security descriptor to check */
      (pSD ,                 /* security descriptor to check */
       hToken,               /* impersonation token */
       hToken,               /* impersonation token */
       dwAccessDesired,      /* requested access rights */
       dwAccessDesired,      /* requested access rights */
       &CheckGenericMapping, /* pointer to GENERIC_MAPPING */
       &CheckGenericMapping, /* pointer to GENERIC_MAPPING */
       &PrivilegeSet,        /* receives privileges used in check */
       &PrivilegeSet,        /* receives privileges used in check */
       &dwPrivSetSize,       /* size of PrivilegeSet buffer */
       &dwPrivSetSize,       /* size of PrivilegeSet buffer */
       &dwAccessAllowed,     /* receives mask of allowed access rights */
       &dwAccessAllowed,     /* receives mask of allowed access rights */
       &fAccessGranted))
       &fAccessGranted))
    goto error;
    goto error;
 
 
  CloseHandle (hToken);
  CloseHandle (hToken);
  HeapFree (GetProcessHeap (), 0, pSD);
  HeapFree (GetProcessHeap (), 0, pSD);
  return fAccessGranted;
  return fAccessGranted;
 
 
 error:
 error:
  if (hToken)
  if (hToken)
    CloseHandle (hToken);
    CloseHandle (hToken);
  HeapFree (GetProcessHeap (), 0, pSD);
  HeapFree (GetProcessHeap (), 0, pSD);
  return 0;
  return 0;
}
}
 
 
static void
static void
__gnat_set_OWNER_ACL
__gnat_set_OWNER_ACL
(TCHAR *wname,
(TCHAR *wname,
 DWORD AccessMode,
 DWORD AccessMode,
 DWORD AccessPermissions)
 DWORD AccessPermissions)
{
{
  PACL pOldDACL = NULL;
  PACL pOldDACL = NULL;
  PACL pNewDACL = NULL;
  PACL pNewDACL = NULL;
  PSECURITY_DESCRIPTOR pSD = NULL;
  PSECURITY_DESCRIPTOR pSD = NULL;
  EXPLICIT_ACCESS ea;
  EXPLICIT_ACCESS ea;
  TCHAR username [100];
  TCHAR username [100];
  DWORD unsize = 100;
  DWORD unsize = 100;
 
 
  /*  Get current user, he will act as the owner */
  /*  Get current user, he will act as the owner */
 
 
  if (!GetUserName (username, &unsize))
  if (!GetUserName (username, &unsize))
    return;
    return;
 
 
  if (GetNamedSecurityInfo
  if (GetNamedSecurityInfo
      (wname,
      (wname,
       SE_FILE_OBJECT,
       SE_FILE_OBJECT,
       DACL_SECURITY_INFORMATION,
       DACL_SECURITY_INFORMATION,
       NULL, NULL, &pOldDACL, NULL, &pSD) != ERROR_SUCCESS)
       NULL, NULL, &pOldDACL, NULL, &pSD) != ERROR_SUCCESS)
    return;
    return;
 
 
  BuildExplicitAccessWithName
  BuildExplicitAccessWithName
    (&ea, username, AccessPermissions, AccessMode, NO_INHERITANCE);
    (&ea, username, AccessPermissions, AccessMode, NO_INHERITANCE);
 
 
  if (AccessMode == SET_ACCESS)
  if (AccessMode == SET_ACCESS)
    {
    {
      /*  SET_ACCESS, we want to set an explicte set of permissions, do not
      /*  SET_ACCESS, we want to set an explicte set of permissions, do not
          merge with current DACL.  */
          merge with current DACL.  */
      if (SetEntriesInAcl (1, &ea, NULL, &pNewDACL) != ERROR_SUCCESS)
      if (SetEntriesInAcl (1, &ea, NULL, &pNewDACL) != ERROR_SUCCESS)
        return;
        return;
    }
    }
  else
  else
    if (SetEntriesInAcl (1, &ea, pOldDACL, &pNewDACL) != ERROR_SUCCESS)
    if (SetEntriesInAcl (1, &ea, pOldDACL, &pNewDACL) != ERROR_SUCCESS)
      return;
      return;
 
 
  if (SetNamedSecurityInfo
  if (SetNamedSecurityInfo
      (wname, SE_FILE_OBJECT,
      (wname, SE_FILE_OBJECT,
       DACL_SECURITY_INFORMATION, NULL, NULL, pNewDACL, NULL) != ERROR_SUCCESS)
       DACL_SECURITY_INFORMATION, NULL, NULL, pNewDACL, NULL) != ERROR_SUCCESS)
    return;
    return;
 
 
  LocalFree (pSD);
  LocalFree (pSD);
  LocalFree (pNewDACL);
  LocalFree (pNewDACL);
}
}
 
 
/* Check if it is possible to use ACL for wname, the file must not be on a
/* Check if it is possible to use ACL for wname, the file must not be on a
   network drive. */
   network drive. */
 
 
static int
static int
__gnat_can_use_acl (TCHAR *wname)
__gnat_can_use_acl (TCHAR *wname)
{
{
  return __gnat_use_acl && GetDriveTypeFromPath (wname) != DRIVE_REMOTE;
  return __gnat_use_acl && GetDriveTypeFromPath (wname) != DRIVE_REMOTE;
}
}
 
 
#endif /* defined (_WIN32) && !defined (RTX) */
#endif /* defined (_WIN32) && !defined (RTX) */
 
 
int
int
__gnat_is_readable_file_attr (char* name, struct file_attributes* attr)
__gnat_is_readable_file_attr (char* name, struct file_attributes* attr)
{
{
   if (attr->readable == ATTR_UNSET) {
   if (attr->readable == ATTR_UNSET) {
#if defined (_WIN32) && !defined (RTX)
#if defined (_WIN32) && !defined (RTX)
     TCHAR wname [GNAT_MAX_PATH_LEN + 2];
     TCHAR wname [GNAT_MAX_PATH_LEN + 2];
     GENERIC_MAPPING GenericMapping;
     GENERIC_MAPPING GenericMapping;
 
 
     S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
     S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
 
     if (__gnat_can_use_acl (wname))
     if (__gnat_can_use_acl (wname))
     {
     {
        ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
        ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
        GenericMapping.GenericRead = GENERIC_READ;
        GenericMapping.GenericRead = GENERIC_READ;
        attr->readable = __gnat_check_OWNER_ACL (wname, FILE_READ_DATA, GenericMapping);
        attr->readable = __gnat_check_OWNER_ACL (wname, FILE_READ_DATA, GenericMapping);
     }
     }
     else
     else
        attr->readable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
        attr->readable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
#else
#else
     __gnat_stat_to_attr (-1, name, attr);
     __gnat_stat_to_attr (-1, name, attr);
#endif
#endif
   }
   }
 
 
   return attr->readable;
   return attr->readable;
}
}
 
 
int
int
__gnat_is_readable_file (char *name)
__gnat_is_readable_file (char *name)
{
{
   struct file_attributes attr;
   struct file_attributes attr;
   __gnat_reset_attributes (&attr);
   __gnat_reset_attributes (&attr);
   return __gnat_is_readable_file_attr (name, &attr);
   return __gnat_is_readable_file_attr (name, &attr);
}
}
 
 
int
int
__gnat_is_writable_file_attr (char* name, struct file_attributes* attr)
__gnat_is_writable_file_attr (char* name, struct file_attributes* attr)
{
{
   if (attr->writable == ATTR_UNSET) {
   if (attr->writable == ATTR_UNSET) {
#if defined (_WIN32) && !defined (RTX)
#if defined (_WIN32) && !defined (RTX)
     TCHAR wname [GNAT_MAX_PATH_LEN + 2];
     TCHAR wname [GNAT_MAX_PATH_LEN + 2];
     GENERIC_MAPPING GenericMapping;
     GENERIC_MAPPING GenericMapping;
 
 
     S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
     S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
 
     if (__gnat_can_use_acl (wname))
     if (__gnat_can_use_acl (wname))
       {
       {
         ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
         ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
         GenericMapping.GenericWrite = GENERIC_WRITE;
         GenericMapping.GenericWrite = GENERIC_WRITE;
 
 
         attr->writable = __gnat_check_OWNER_ACL
         attr->writable = __gnat_check_OWNER_ACL
             (wname, FILE_WRITE_DATA | FILE_APPEND_DATA, GenericMapping)
             (wname, FILE_WRITE_DATA | FILE_APPEND_DATA, GenericMapping)
             && !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
             && !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
       }
       }
     else
     else
       attr->writable = !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
       attr->writable = !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
 
 
#else
#else
     __gnat_stat_to_attr (-1, name, attr);
     __gnat_stat_to_attr (-1, name, attr);
#endif
#endif
   }
   }
 
 
   return attr->writable;
   return attr->writable;
}
}
 
 
int
int
__gnat_is_writable_file (char *name)
__gnat_is_writable_file (char *name)
{
{
   struct file_attributes attr;
   struct file_attributes attr;
   __gnat_reset_attributes (&attr);
   __gnat_reset_attributes (&attr);
   return __gnat_is_writable_file_attr (name, &attr);
   return __gnat_is_writable_file_attr (name, &attr);
}
}
 
 
int
int
__gnat_is_executable_file_attr (char* name, struct file_attributes* attr)
__gnat_is_executable_file_attr (char* name, struct file_attributes* attr)
{
{
   if (attr->executable == ATTR_UNSET) {
   if (attr->executable == ATTR_UNSET) {
#if defined (_WIN32) && !defined (RTX)
#if defined (_WIN32) && !defined (RTX)
     TCHAR wname [GNAT_MAX_PATH_LEN + 2];
     TCHAR wname [GNAT_MAX_PATH_LEN + 2];
     GENERIC_MAPPING GenericMapping;
     GENERIC_MAPPING GenericMapping;
 
 
     S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
     S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
 
     if (__gnat_can_use_acl (wname))
     if (__gnat_can_use_acl (wname))
       {
       {
         ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
         ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
         GenericMapping.GenericExecute = GENERIC_EXECUTE;
         GenericMapping.GenericExecute = GENERIC_EXECUTE;
 
 
         attr->executable = __gnat_check_OWNER_ACL (wname, FILE_EXECUTE, GenericMapping);
         attr->executable = __gnat_check_OWNER_ACL (wname, FILE_EXECUTE, GenericMapping);
       }
       }
     else
     else
       attr->executable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES
       attr->executable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES
         && _tcsstr (wname, _T(".exe")) - wname == (int) (_tcslen (wname) - 4);
         && _tcsstr (wname, _T(".exe")) - wname == (int) (_tcslen (wname) - 4);
#else
#else
     __gnat_stat_to_attr (-1, name, attr);
     __gnat_stat_to_attr (-1, name, attr);
#endif
#endif
   }
   }
 
 
   return attr->executable;
   return attr->executable;
}
}
 
 
int
int
__gnat_is_executable_file (char *name)
__gnat_is_executable_file (char *name)
{
{
   struct file_attributes attr;
   struct file_attributes attr;
   __gnat_reset_attributes (&attr);
   __gnat_reset_attributes (&attr);
   return __gnat_is_executable_file_attr (name, &attr);
   return __gnat_is_executable_file_attr (name, &attr);
}
}
 
 
void
void
__gnat_set_writable (char *name)
__gnat_set_writable (char *name)
{
{
#if defined (_WIN32) && !defined (RTX)
#if defined (_WIN32) && !defined (RTX)
  TCHAR wname [GNAT_MAX_PATH_LEN + 2];
  TCHAR wname [GNAT_MAX_PATH_LEN + 2];
 
 
  S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
  S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
 
  if (__gnat_can_use_acl (wname))
  if (__gnat_can_use_acl (wname))
    __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_WRITE);
    __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_WRITE);
 
 
  SetFileAttributes
  SetFileAttributes
    (wname, GetFileAttributes (wname) & ~FILE_ATTRIBUTE_READONLY);
    (wname, GetFileAttributes (wname) & ~FILE_ATTRIBUTE_READONLY);
#elif ! defined (__vxworks) && ! defined(__nucleus__)
#elif ! defined (__vxworks) && ! defined(__nucleus__)
  GNAT_STRUCT_STAT statbuf;
  GNAT_STRUCT_STAT statbuf;
 
 
  if (GNAT_STAT (name, &statbuf) == 0)
  if (GNAT_STAT (name, &statbuf) == 0)
    {
    {
      statbuf.st_mode = statbuf.st_mode | S_IWUSR;
      statbuf.st_mode = statbuf.st_mode | S_IWUSR;
      chmod (name, statbuf.st_mode);
      chmod (name, statbuf.st_mode);
    }
    }
#endif
#endif
}
}
 
 
void
void
__gnat_set_executable (char *name)
__gnat_set_executable (char *name)
{
{
#if defined (_WIN32) && !defined (RTX)
#if defined (_WIN32) && !defined (RTX)
  TCHAR wname [GNAT_MAX_PATH_LEN + 2];
  TCHAR wname [GNAT_MAX_PATH_LEN + 2];
 
 
  S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
  S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
 
  if (__gnat_can_use_acl (wname))
  if (__gnat_can_use_acl (wname))
    __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_EXECUTE);
    __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_EXECUTE);
 
 
#elif ! defined (__vxworks) && ! defined(__nucleus__)
#elif ! defined (__vxworks) && ! defined(__nucleus__)
  GNAT_STRUCT_STAT statbuf;
  GNAT_STRUCT_STAT statbuf;
 
 
  if (GNAT_STAT (name, &statbuf) == 0)
  if (GNAT_STAT (name, &statbuf) == 0)
    {
    {
      statbuf.st_mode = statbuf.st_mode | S_IXUSR;
      statbuf.st_mode = statbuf.st_mode | S_IXUSR;
      chmod (name, statbuf.st_mode);
      chmod (name, statbuf.st_mode);
    }
    }
#endif
#endif
}
}
 
 
void
void
__gnat_set_non_writable (char *name)
__gnat_set_non_writable (char *name)
{
{
#if defined (_WIN32) && !defined (RTX)
#if defined (_WIN32) && !defined (RTX)
  TCHAR wname [GNAT_MAX_PATH_LEN + 2];
  TCHAR wname [GNAT_MAX_PATH_LEN + 2];
 
 
  S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
  S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
 
  if (__gnat_can_use_acl (wname))
  if (__gnat_can_use_acl (wname))
    __gnat_set_OWNER_ACL
    __gnat_set_OWNER_ACL
      (wname, DENY_ACCESS,
      (wname, DENY_ACCESS,
       FILE_WRITE_DATA | FILE_APPEND_DATA |
       FILE_WRITE_DATA | FILE_APPEND_DATA |
       FILE_WRITE_EA | FILE_WRITE_ATTRIBUTES);
       FILE_WRITE_EA | FILE_WRITE_ATTRIBUTES);
 
 
  SetFileAttributes
  SetFileAttributes
    (wname, GetFileAttributes (wname) | FILE_ATTRIBUTE_READONLY);
    (wname, GetFileAttributes (wname) | FILE_ATTRIBUTE_READONLY);
#elif ! defined (__vxworks) && ! defined(__nucleus__)
#elif ! defined (__vxworks) && ! defined(__nucleus__)
  GNAT_STRUCT_STAT statbuf;
  GNAT_STRUCT_STAT statbuf;
 
 
  if (GNAT_STAT (name, &statbuf) == 0)
  if (GNAT_STAT (name, &statbuf) == 0)
    {
    {
      statbuf.st_mode = statbuf.st_mode & 07577;
      statbuf.st_mode = statbuf.st_mode & 07577;
      chmod (name, statbuf.st_mode);
      chmod (name, statbuf.st_mode);
    }
    }
#endif
#endif
}
}
 
 
void
void
__gnat_set_readable (char *name)
__gnat_set_readable (char *name)
{
{
#if defined (_WIN32) && !defined (RTX)
#if defined (_WIN32) && !defined (RTX)
  TCHAR wname [GNAT_MAX_PATH_LEN + 2];
  TCHAR wname [GNAT_MAX_PATH_LEN + 2];
 
 
  S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
  S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
 
  if (__gnat_can_use_acl (wname))
  if (__gnat_can_use_acl (wname))
    __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_READ);
    __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_READ);
 
 
#elif ! defined (__vxworks) && ! defined(__nucleus__)
#elif ! defined (__vxworks) && ! defined(__nucleus__)
  GNAT_STRUCT_STAT statbuf;
  GNAT_STRUCT_STAT statbuf;
 
 
  if (GNAT_STAT (name, &statbuf) == 0)
  if (GNAT_STAT (name, &statbuf) == 0)
    {
    {
      chmod (name, statbuf.st_mode | S_IREAD);
      chmod (name, statbuf.st_mode | S_IREAD);
    }
    }
#endif
#endif
}
}
 
 
void
void
__gnat_set_non_readable (char *name)
__gnat_set_non_readable (char *name)
{
{
#if defined (_WIN32) && !defined (RTX)
#if defined (_WIN32) && !defined (RTX)
  TCHAR wname [GNAT_MAX_PATH_LEN + 2];
  TCHAR wname [GNAT_MAX_PATH_LEN + 2];
 
 
  S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
  S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
 
  if (__gnat_can_use_acl (wname))
  if (__gnat_can_use_acl (wname))
    __gnat_set_OWNER_ACL (wname, DENY_ACCESS, FILE_GENERIC_READ);
    __gnat_set_OWNER_ACL (wname, DENY_ACCESS, FILE_GENERIC_READ);
 
 
#elif ! defined (__vxworks) && ! defined(__nucleus__)
#elif ! defined (__vxworks) && ! defined(__nucleus__)
  GNAT_STRUCT_STAT statbuf;
  GNAT_STRUCT_STAT statbuf;
 
 
  if (GNAT_STAT (name, &statbuf) == 0)
  if (GNAT_STAT (name, &statbuf) == 0)
    {
    {
      chmod (name, statbuf.st_mode & (~S_IREAD));
      chmod (name, statbuf.st_mode & (~S_IREAD));
    }
    }
#endif
#endif
}
}
 
 
int
int
__gnat_is_symbolic_link_attr (char* name, struct file_attributes* attr)
__gnat_is_symbolic_link_attr (char* name, struct file_attributes* attr)
{
{
   if (attr->symbolic_link == ATTR_UNSET) {
   if (attr->symbolic_link == ATTR_UNSET) {
#if defined (__vxworks) || defined (__nucleus__)
#if defined (__vxworks) || defined (__nucleus__)
      attr->symbolic_link = 0;
      attr->symbolic_link = 0;
 
 
#elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
#elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
      int ret;
      int ret;
      GNAT_STRUCT_STAT statbuf;
      GNAT_STRUCT_STAT statbuf;
      ret = GNAT_LSTAT (name, &statbuf);
      ret = GNAT_LSTAT (name, &statbuf);
      attr->symbolic_link = (!ret && S_ISLNK (statbuf.st_mode));
      attr->symbolic_link = (!ret && S_ISLNK (statbuf.st_mode));
#else
#else
      attr->symbolic_link = 0;
      attr->symbolic_link = 0;
#endif
#endif
   }
   }
   return attr->symbolic_link;
   return attr->symbolic_link;
}
}
 
 
int
int
__gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED)
__gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED)
{
{
   struct file_attributes attr;
   struct file_attributes attr;
   __gnat_reset_attributes (&attr);
   __gnat_reset_attributes (&attr);
   return __gnat_is_symbolic_link_attr (name, &attr);
   return __gnat_is_symbolic_link_attr (name, &attr);
 
 
}
}
 
 
#if defined (sun) && defined (__SVR4)
#if defined (sun) && defined (__SVR4)
/* Using fork on Solaris will duplicate all the threads. fork1, which
/* Using fork on Solaris will duplicate all the threads. fork1, which
   duplicates only the active thread, must be used instead, or spawning
   duplicates only the active thread, must be used instead, or spawning
   subprocess from a program with tasking will lead into numerous problems.  */
   subprocess from a program with tasking will lead into numerous problems.  */
#define fork fork1
#define fork fork1
#endif
#endif
 
 
int
int
__gnat_portable_spawn (char *args[])
__gnat_portable_spawn (char *args[])
{
{
  int status = 0;
  int status = 0;
  int finished ATTRIBUTE_UNUSED;
  int finished ATTRIBUTE_UNUSED;
  int pid ATTRIBUTE_UNUSED;
  int pid ATTRIBUTE_UNUSED;
 
 
#if defined (__vxworks) || defined(__nucleus__) || defined(RTX)
#if defined (__vxworks) || defined(__nucleus__) || defined(RTX)
  return -1;
  return -1;
 
 
#elif defined (MSDOS) || defined (_WIN32)
#elif defined (MSDOS) || defined (_WIN32)
  /* args[0] must be quotes as it could contain a full pathname with spaces */
  /* args[0] must be quotes as it could contain a full pathname with spaces */
  char *args_0 = args[0];
  char *args_0 = args[0];
  args[0] = (char *)xmalloc (strlen (args_0) + 3);
  args[0] = (char *)xmalloc (strlen (args_0) + 3);
  strcpy (args[0], "\"");
  strcpy (args[0], "\"");
  strcat (args[0], args_0);
  strcat (args[0], args_0);
  strcat (args[0], "\"");
  strcat (args[0], "\"");
 
 
  status = spawnvp (P_WAIT, args_0, (const char* const*)args);
  status = spawnvp (P_WAIT, args_0, (const char* const*)args);
 
 
  /* restore previous value */
  /* restore previous value */
  free (args[0]);
  free (args[0]);
  args[0] = (char *)args_0;
  args[0] = (char *)args_0;
 
 
  if (status < 0)
  if (status < 0)
    return -1;
    return -1;
  else
  else
    return status;
    return status;
 
 
#else
#else
 
 
#ifdef __EMX__
#ifdef __EMX__
  pid = spawnvp (P_NOWAIT, args[0], args);
  pid = spawnvp (P_NOWAIT, args[0], args);
  if (pid == -1)
  if (pid == -1)
    return -1;
    return -1;
 
 
#else
#else
  pid = fork ();
  pid = fork ();
  if (pid < 0)
  if (pid < 0)
    return -1;
    return -1;
 
 
  if (pid == 0)
  if (pid == 0)
    {
    {
      /* The child. */
      /* The child. */
      if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
      if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
#if defined (VMS)
#if defined (VMS)
        return -1; /* execv is in parent context on VMS.  */
        return -1; /* execv is in parent context on VMS.  */
#else
#else
        _exit (1);
        _exit (1);
#endif
#endif
    }
    }
#endif
#endif
 
 
  /* The parent.  */
  /* The parent.  */
  finished = waitpid (pid, &status, 0);
  finished = waitpid (pid, &status, 0);
 
 
  if (finished != pid || WIFEXITED (status) == 0)
  if (finished != pid || WIFEXITED (status) == 0)
    return -1;
    return -1;
 
 
  return WEXITSTATUS (status);
  return WEXITSTATUS (status);
#endif
#endif
 
 
  return 0;
  return 0;
}
}
 
 
/* Create a copy of the given file descriptor.
/* Create a copy of the given file descriptor.
   Return -1 if an error occurred.  */
   Return -1 if an error occurred.  */
 
 
int
int
__gnat_dup (int oldfd)
__gnat_dup (int oldfd)
{
{
#if defined (__vxworks) && !defined (__RTP__)
#if defined (__vxworks) && !defined (__RTP__)
  /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
  /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
     RTPs. */
     RTPs. */
  return -1;
  return -1;
#else
#else
  return dup (oldfd);
  return dup (oldfd);
#endif
#endif
}
}
 
 
/* Make newfd be the copy of oldfd, closing newfd first if necessary.
/* Make newfd be the copy of oldfd, closing newfd first if necessary.
   Return -1 if an error occurred.  */
   Return -1 if an error occurred.  */
 
 
int
int
__gnat_dup2 (int oldfd, int newfd)
__gnat_dup2 (int oldfd, int newfd)
{
{
#if defined (__vxworks) && !defined (__RTP__)
#if defined (__vxworks) && !defined (__RTP__)
  /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
  /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
     RTPs.  */
     RTPs.  */
  return -1;
  return -1;
#else
#else
  return dup2 (oldfd, newfd);
  return dup2 (oldfd, newfd);
#endif
#endif
}
}
 
 
/* WIN32 code to implement a wait call that wait for any child process.  */
/* WIN32 code to implement a wait call that wait for any child process.  */
 
 
#if defined (_WIN32) && !defined (RTX)
#if defined (_WIN32) && !defined (RTX)
 
 
/* Synchronization code, to be thread safe.  */
/* Synchronization code, to be thread safe.  */
 
 
#ifdef CERT
#ifdef CERT
 
 
/* For the Cert run times on native Windows we use dummy functions
/* For the Cert run times on native Windows we use dummy functions
   for locking and unlocking tasks since we do not support multiple
   for locking and unlocking tasks since we do not support multiple
   threads on this configuration (Cert run time on native Windows). */
   threads on this configuration (Cert run time on native Windows). */
 
 
void dummy (void) {}
void dummy (void) {}
 
 
void (*Lock_Task) ()   = &dummy;
void (*Lock_Task) ()   = &dummy;
void (*Unlock_Task) () = &dummy;
void (*Unlock_Task) () = &dummy;
 
 
#else
#else
 
 
#define Lock_Task system__soft_links__lock_task
#define Lock_Task system__soft_links__lock_task
extern void (*Lock_Task) (void);
extern void (*Lock_Task) (void);
 
 
#define Unlock_Task system__soft_links__unlock_task
#define Unlock_Task system__soft_links__unlock_task
extern void (*Unlock_Task) (void);
extern void (*Unlock_Task) (void);
 
 
#endif
#endif
 
 
static HANDLE *HANDLES_LIST = NULL;
static HANDLE *HANDLES_LIST = NULL;
static int *PID_LIST = NULL, plist_length = 0, plist_max_length = 0;
static int *PID_LIST = NULL, plist_length = 0, plist_max_length = 0;
 
 
static void
static void
add_handle (HANDLE h)
add_handle (HANDLE h)
{
{
 
 
  /* -------------------- critical section -------------------- */
  /* -------------------- critical section -------------------- */
  (*Lock_Task) ();
  (*Lock_Task) ();
 
 
  if (plist_length == plist_max_length)
  if (plist_length == plist_max_length)
    {
    {
      plist_max_length += 1000;
      plist_max_length += 1000;
      HANDLES_LIST =
      HANDLES_LIST =
        xrealloc (HANDLES_LIST, sizeof (HANDLE) * plist_max_length);
        xrealloc (HANDLES_LIST, sizeof (HANDLE) * plist_max_length);
      PID_LIST =
      PID_LIST =
        xrealloc (PID_LIST, sizeof (int) * plist_max_length);
        xrealloc (PID_LIST, sizeof (int) * plist_max_length);
    }
    }
 
 
  HANDLES_LIST[plist_length] = h;
  HANDLES_LIST[plist_length] = h;
  PID_LIST[plist_length] = GetProcessId (h);
  PID_LIST[plist_length] = GetProcessId (h);
  ++plist_length;
  ++plist_length;
 
 
  (*Unlock_Task) ();
  (*Unlock_Task) ();
  /* -------------------- critical section -------------------- */
  /* -------------------- critical section -------------------- */
}
}
 
 
void
void
__gnat_win32_remove_handle (HANDLE h, int pid)
__gnat_win32_remove_handle (HANDLE h, int pid)
{
{
  int j;
  int j;
 
 
  /* -------------------- critical section -------------------- */
  /* -------------------- critical section -------------------- */
  (*Lock_Task) ();
  (*Lock_Task) ();
 
 
  for (j = 0; j < plist_length; j++)
  for (j = 0; j < plist_length; j++)
    {
    {
      if ((HANDLES_LIST[j] == h) || (PID_LIST[j] == pid))
      if ((HANDLES_LIST[j] == h) || (PID_LIST[j] == pid))
        {
        {
          CloseHandle (h);
          CloseHandle (h);
          --plist_length;
          --plist_length;
          HANDLES_LIST[j] = HANDLES_LIST[plist_length];
          HANDLES_LIST[j] = HANDLES_LIST[plist_length];
          PID_LIST[j] = PID_LIST[plist_length];
          PID_LIST[j] = PID_LIST[plist_length];
          break;
          break;
        }
        }
    }
    }
 
 
  (*Unlock_Task) ();
  (*Unlock_Task) ();
  /* -------------------- critical section -------------------- */
  /* -------------------- critical section -------------------- */
}
}
 
 
static HANDLE
static HANDLE
win32_no_block_spawn (char *command, char *args[])
win32_no_block_spawn (char *command, char *args[])
{
{
  BOOL result;
  BOOL result;
  STARTUPINFO SI;
  STARTUPINFO SI;
  PROCESS_INFORMATION PI;
  PROCESS_INFORMATION PI;
  SECURITY_ATTRIBUTES SA;
  SECURITY_ATTRIBUTES SA;
  int csize = 1;
  int csize = 1;
  char *full_command;
  char *full_command;
  int k;
  int k;
 
 
  /* compute the total command line length */
  /* compute the total command line length */
  k = 0;
  k = 0;
  while (args[k])
  while (args[k])
    {
    {
      csize += strlen (args[k]) + 1;
      csize += strlen (args[k]) + 1;
      k++;
      k++;
    }
    }
 
 
  full_command = (char *) xmalloc (csize);
  full_command = (char *) xmalloc (csize);
 
 
  /* Startup info. */
  /* Startup info. */
  SI.cb          = sizeof (STARTUPINFO);
  SI.cb          = sizeof (STARTUPINFO);
  SI.lpReserved  = NULL;
  SI.lpReserved  = NULL;
  SI.lpReserved2 = NULL;
  SI.lpReserved2 = NULL;
  SI.lpDesktop   = NULL;
  SI.lpDesktop   = NULL;
  SI.cbReserved2 = 0;
  SI.cbReserved2 = 0;
  SI.lpTitle     = NULL;
  SI.lpTitle     = NULL;
  SI.dwFlags     = 0;
  SI.dwFlags     = 0;
  SI.wShowWindow = SW_HIDE;
  SI.wShowWindow = SW_HIDE;
 
 
  /* Security attributes. */
  /* Security attributes. */
  SA.nLength = sizeof (SECURITY_ATTRIBUTES);
  SA.nLength = sizeof (SECURITY_ATTRIBUTES);
  SA.bInheritHandle = TRUE;
  SA.bInheritHandle = TRUE;
  SA.lpSecurityDescriptor = NULL;
  SA.lpSecurityDescriptor = NULL;
 
 
  /* Prepare the command string. */
  /* Prepare the command string. */
  strcpy (full_command, command);
  strcpy (full_command, command);
  strcat (full_command, " ");
  strcat (full_command, " ");
 
 
  k = 1;
  k = 1;
  while (args[k])
  while (args[k])
    {
    {
      strcat (full_command, args[k]);
      strcat (full_command, args[k]);
      strcat (full_command, " ");
      strcat (full_command, " ");
      k++;
      k++;
    }
    }
 
 
  {
  {
    int wsize = csize * 2;
    int wsize = csize * 2;
    TCHAR *wcommand = (TCHAR *) xmalloc (wsize);
    TCHAR *wcommand = (TCHAR *) xmalloc (wsize);
 
 
    S2WSC (wcommand, full_command, wsize);
    S2WSC (wcommand, full_command, wsize);
 
 
    free (full_command);
    free (full_command);
 
 
    result = CreateProcess
    result = CreateProcess
      (NULL, wcommand, &SA, NULL, TRUE,
      (NULL, wcommand, &SA, NULL, TRUE,
       GetPriorityClass (GetCurrentProcess()), NULL, NULL, &SI, &PI);
       GetPriorityClass (GetCurrentProcess()), NULL, NULL, &SI, &PI);
 
 
    free (wcommand);
    free (wcommand);
  }
  }
 
 
  if (result == TRUE)
  if (result == TRUE)
    {
    {
      CloseHandle (PI.hThread);
      CloseHandle (PI.hThread);
      return PI.hProcess;
      return PI.hProcess;
    }
    }
  else
  else
    return NULL;
    return NULL;
}
}
 
 
static int
static int
win32_wait (int *status)
win32_wait (int *status)
{
{
  DWORD exitcode, pid;
  DWORD exitcode, pid;
  HANDLE *hl;
  HANDLE *hl;
  HANDLE h;
  HANDLE h;
  DWORD res;
  DWORD res;
  int k;
  int k;
  int hl_len;
  int hl_len;
 
 
  if (plist_length == 0)
  if (plist_length == 0)
    {
    {
      errno = ECHILD;
      errno = ECHILD;
      return -1;
      return -1;
    }
    }
 
 
  k = 0;
  k = 0;
 
 
  /* -------------------- critical section -------------------- */
  /* -------------------- critical section -------------------- */
  (*Lock_Task) ();
  (*Lock_Task) ();
 
 
  hl_len = plist_length;
  hl_len = plist_length;
 
 
  hl = (HANDLE *) xmalloc (sizeof (HANDLE) * hl_len);
  hl = (HANDLE *) xmalloc (sizeof (HANDLE) * hl_len);
 
 
  memmove (hl, HANDLES_LIST, sizeof (HANDLE) * hl_len);
  memmove (hl, HANDLES_LIST, sizeof (HANDLE) * hl_len);
 
 
  (*Unlock_Task) ();
  (*Unlock_Task) ();
  /* -------------------- critical section -------------------- */
  /* -------------------- critical section -------------------- */
 
 
  res = WaitForMultipleObjects (hl_len, hl, FALSE, INFINITE);
  res = WaitForMultipleObjects (hl_len, hl, FALSE, INFINITE);
  h = hl[res - WAIT_OBJECT_0];
  h = hl[res - WAIT_OBJECT_0];
 
 
  GetExitCodeProcess (h, &exitcode);
  GetExitCodeProcess (h, &exitcode);
  pid = GetProcessId (h);
  pid = GetProcessId (h);
  __gnat_win32_remove_handle (h, -1);
  __gnat_win32_remove_handle (h, -1);
 
 
  free (hl);
  free (hl);
 
 
  *status = (int) exitcode;
  *status = (int) exitcode;
  return (int) pid;
  return (int) pid;
}
}
 
 
#endif
#endif
 
 
int
int
__gnat_portable_no_block_spawn (char *args[])
__gnat_portable_no_block_spawn (char *args[])
{
{
 
 
#if defined (__vxworks) || defined (__nucleus__) || defined (RTX)
#if defined (__vxworks) || defined (__nucleus__) || defined (RTX)
  return -1;
  return -1;
 
 
#elif defined (__EMX__) || defined (MSDOS)
#elif defined (__EMX__) || defined (MSDOS)
 
 
  /* ??? For PC machines I (Franco) don't know the system calls to implement
  /* ??? 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
     this routine. So I'll fake it as follows. This routine will behave
     exactly like the blocking portable_spawn and will systematically return
     exactly like the blocking portable_spawn and will systematically return
     a pid of 0 unless the spawned task did not complete successfully, in
     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
     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
     portable_wait below systematically returns a pid of 0 and reports that
     the subprocess terminated successfully. */
     the subprocess terminated successfully. */
 
 
  if (spawnvp (P_WAIT, args[0], args) != 0)
  if (spawnvp (P_WAIT, args[0], args) != 0)
    return -1;
    return -1;
 
 
#elif defined (_WIN32)
#elif defined (_WIN32)
 
 
  HANDLE h = NULL;
  HANDLE h = NULL;
 
 
  h = win32_no_block_spawn (args[0], args);
  h = win32_no_block_spawn (args[0], args);
  if (h != NULL)
  if (h != NULL)
    {
    {
      add_handle (h);
      add_handle (h);
      return GetProcessId (h);
      return GetProcessId (h);
    }
    }
  else
  else
    return -1;
    return -1;
 
 
#else
#else
 
 
  int pid = fork ();
  int pid = fork ();
 
 
  if (pid == 0)
  if (pid == 0)
    {
    {
      /* The child.  */
      /* The child.  */
      if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
      if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
#if defined (VMS)
#if defined (VMS)
        return -1; /* execv is in parent context on VMS. */
        return -1; /* execv is in parent context on VMS. */
#else
#else
        _exit (1);
        _exit (1);
#endif
#endif
    }
    }
 
 
  return pid;
  return pid;
 
 
  #endif
  #endif
}
}
 
 
int
int
__gnat_portable_wait (int *process_status)
__gnat_portable_wait (int *process_status)
{
{
  int status = 0;
  int status = 0;
  int pid = 0;
  int pid = 0;
 
 
#if defined (__vxworks) || defined (__nucleus__) || defined (RTX)
#if defined (__vxworks) || defined (__nucleus__) || defined (RTX)
  /* Not sure what to do here, so do same as __EMX__ case, i.e., nothing but
  /* Not sure what to do here, so do same as __EMX__ case, i.e., nothing but
     return zero.  */
     return zero.  */
 
 
#elif defined (_WIN32)
#elif defined (_WIN32)
 
 
  pid = win32_wait (&status);
  pid = win32_wait (&status);
 
 
#elif defined (__EMX__) || defined (MSDOS)
#elif defined (__EMX__) || defined (MSDOS)
  /* ??? See corresponding comment in portable_no_block_spawn.  */
  /* ??? See corresponding comment in portable_no_block_spawn.  */
 
 
#else
#else
 
 
  pid = waitpid (-1, &status, 0);
  pid = waitpid (-1, &status, 0);
  status = status & 0xffff;
  status = status & 0xffff;
#endif
#endif
 
 
  *process_status = status;
  *process_status = status;
  return pid;
  return pid;
}
}
 
 
void
void
__gnat_os_exit (int status)
__gnat_os_exit (int status)
{
{
  exit (status);
  exit (status);
}
}
 
 
/* Locate a regular file, give a Path value.  */
/* Locate a regular file, give a Path value.  */
 
 
char *
char *
__gnat_locate_regular_file (char *file_name, char *path_val)
__gnat_locate_regular_file (char *file_name, char *path_val)
{
{
  char *ptr;
  char *ptr;
  char *file_path = (char *) alloca (strlen (file_name) + 1);
  char *file_path = (char *) alloca (strlen (file_name) + 1);
  int absolute;
  int absolute;
 
 
  /* Return immediately if file_name is empty */
  /* Return immediately if file_name is empty */
 
 
  if (*file_name == '\0')
  if (*file_name == '\0')
    return 0;
    return 0;
 
 
  /* Remove quotes around file_name if present */
  /* Remove quotes around file_name if present */
 
 
  ptr = file_name;
  ptr = file_name;
  if (*ptr == '"')
  if (*ptr == '"')
    ptr++;
    ptr++;
 
 
  strcpy (file_path, ptr);
  strcpy (file_path, ptr);
 
 
  ptr = file_path + strlen (file_path) - 1;
  ptr = file_path + strlen (file_path) - 1;
 
 
  if (*ptr == '"')
  if (*ptr == '"')
    *ptr = '\0';
    *ptr = '\0';
 
 
  /* Handle absolute pathnames.  */
  /* Handle absolute pathnames.  */
 
 
  absolute = __gnat_is_absolute_path (file_path, strlen (file_name));
  absolute = __gnat_is_absolute_path (file_path, strlen (file_name));
 
 
  if (absolute)
  if (absolute)
    {
    {
     if (__gnat_is_regular_file (file_path))
     if (__gnat_is_regular_file (file_path))
       return xstrdup (file_path);
       return xstrdup (file_path);
 
 
      return 0;
      return 0;
    }
    }
 
 
  /* If file_name include directory separator(s), try it first as
  /* If file_name include directory separator(s), try it first as
     a path name relative to the current directory */
     a path name relative to the current directory */
  for (ptr = file_name; *ptr && *ptr != '/' && *ptr != DIR_SEPARATOR; ptr++)
  for (ptr = file_name; *ptr && *ptr != '/' && *ptr != DIR_SEPARATOR; ptr++)
    ;
    ;
 
 
  if (*ptr != 0)
  if (*ptr != 0)
    {
    {
      if (__gnat_is_regular_file (file_name))
      if (__gnat_is_regular_file (file_name))
        return xstrdup (file_name);
        return xstrdup (file_name);
    }
    }
 
 
  if (path_val == 0)
  if (path_val == 0)
    return 0;
    return 0;
 
 
  {
  {
    /* The result has to be smaller than path_val + file_name.  */
    /* 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 (;;)
      {
      {
        for (; *path_val == PATH_SEPARATOR; path_val++)
        for (; *path_val == PATH_SEPARATOR; path_val++)
          ;
          ;
 
 
      if (*path_val == 0)
      if (*path_val == 0)
        return 0;
        return 0;
 
 
      /* Skip the starting quote */
      /* Skip the starting quote */
 
 
      if (*path_val == '"')
      if (*path_val == '"')
        path_val++;
        path_val++;
 
 
      for (ptr = file_path; *path_val && *path_val != PATH_SEPARATOR; )
      for (ptr = file_path; *path_val && *path_val != PATH_SEPARATOR; )
        *ptr++ = *path_val++;
        *ptr++ = *path_val++;
 
 
      ptr--;
      ptr--;
 
 
      /* Skip the ending quote */
      /* Skip the ending quote */
 
 
      if (*ptr == '"')
      if (*ptr == '"')
        ptr--;
        ptr--;
 
 
      if (*ptr != '/' && *ptr != DIR_SEPARATOR)
      if (*ptr != '/' && *ptr != DIR_SEPARATOR)
        *++ptr = DIR_SEPARATOR;
        *++ptr = DIR_SEPARATOR;
 
 
      strcpy (++ptr, file_name);
      strcpy (++ptr, file_name);
 
 
      if (__gnat_is_regular_file (file_path))
      if (__gnat_is_regular_file (file_path))
        return xstrdup (file_path);
        return xstrdup (file_path);
      }
      }
  }
  }
 
 
  return 0;
  return 0;
}
}
 
 
/* Locate an executable given a Path argument. This routine is only used by
/* Locate an executable given a Path argument. This routine is only used by
   gnatbl and should not be used otherwise.  Use locate_exec_on_path
   gnatbl and should not be used otherwise.  Use locate_exec_on_path
   instead.  */
   instead.  */
 
 
char *
char *
__gnat_locate_exec (char *exec_name, char *path_val)
__gnat_locate_exec (char *exec_name, char *path_val)
{
{
  char *ptr;
  char *ptr;
  if (!strstr (exec_name, HOST_EXECUTABLE_SUFFIX))
  if (!strstr (exec_name, HOST_EXECUTABLE_SUFFIX))
    {
    {
      char *full_exec_name
      char *full_exec_name
        = (char *) alloca (strlen (exec_name) + strlen (HOST_EXECUTABLE_SUFFIX) + 1);
        = (char *) alloca (strlen (exec_name) + strlen (HOST_EXECUTABLE_SUFFIX) + 1);
 
 
      strcpy (full_exec_name, exec_name);
      strcpy (full_exec_name, exec_name);
      strcat (full_exec_name, HOST_EXECUTABLE_SUFFIX);
      strcat (full_exec_name, HOST_EXECUTABLE_SUFFIX);
      ptr = __gnat_locate_regular_file (full_exec_name, path_val);
      ptr = __gnat_locate_regular_file (full_exec_name, path_val);
 
 
      if (ptr == 0)
      if (ptr == 0)
         return __gnat_locate_regular_file (exec_name, path_val);
         return __gnat_locate_regular_file (exec_name, path_val);
      return ptr;
      return ptr;
    }
    }
  else
  else
    return __gnat_locate_regular_file (exec_name, path_val);
    return __gnat_locate_regular_file (exec_name, path_val);
}
}
 
 
/* Locate an executable using the Systems default PATH.  */
/* Locate an executable using the Systems default PATH.  */
 
 
char *
char *
__gnat_locate_exec_on_path (char *exec_name)
__gnat_locate_exec_on_path (char *exec_name)
{
{
  char *apath_val;
  char *apath_val;
 
 
#if defined (_WIN32) && !defined (RTX)
#if defined (_WIN32) && !defined (RTX)
  TCHAR *wpath_val = _tgetenv (_T("PATH"));
  TCHAR *wpath_val = _tgetenv (_T("PATH"));
  TCHAR *wapath_val;
  TCHAR *wapath_val;
  /* In Win32 systems we expand the PATH as for XP environment
  /* In Win32 systems we expand the PATH as for XP environment
     variables are not automatically expanded. We also prepend the
     variables are not automatically expanded. We also prepend the
     ".;" to the path to match normal NT path search semantics */
     ".;" to the path to match normal NT path search semantics */
 
 
  #define EXPAND_BUFFER_SIZE 32767
  #define EXPAND_BUFFER_SIZE 32767
 
 
  wapath_val = alloca (EXPAND_BUFFER_SIZE);
  wapath_val = alloca (EXPAND_BUFFER_SIZE);
 
 
  wapath_val [0] = '.';
  wapath_val [0] = '.';
  wapath_val [1] = ';';
  wapath_val [1] = ';';
 
 
  DWORD res = ExpandEnvironmentStrings
  DWORD res = ExpandEnvironmentStrings
    (wpath_val, &wapath_val[2], EXPAND_BUFFER_SIZE - 2);
    (wpath_val, &wapath_val[2], EXPAND_BUFFER_SIZE - 2);
 
 
  if (!res) wapath_val [0] = _T('\0');
  if (!res) wapath_val [0] = _T('\0');
 
 
  apath_val = alloca (EXPAND_BUFFER_SIZE);
  apath_val = alloca (EXPAND_BUFFER_SIZE);
 
 
  WS2SC (apath_val, wapath_val, EXPAND_BUFFER_SIZE);
  WS2SC (apath_val, wapath_val, EXPAND_BUFFER_SIZE);
  return __gnat_locate_exec (exec_name, apath_val);
  return __gnat_locate_exec (exec_name, apath_val);
 
 
#else
#else
 
 
#ifdef VMS
#ifdef VMS
  char *path_val = "/VAXC$PATH";
  char *path_val = "/VAXC$PATH";
#else
#else
  char *path_val = getenv ("PATH");
  char *path_val = getenv ("PATH");
#endif
#endif
  if (path_val == NULL) return NULL;
  if (path_val == NULL) return NULL;
  apath_val = (char *) alloca (strlen (path_val) + 1);
  apath_val = (char *) alloca (strlen (path_val) + 1);
  strcpy (apath_val, path_val);
  strcpy (apath_val, path_val);
  return __gnat_locate_exec (exec_name, apath_val);
  return __gnat_locate_exec (exec_name, apath_val);
#endif
#endif
}
}
 
 
#ifdef VMS
#ifdef VMS
 
 
/* These functions are used to translate to and from VMS and Unix syntax
/* These functions are used to translate to and from VMS and Unix syntax
   file, directory and path specifications.  */
   file, directory and path specifications.  */
 
 
#define MAXPATH  256
#define MAXPATH  256
#define MAXNAMES 256
#define MAXNAMES 256
#define NEW_CANONICAL_FILELIST_INCREMENT 64
#define NEW_CANONICAL_FILELIST_INCREMENT 64
 
 
static char new_canonical_dirspec [MAXPATH];
static char new_canonical_dirspec [MAXPATH];
static char new_canonical_filespec [MAXPATH];
static char new_canonical_filespec [MAXPATH];
static char new_canonical_pathspec [MAXNAMES*MAXPATH];
static char new_canonical_pathspec [MAXNAMES*MAXPATH];
static unsigned new_canonical_filelist_index;
static unsigned new_canonical_filelist_index;
static unsigned new_canonical_filelist_in_use;
static unsigned new_canonical_filelist_in_use;
static unsigned new_canonical_filelist_allocated;
static unsigned new_canonical_filelist_allocated;
static char **new_canonical_filelist;
static char **new_canonical_filelist;
static char new_host_pathspec [MAXNAMES*MAXPATH];
static char new_host_pathspec [MAXNAMES*MAXPATH];
static char new_host_dirspec [MAXPATH];
static char new_host_dirspec [MAXPATH];
static char new_host_filespec [MAXPATH];
static char new_host_filespec [MAXPATH];
 
 
/* Routine is called repeatedly by decc$from_vms via
/* Routine is called repeatedly by decc$from_vms via
   __gnat_to_canonical_file_list_init until it returns 0 or the expansion
   __gnat_to_canonical_file_list_init until it returns 0 or the expansion
   runs out. */
   runs out. */
 
 
static int
static int
wildcard_translate_unix (char *name)
wildcard_translate_unix (char *name)
{
{
  char *ver;
  char *ver;
  char buff [MAXPATH];
  char buff [MAXPATH];
 
 
  strncpy (buff, name, MAXPATH);
  strncpy (buff, name, MAXPATH);
  buff [MAXPATH - 1] = (char) 0;
  buff [MAXPATH - 1] = (char) 0;
  ver = strrchr (buff, '.');
  ver = strrchr (buff, '.');
 
 
  /* Chop off the version.  */
  /* Chop off the version.  */
  if (ver)
  if (ver)
    *ver = 0;
    *ver = 0;
 
 
  /* Dynamically extend the allocation by the increment.  */
  /* Dynamically extend the allocation by the increment.  */
  if (new_canonical_filelist_in_use == new_canonical_filelist_allocated)
  if (new_canonical_filelist_in_use == new_canonical_filelist_allocated)
    {
    {
      new_canonical_filelist_allocated += NEW_CANONICAL_FILELIST_INCREMENT;
      new_canonical_filelist_allocated += NEW_CANONICAL_FILELIST_INCREMENT;
      new_canonical_filelist = (char **) xrealloc
      new_canonical_filelist = (char **) xrealloc
        (new_canonical_filelist,
        (new_canonical_filelist,
         new_canonical_filelist_allocated * sizeof (char *));
         new_canonical_filelist_allocated * sizeof (char *));
    }
    }
 
 
  new_canonical_filelist[new_canonical_filelist_in_use++] = xstrdup (buff);
  new_canonical_filelist[new_canonical_filelist_in_use++] = xstrdup (buff);
 
 
  return 1;
  return 1;
}
}
 
 
/* Translate a wildcard VMS file spec into a list of Unix file specs. First do
/* Translate a wildcard VMS file spec into a list of Unix file specs. First do
   full translation and copy the results into a list (_init), then return them
   full translation and copy the results into a list (_init), then return them
   one at a time (_next). If onlydirs set, only expand directory files.  */
   one at a time (_next). If onlydirs set, only expand directory files.  */
 
 
int
int
__gnat_to_canonical_file_list_init (char *filespec, int onlydirs)
__gnat_to_canonical_file_list_init (char *filespec, int onlydirs)
{
{
  int len;
  int len;
  char buff [MAXPATH];
  char buff [MAXPATH];
 
 
  len = strlen (filespec);
  len = strlen (filespec);
  strncpy (buff, filespec, MAXPATH);
  strncpy (buff, filespec, MAXPATH);
 
 
  /* Only look for directories */
  /* Only look for directories */
  if (onlydirs && !strstr (&buff [len-5], "*.dir"))
  if (onlydirs && !strstr (&buff [len-5], "*.dir"))
    strncat (buff, "*.dir", MAXPATH);
    strncat (buff, "*.dir", MAXPATH);
 
 
  buff [MAXPATH - 1] = (char) 0;
  buff [MAXPATH - 1] = (char) 0;
 
 
  decc$from_vms (buff, wildcard_translate_unix, 1);
  decc$from_vms (buff, wildcard_translate_unix, 1);
 
 
  /* Remove the .dir extension.  */
  /* Remove the .dir extension.  */
  if (onlydirs)
  if (onlydirs)
    {
    {
      int i;
      int i;
      char *ext;
      char *ext;
 
 
      for (i = 0; i < new_canonical_filelist_in_use; i++)
      for (i = 0; i < new_canonical_filelist_in_use; i++)
        {
        {
          ext = strstr (new_canonical_filelist[i], ".dir");
          ext = strstr (new_canonical_filelist[i], ".dir");
          if (ext)
          if (ext)
            *ext = 0;
            *ext = 0;
        }
        }
    }
    }
 
 
  return new_canonical_filelist_in_use;
  return new_canonical_filelist_in_use;
}
}
 
 
/* Return the next filespec in the list.  */
/* Return the next filespec in the list.  */
 
 
char *
char *
__gnat_to_canonical_file_list_next ()
__gnat_to_canonical_file_list_next ()
{
{
  return new_canonical_filelist[new_canonical_filelist_index++];
  return new_canonical_filelist[new_canonical_filelist_index++];
}
}
 
 
/* Free storage used in the wildcard expansion.  */
/* Free storage used in the wildcard expansion.  */
 
 
void
void
__gnat_to_canonical_file_list_free ()
__gnat_to_canonical_file_list_free ()
{
{
  int i;
  int i;
 
 
   for (i = 0; i < new_canonical_filelist_in_use; i++)
   for (i = 0; i < new_canonical_filelist_in_use; i++)
     free (new_canonical_filelist[i]);
     free (new_canonical_filelist[i]);
 
 
  free (new_canonical_filelist);
  free (new_canonical_filelist);
 
 
  new_canonical_filelist_in_use = 0;
  new_canonical_filelist_in_use = 0;
  new_canonical_filelist_allocated = 0;
  new_canonical_filelist_allocated = 0;
  new_canonical_filelist_index = 0;
  new_canonical_filelist_index = 0;
  new_canonical_filelist = 0;
  new_canonical_filelist = 0;
}
}
 
 
/* The functional equivalent of decc$translate_vms routine.
/* The functional equivalent of decc$translate_vms routine.
   Designed to produce the same output, but is protected against
   Designed to produce the same output, but is protected against
   malformed paths (original version ACCVIOs in this case) and
   malformed paths (original version ACCVIOs in this case) and
   does not require VMS-specific DECC RTL */
   does not require VMS-specific DECC RTL */
 
 
#define NAM$C_MAXRSS 1024
#define NAM$C_MAXRSS 1024
 
 
char *
char *
__gnat_translate_vms (char *src)
__gnat_translate_vms (char *src)
{
{
  static char retbuf [NAM$C_MAXRSS+1];
  static char retbuf [NAM$C_MAXRSS+1];
  char *srcendpos, *pos1, *pos2, *retpos;
  char *srcendpos, *pos1, *pos2, *retpos;
  int disp, path_present = 0;
  int disp, path_present = 0;
 
 
  if (!src) return NULL;
  if (!src) return NULL;
 
 
  srcendpos = strchr (src, '\0');
  srcendpos = strchr (src, '\0');
  retpos = retbuf;
  retpos = retbuf;
 
 
  /* Look for the node and/or device in front of the path */
  /* Look for the node and/or device in front of the path */
  pos1 = src;
  pos1 = src;
  pos2 = strchr (pos1, ':');
  pos2 = strchr (pos1, ':');
 
 
  if (pos2 && (pos2 < srcendpos) && (*(pos2 + 1) == ':')) {
  if (pos2 && (pos2 < srcendpos) && (*(pos2 + 1) == ':')) {
    /* There is a node name. "node_name::" becomes "node_name!" */
    /* There is a node name. "node_name::" becomes "node_name!" */
    disp = pos2 - pos1;
    disp = pos2 - pos1;
    strncpy (retbuf, pos1, disp);
    strncpy (retbuf, pos1, disp);
    retpos [disp] = '!';
    retpos [disp] = '!';
    retpos = retpos + disp + 1;
    retpos = retpos + disp + 1;
    pos1 = pos2 + 2;
    pos1 = pos2 + 2;
    pos2 = strchr (pos1, ':');
    pos2 = strchr (pos1, ':');
  }
  }
 
 
  if (pos2) {
  if (pos2) {
    /* There is a device name. "dev_name:" becomes "/dev_name/" */
    /* There is a device name. "dev_name:" becomes "/dev_name/" */
    *(retpos++) = '/';
    *(retpos++) = '/';
    disp = pos2 - pos1;
    disp = pos2 - pos1;
    strncpy (retpos, pos1, disp);
    strncpy (retpos, pos1, disp);
    retpos = retpos + disp;
    retpos = retpos + disp;
    pos1 = pos2 + 1;
    pos1 = pos2 + 1;
    *(retpos++) = '/';
    *(retpos++) = '/';
  }
  }
  else
  else
    /* No explicit device; we must look ahead and prepend /sys$disk/ if
    /* No explicit device; we must look ahead and prepend /sys$disk/ if
       the path is absolute */
       the path is absolute */
    if ((*pos1 == '[' || *pos1 == '<') && (pos1 < srcendpos)
    if ((*pos1 == '[' || *pos1 == '<') && (pos1 < srcendpos)
        && !strchr (".-]>", *(pos1 + 1))) {
        && !strchr (".-]>", *(pos1 + 1))) {
      strncpy (retpos, "/sys$disk/", 10);
      strncpy (retpos, "/sys$disk/", 10);
      retpos += 10;
      retpos += 10;
    }
    }
 
 
  /* Process the path part */
  /* Process the path part */
  while (*pos1 == '[' || *pos1 == '<') {
  while (*pos1 == '[' || *pos1 == '<') {
    path_present++;
    path_present++;
    pos1++;
    pos1++;
    if (*pos1 == ']' || *pos1 == '>') {
    if (*pos1 == ']' || *pos1 == '>') {
      /* Special case, [] translates to '.' */
      /* Special case, [] translates to '.' */
      *(retpos++) = '.';
      *(retpos++) = '.';
      pos1++;
      pos1++;
    }
    }
    else {
    else {
      /* '[000000' means root dir. It can be present in the middle of
      /* '[000000' means root dir. It can be present in the middle of
         the path due to expansion of logical devices, in which case
         the path due to expansion of logical devices, in which case
         we skip it */
         we skip it */
      if (!strncmp (pos1, "000000", 6) && path_present > 1 &&
      if (!strncmp (pos1, "000000", 6) && path_present > 1 &&
         (*(pos1 + 6) == ']' || *(pos1 + 6) == '>' || *(pos1 + 6) == '.')) {
         (*(pos1 + 6) == ']' || *(pos1 + 6) == '>' || *(pos1 + 6) == '.')) {
          pos1 += 6;
          pos1 += 6;
          if (*pos1 == '.') pos1++;
          if (*pos1 == '.') pos1++;
        }
        }
      else if (*pos1 == '.') {
      else if (*pos1 == '.') {
        /* Relative path */
        /* Relative path */
        *(retpos++) = '.';
        *(retpos++) = '.';
      }
      }
 
 
      /* There is a qualified path */
      /* There is a qualified path */
      while (*pos1 && *pos1 != ']' && *pos1 != '>') {
      while (*pos1 && *pos1 != ']' && *pos1 != '>') {
        switch (*pos1) {
        switch (*pos1) {
          case '.':
          case '.':
            /* '.' is used to separate directories. Replace it with '/' but
            /* '.' is used to separate directories. Replace it with '/' but
               only if there isn't already '/' just before */
               only if there isn't already '/' just before */
            if (*(retpos - 1) != '/') *(retpos++) = '/';
            if (*(retpos - 1) != '/') *(retpos++) = '/';
            pos1++;
            pos1++;
            if (pos1 + 1 < srcendpos && *pos1 == '.' && *(pos1 + 1) == '.') {
            if (pos1 + 1 < srcendpos && *pos1 == '.' && *(pos1 + 1) == '.') {
              /* ellipsis refers to entire subtree; replace with '**' */
              /* ellipsis refers to entire subtree; replace with '**' */
              *(retpos++) = '*'; *(retpos++) = '*'; *(retpos++) = '/';
              *(retpos++) = '*'; *(retpos++) = '*'; *(retpos++) = '/';
              pos1 += 2;
              pos1 += 2;
            }
            }
            break;
            break;
          case '-' :
          case '-' :
            /* When after '.' '[' '<' is equivalent to Unix ".." but there
            /* When after '.' '[' '<' is equivalent to Unix ".." but there
            may be several in a row */
            may be several in a row */
            if (*(pos1 - 1) == '.' || *(pos1 - 1) == '[' ||
            if (*(pos1 - 1) == '.' || *(pos1 - 1) == '[' ||
                *(pos1 - 1) == '<') {
                *(pos1 - 1) == '<') {
              while (*pos1 == '-') {
              while (*pos1 == '-') {
                pos1++;
                pos1++;
                *(retpos++) = '.'; *(retpos++) = '.'; *(retpos++) = '/';
                *(retpos++) = '.'; *(retpos++) = '.'; *(retpos++) = '/';
              }
              }
              retpos--;
              retpos--;
              break;
              break;
            }
            }
            /* otherwise fall through to default */
            /* otherwise fall through to default */
          default:
          default:
            *(retpos++) = *(pos1++);
            *(retpos++) = *(pos1++);
        }
        }
      }
      }
      pos1++;
      pos1++;
    }
    }
  }
  }
 
 
  if (pos1 < srcendpos) {
  if (pos1 < srcendpos) {
    /* Now add the actual file name, until the version suffix if any */
    /* Now add the actual file name, until the version suffix if any */
    if (path_present) *(retpos++) = '/';
    if (path_present) *(retpos++) = '/';
    pos2 = strchr (pos1, ';');
    pos2 = strchr (pos1, ';');
    disp = pos2? (pos2 - pos1) : (srcendpos - pos1);
    disp = pos2? (pos2 - pos1) : (srcendpos - pos1);
    strncpy (retpos, pos1, disp);
    strncpy (retpos, pos1, disp);
    retpos += disp;
    retpos += disp;
    if (pos2 && pos2 < srcendpos) {
    if (pos2 && pos2 < srcendpos) {
      /* There is a non-empty version suffix. ";<ver>" becomes ".<ver>" */
      /* There is a non-empty version suffix. ";<ver>" becomes ".<ver>" */
      *retpos++ = '.';
      *retpos++ = '.';
      disp = srcendpos - pos2 - 1;
      disp = srcendpos - pos2 - 1;
      strncpy (retpos, pos2 + 1, disp);
      strncpy (retpos, pos2 + 1, disp);
      retpos += disp;
      retpos += disp;
    }
    }
  }
  }
 
 
  *retpos = '\0';
  *retpos = '\0';
 
 
  return retbuf;
  return retbuf;
 
 
}
}
 
 
/* Translate a VMS syntax directory specification in to Unix syntax.  If
/* Translate a VMS syntax directory specification in to Unix syntax.  If
   PREFIXFLAG is set, append an underscore "/". If no indicators of VMS syntax
   PREFIXFLAG is set, append an underscore "/". If no indicators of VMS syntax
   found, return input string. Also translate a dirname that contains no
   found, return input string. Also translate a dirname that contains no
   slashes, in case it's a logical name.  */
   slashes, in case it's a logical name.  */
 
 
char *
char *
__gnat_to_canonical_dir_spec (char *dirspec, int prefixflag)
__gnat_to_canonical_dir_spec (char *dirspec, int prefixflag)
{
{
  int len;
  int len;
 
 
  strcpy (new_canonical_dirspec, "");
  strcpy (new_canonical_dirspec, "");
  if (strlen (dirspec))
  if (strlen (dirspec))
    {
    {
      char *dirspec1;
      char *dirspec1;
 
 
      if (strchr (dirspec, ']') || strchr (dirspec, ':'))
      if (strchr (dirspec, ']') || strchr (dirspec, ':'))
        {
        {
          strncpy (new_canonical_dirspec,
          strncpy (new_canonical_dirspec,
                   __gnat_translate_vms (dirspec),
                   __gnat_translate_vms (dirspec),
                   MAXPATH);
                   MAXPATH);
        }
        }
      else if (!strchr (dirspec, '/') && (dirspec1 = getenv (dirspec)) != 0)
      else if (!strchr (dirspec, '/') && (dirspec1 = getenv (dirspec)) != 0)
        {
        {
          strncpy (new_canonical_dirspec,
          strncpy (new_canonical_dirspec,
                  __gnat_translate_vms (dirspec1),
                  __gnat_translate_vms (dirspec1),
                  MAXPATH);
                  MAXPATH);
        }
        }
      else
      else
        {
        {
          strncpy (new_canonical_dirspec, dirspec, MAXPATH);
          strncpy (new_canonical_dirspec, dirspec, MAXPATH);
        }
        }
    }
    }
 
 
  len = strlen (new_canonical_dirspec);
  len = strlen (new_canonical_dirspec);
  if (prefixflag && new_canonical_dirspec [len-1] != '/')
  if (prefixflag && new_canonical_dirspec [len-1] != '/')
    strncat (new_canonical_dirspec, "/", MAXPATH);
    strncat (new_canonical_dirspec, "/", MAXPATH);
 
 
  new_canonical_dirspec [MAXPATH - 1] = (char) 0;
  new_canonical_dirspec [MAXPATH - 1] = (char) 0;
 
 
  return new_canonical_dirspec;
  return new_canonical_dirspec;
 
 
}
}
 
 
/* Translate a VMS syntax file specification into Unix syntax.
/* Translate a VMS syntax file specification into Unix syntax.
   If no indicators of VMS syntax found, check if it's an uppercase
   If no indicators of VMS syntax found, check if it's an uppercase
   alphanumeric_ name and if so try it out as an environment
   alphanumeric_ name and if so try it out as an environment
   variable (logical name). If all else fails return the
   variable (logical name). If all else fails return the
   input string.  */
   input string.  */
 
 
char *
char *
__gnat_to_canonical_file_spec (char *filespec)
__gnat_to_canonical_file_spec (char *filespec)
{
{
  char *filespec1;
  char *filespec1;
 
 
  strncpy (new_canonical_filespec, "", MAXPATH);
  strncpy (new_canonical_filespec, "", MAXPATH);
 
 
  if (strchr (filespec, ']') || strchr (filespec, ':'))
  if (strchr (filespec, ']') || strchr (filespec, ':'))
    {
    {
      char *tspec = (char *) __gnat_translate_vms (filespec);
      char *tspec = (char *) __gnat_translate_vms (filespec);
 
 
      if (tspec != (char *) -1)
      if (tspec != (char *) -1)
        strncpy (new_canonical_filespec, tspec, MAXPATH);
        strncpy (new_canonical_filespec, tspec, MAXPATH);
    }
    }
  else if ((strlen (filespec) == strspn (filespec,
  else if ((strlen (filespec) == strspn (filespec,
            "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"))
            "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"))
        && (filespec1 = getenv (filespec)))
        && (filespec1 = getenv (filespec)))
    {
    {
      char *tspec = (char *) __gnat_translate_vms (filespec1);
      char *tspec = (char *) __gnat_translate_vms (filespec1);
 
 
      if (tspec != (char *) -1)
      if (tspec != (char *) -1)
        strncpy (new_canonical_filespec, tspec, MAXPATH);
        strncpy (new_canonical_filespec, tspec, MAXPATH);
    }
    }
  else
  else
    {
    {
      strncpy (new_canonical_filespec, filespec, MAXPATH);
      strncpy (new_canonical_filespec, filespec, MAXPATH);
    }
    }
 
 
  new_canonical_filespec [MAXPATH - 1] = (char) 0;
  new_canonical_filespec [MAXPATH - 1] = (char) 0;
 
 
  return new_canonical_filespec;
  return new_canonical_filespec;
}
}
 
 
/* Translate a VMS syntax path specification into Unix syntax.
/* Translate a VMS syntax path specification into Unix syntax.
   If no indicators of VMS syntax found, return input string.  */
   If no indicators of VMS syntax found, return input string.  */
 
 
char *
char *
__gnat_to_canonical_path_spec (char *pathspec)
__gnat_to_canonical_path_spec (char *pathspec)
{
{
  char *curr, *next, buff [MAXPATH];
  char *curr, *next, buff [MAXPATH];
 
 
  if (pathspec == 0)
  if (pathspec == 0)
    return pathspec;
    return pathspec;
 
 
  /* If there are /'s, assume it's a Unix path spec and return.  */
  /* If there are /'s, assume it's a Unix path spec and return.  */
  if (strchr (pathspec, '/'))
  if (strchr (pathspec, '/'))
    return pathspec;
    return pathspec;
 
 
  new_canonical_pathspec[0] = 0;
  new_canonical_pathspec[0] = 0;
  curr = pathspec;
  curr = pathspec;
 
 
  for (;;)
  for (;;)
    {
    {
      next = strchr (curr, ',');
      next = strchr (curr, ',');
      if (next == 0)
      if (next == 0)
        next = strchr (curr, 0);
        next = strchr (curr, 0);
 
 
      strncpy (buff, curr, next - curr);
      strncpy (buff, curr, next - curr);
      buff[next - curr] = 0;
      buff[next - curr] = 0;
 
 
      /* Check for wildcards and expand if present.  */
      /* Check for wildcards and expand if present.  */
      if (strchr (buff, '*') || strchr (buff, '%') || strstr (buff, "..."))
      if (strchr (buff, '*') || strchr (buff, '%') || strstr (buff, "..."))
        {
        {
          int i, dirs;
          int i, dirs;
 
 
          dirs = __gnat_to_canonical_file_list_init (buff, 1);
          dirs = __gnat_to_canonical_file_list_init (buff, 1);
          for (i = 0; i < dirs; i++)
          for (i = 0; i < dirs; i++)
            {
            {
              char *next_dir;
              char *next_dir;
 
 
              next_dir = __gnat_to_canonical_file_list_next ();
              next_dir = __gnat_to_canonical_file_list_next ();
              strncat (new_canonical_pathspec, next_dir, MAXPATH);
              strncat (new_canonical_pathspec, next_dir, MAXPATH);
 
 
              /* Don't append the separator after the last expansion.  */
              /* Don't append the separator after the last expansion.  */
              if (i+1 < dirs)
              if (i+1 < dirs)
                strncat (new_canonical_pathspec, ":", MAXPATH);
                strncat (new_canonical_pathspec, ":", MAXPATH);
            }
            }
 
 
          __gnat_to_canonical_file_list_free ();
          __gnat_to_canonical_file_list_free ();
        }
        }
      else
      else
        strncat (new_canonical_pathspec,
        strncat (new_canonical_pathspec,
                __gnat_to_canonical_dir_spec (buff, 0), MAXPATH);
                __gnat_to_canonical_dir_spec (buff, 0), MAXPATH);
 
 
      if (*next == 0)
      if (*next == 0)
        break;
        break;
 
 
      strncat (new_canonical_pathspec, ":", MAXPATH);
      strncat (new_canonical_pathspec, ":", MAXPATH);
      curr = next + 1;
      curr = next + 1;
    }
    }
 
 
  new_canonical_pathspec [MAXPATH - 1] = (char) 0;
  new_canonical_pathspec [MAXPATH - 1] = (char) 0;
 
 
  return new_canonical_pathspec;
  return new_canonical_pathspec;
}
}
 
 
static char filename_buff [MAXPATH];
static char filename_buff [MAXPATH];
 
 
static int
static int
translate_unix (char *name, int type)
translate_unix (char *name, int type)
{
{
  strncpy (filename_buff, name, MAXPATH);
  strncpy (filename_buff, name, MAXPATH);
  filename_buff [MAXPATH - 1] = (char) 0;
  filename_buff [MAXPATH - 1] = (char) 0;
  return 0;
  return 0;
}
}
 
 
/* Translate a Unix syntax path spec into a VMS style (comma separated list of
/* Translate a Unix syntax path spec into a VMS style (comma separated list of
   directories.  */
   directories.  */
 
 
static char *
static char *
to_host_path_spec (char *pathspec)
to_host_path_spec (char *pathspec)
{
{
  char *curr, *next, buff [MAXPATH];
  char *curr, *next, buff [MAXPATH];
 
 
  if (pathspec == 0)
  if (pathspec == 0)
    return pathspec;
    return pathspec;
 
 
  /* Can't very well test for colons, since that's the Unix separator!  */
  /* Can't very well test for colons, since that's the Unix separator!  */
  if (strchr (pathspec, ']') || strchr (pathspec, ','))
  if (strchr (pathspec, ']') || strchr (pathspec, ','))
    return pathspec;
    return pathspec;
 
 
  new_host_pathspec[0] = 0;
  new_host_pathspec[0] = 0;
  curr = pathspec;
  curr = pathspec;
 
 
  for (;;)
  for (;;)
    {
    {
      next = strchr (curr, ':');
      next = strchr (curr, ':');
      if (next == 0)
      if (next == 0)
        next = strchr (curr, 0);
        next = strchr (curr, 0);
 
 
      strncpy (buff, curr, next - curr);
      strncpy (buff, curr, next - curr);
      buff[next - curr] = 0;
      buff[next - curr] = 0;
 
 
      strncat (new_host_pathspec, __gnat_to_host_dir_spec (buff, 0), MAXPATH);
      strncat (new_host_pathspec, __gnat_to_host_dir_spec (buff, 0), MAXPATH);
      if (*next == 0)
      if (*next == 0)
        break;
        break;
      strncat (new_host_pathspec, ",", MAXPATH);
      strncat (new_host_pathspec, ",", MAXPATH);
      curr = next + 1;
      curr = next + 1;
    }
    }
 
 
  new_host_pathspec [MAXPATH - 1] = (char) 0;
  new_host_pathspec [MAXPATH - 1] = (char) 0;
 
 
  return new_host_pathspec;
  return new_host_pathspec;
}
}
 
 
/* Translate a Unix syntax directory specification into VMS syntax.  The
/* Translate a Unix syntax directory specification into VMS syntax.  The
   PREFIXFLAG has no effect, but is kept for symmetry with
   PREFIXFLAG has no effect, but is kept for symmetry with
   to_canonical_dir_spec.  If indicators of VMS syntax found, return input
   to_canonical_dir_spec.  If indicators of VMS syntax found, return input
   string. */
   string. */
 
 
char *
char *
__gnat_to_host_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
__gnat_to_host_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
{
{
  int len = strlen (dirspec);
  int len = strlen (dirspec);
 
 
  strncpy (new_host_dirspec, dirspec, MAXPATH);
  strncpy (new_host_dirspec, dirspec, MAXPATH);
  new_host_dirspec [MAXPATH - 1] = (char) 0;
  new_host_dirspec [MAXPATH - 1] = (char) 0;
 
 
  if (strchr (new_host_dirspec, ']') || strchr (new_host_dirspec, ':'))
  if (strchr (new_host_dirspec, ']') || strchr (new_host_dirspec, ':'))
    return new_host_dirspec;
    return new_host_dirspec;
 
 
  while (len > 1 && new_host_dirspec[len - 1] == '/')
  while (len > 1 && new_host_dirspec[len - 1] == '/')
    {
    {
      new_host_dirspec[len - 1] = 0;
      new_host_dirspec[len - 1] = 0;
      len--;
      len--;
    }
    }
 
 
  decc$to_vms (new_host_dirspec, translate_unix, 1, 2);
  decc$to_vms (new_host_dirspec, translate_unix, 1, 2);
  strncpy (new_host_dirspec, filename_buff, MAXPATH);
  strncpy (new_host_dirspec, filename_buff, MAXPATH);
  new_host_dirspec [MAXPATH - 1] = (char) 0;
  new_host_dirspec [MAXPATH - 1] = (char) 0;
 
 
  return new_host_dirspec;
  return new_host_dirspec;
}
}
 
 
/* Translate a Unix syntax file specification into VMS syntax.
/* Translate a Unix syntax file specification into VMS syntax.
   If indicators of VMS syntax found, return input string.  */
   If indicators of VMS syntax found, return input string.  */
 
 
char *
char *
__gnat_to_host_file_spec (char *filespec)
__gnat_to_host_file_spec (char *filespec)
{
{
  strncpy (new_host_filespec, "", MAXPATH);
  strncpy (new_host_filespec, "", MAXPATH);
  if (strchr (filespec, ']') || strchr (filespec, ':'))
  if (strchr (filespec, ']') || strchr (filespec, ':'))
    {
    {
      strncpy (new_host_filespec, filespec, MAXPATH);
      strncpy (new_host_filespec, filespec, MAXPATH);
    }
    }
  else
  else
    {
    {
      decc$to_vms (filespec, translate_unix, 1, 1);
      decc$to_vms (filespec, translate_unix, 1, 1);
      strncpy (new_host_filespec, filename_buff, MAXPATH);
      strncpy (new_host_filespec, filename_buff, MAXPATH);
    }
    }
 
 
  new_host_filespec [MAXPATH - 1] = (char) 0;
  new_host_filespec [MAXPATH - 1] = (char) 0;
 
 
  return new_host_filespec;
  return new_host_filespec;
}
}
 
 
void
void
__gnat_adjust_os_resource_limits ()
__gnat_adjust_os_resource_limits ()
{
{
  SYS$ADJWSL (131072, 0);
  SYS$ADJWSL (131072, 0);
}
}
 
 
#else /* VMS */
#else /* VMS */
 
 
/* Dummy functions for Osint import for non-VMS systems.  */
/* Dummy functions for Osint import for non-VMS systems.  */
 
 
int
int
__gnat_to_canonical_file_list_init
__gnat_to_canonical_file_list_init
  (char *dirspec ATTRIBUTE_UNUSED, int onlydirs ATTRIBUTE_UNUSED)
  (char *dirspec ATTRIBUTE_UNUSED, int onlydirs ATTRIBUTE_UNUSED)
{
{
  return 0;
  return 0;
}
}
 
 
char *
char *
__gnat_to_canonical_file_list_next (void)
__gnat_to_canonical_file_list_next (void)
{
{
  static char *empty = "";
  static char *empty = "";
  return empty;
  return empty;
}
}
 
 
void
void
__gnat_to_canonical_file_list_free (void)
__gnat_to_canonical_file_list_free (void)
{
{
}
}
 
 
char *
char *
__gnat_to_canonical_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
__gnat_to_canonical_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
{
{
  return dirspec;
  return dirspec;
}
}
 
 
char *
char *
__gnat_to_canonical_file_spec (char *filespec)
__gnat_to_canonical_file_spec (char *filespec)
{
{
  return filespec;
  return filespec;
}
}
 
 
char *
char *
__gnat_to_canonical_path_spec (char *pathspec)
__gnat_to_canonical_path_spec (char *pathspec)
{
{
  return pathspec;
  return pathspec;
}
}
 
 
char *
char *
__gnat_to_host_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
__gnat_to_host_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
{
{
  return dirspec;
  return dirspec;
}
}
 
 
char *
char *
__gnat_to_host_file_spec (char *filespec)
__gnat_to_host_file_spec (char *filespec)
{
{
  return filespec;
  return filespec;
}
}
 
 
void
void
__gnat_adjust_os_resource_limits (void)
__gnat_adjust_os_resource_limits (void)
{
{
}
}
 
 
#endif
#endif
 
 
/* For EMX, we cannot include dummy in libgcc, since it is too difficult
/* For EMX, we cannot include dummy in libgcc, since it is too difficult
   to coordinate this with the EMX distribution. Consequently, we put the
   to coordinate this with the EMX distribution. Consequently, we put the
   definition of dummy which is used for exception handling, here.  */
   definition of dummy which is used for exception handling, here.  */
 
 
#if defined (__EMX__)
#if defined (__EMX__)
void __dummy () {}
void __dummy () {}
#endif
#endif
 
 
#if defined (__mips_vxworks)
#if defined (__mips_vxworks)
int
int
_flush_cache()
_flush_cache()
{
{
   CACHE_USER_FLUSH (0, ENTIRE_CACHE);
   CACHE_USER_FLUSH (0, ENTIRE_CACHE);
}
}
#endif
#endif
 
 
#if defined (IS_CROSS)  \
#if defined (IS_CROSS)  \
  || (! ((defined (sparc) || defined (i386)) && defined (sun) \
  || (! ((defined (sparc) || defined (i386)) && defined (sun) \
      && defined (__SVR4)) \
      && defined (__SVR4)) \
      && ! (defined (linux) && (defined (i386) || defined (__x86_64__))) \
      && ! (defined (linux) && (defined (i386) || defined (__x86_64__))) \
      && ! (defined (linux) && defined (__ia64__)) \
      && ! (defined (linux) && defined (__ia64__)) \
      && ! (defined (linux) && defined (powerpc)) \
      && ! (defined (linux) && defined (powerpc)) \
      && ! defined (__FreeBSD__) \
      && ! defined (__FreeBSD__) \
      && ! defined (__Lynx__) \
      && ! defined (__Lynx__) \
      && ! defined (__hpux__) \
      && ! defined (__hpux__) \
      && ! defined (__APPLE__) \
      && ! defined (__APPLE__) \
      && ! defined (_AIX) \
      && ! defined (_AIX) \
      && ! (defined (__alpha__)  && defined (__osf__)) \
      && ! (defined (__alpha__)  && defined (__osf__)) \
      && ! defined (VMS) \
      && ! defined (VMS) \
      && ! defined (__MINGW32__) \
      && ! defined (__MINGW32__) \
      && ! (defined (__mips) && defined (__sgi)))
      && ! (defined (__mips) && defined (__sgi)))
 
 
/* Dummy function to satisfy g-trasym.o. See the preprocessor conditional
/* Dummy function to satisfy g-trasym.o. See the preprocessor conditional
   just above for a list of native platforms that provide a non-dummy
   just above for a list of native platforms that provide a non-dummy
   version of this procedure in libaddr2line.a.  */
   version of this procedure in libaddr2line.a.  */
 
 
void
void
convert_addresses (const char *file_name ATTRIBUTE_UNUSED,
convert_addresses (const char *file_name ATTRIBUTE_UNUSED,
                   void *addrs ATTRIBUTE_UNUSED,
                   void *addrs ATTRIBUTE_UNUSED,
                   int n_addr ATTRIBUTE_UNUSED,
                   int n_addr ATTRIBUTE_UNUSED,
                   void *buf ATTRIBUTE_UNUSED,
                   void *buf ATTRIBUTE_UNUSED,
                   int *len ATTRIBUTE_UNUSED)
                   int *len ATTRIBUTE_UNUSED)
{
{
  *len = 0;
  *len = 0;
}
}
#endif
#endif
 
 
#if defined (_WIN32)
#if defined (_WIN32)
int __gnat_argument_needs_quote = 1;
int __gnat_argument_needs_quote = 1;
#else
#else
int __gnat_argument_needs_quote = 0;
int __gnat_argument_needs_quote = 0;
#endif
#endif
 
 
/* This option is used to enable/disable object files handling from the
/* This option is used to enable/disable object files handling from the
   binder file by the GNAT Project module. For example, this is disabled on
   binder file by the GNAT Project module. For example, this is disabled on
   Windows (prior to GCC 3.4) as it is already done by the mdll module.
   Windows (prior to GCC 3.4) as it is already done by the mdll module.
   Stating with GCC 3.4 the shared libraries are not based on mdll
   Stating with GCC 3.4 the shared libraries are not based on mdll
   anymore as it uses the GCC's -shared option  */
   anymore as it uses the GCC's -shared option  */
#if defined (_WIN32) \
#if defined (_WIN32) \
    && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
    && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
int __gnat_prj_add_obj_files = 0;
int __gnat_prj_add_obj_files = 0;
#else
#else
int __gnat_prj_add_obj_files = 1;
int __gnat_prj_add_obj_files = 1;
#endif
#endif
 
 
/* char used as prefix/suffix for environment variables */
/* char used as prefix/suffix for environment variables */
#if defined (_WIN32)
#if defined (_WIN32)
char __gnat_environment_char = '%';
char __gnat_environment_char = '%';
#else
#else
char __gnat_environment_char = '$';
char __gnat_environment_char = '$';
#endif
#endif
 
 
/* This functions copy the file attributes from a source file to a
/* This functions copy the file attributes from a source file to a
   destination file.
   destination file.
 
 
   mode = 0  : In this mode copy only the file time stamps (last access and
   mode = 0  : In this mode copy only the file time stamps (last access and
               last modification time stamps).
               last modification time stamps).
 
 
   mode = 1  : In this mode, time stamps and read/write/execute attributes are
   mode = 1  : In this mode, time stamps and read/write/execute attributes are
               copied.
               copied.
 
 
   Returns 0 if operation was successful and -1 in case of error. */
   Returns 0 if operation was successful and -1 in case of error. */
 
 
int
int
__gnat_copy_attribs (char *from, char *to, int mode)
__gnat_copy_attribs (char *from, char *to, int mode)
{
{
#if defined (VMS) || defined (__vxworks) || defined (__nucleus__)
#if defined (VMS) || defined (__vxworks) || defined (__nucleus__)
  return -1;
  return -1;
 
 
#elif defined (_WIN32) && !defined (RTX)
#elif defined (_WIN32) && !defined (RTX)
  TCHAR wfrom [GNAT_MAX_PATH_LEN + 2];
  TCHAR wfrom [GNAT_MAX_PATH_LEN + 2];
  TCHAR wto [GNAT_MAX_PATH_LEN + 2];
  TCHAR wto [GNAT_MAX_PATH_LEN + 2];
  BOOL res;
  BOOL res;
  FILETIME fct, flat, flwt;
  FILETIME fct, flat, flwt;
  HANDLE hfrom, hto;
  HANDLE hfrom, hto;
 
 
  S2WSC (wfrom, from, GNAT_MAX_PATH_LEN + 2);
  S2WSC (wfrom, from, GNAT_MAX_PATH_LEN + 2);
  S2WSC (wto, to, GNAT_MAX_PATH_LEN + 2);
  S2WSC (wto, to, GNAT_MAX_PATH_LEN + 2);
 
 
  /* retrieve from times */
  /* retrieve from times */
 
 
  hfrom = CreateFile
  hfrom = CreateFile
    (wfrom, GENERIC_READ, 0, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
    (wfrom, GENERIC_READ, 0, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
 
 
  if (hfrom == INVALID_HANDLE_VALUE)
  if (hfrom == INVALID_HANDLE_VALUE)
    return -1;
    return -1;
 
 
  res = GetFileTime (hfrom, &fct, &flat, &flwt);
  res = GetFileTime (hfrom, &fct, &flat, &flwt);
 
 
  CloseHandle (hfrom);
  CloseHandle (hfrom);
 
 
  if (res == 0)
  if (res == 0)
    return -1;
    return -1;
 
 
  /* retrieve from times */
  /* retrieve from times */
 
 
  hto = CreateFile
  hto = CreateFile
    (wto, GENERIC_WRITE, 0, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
    (wto, GENERIC_WRITE, 0, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
 
 
  if (hto == INVALID_HANDLE_VALUE)
  if (hto == INVALID_HANDLE_VALUE)
    return -1;
    return -1;
 
 
  res = SetFileTime (hto, NULL, &flat, &flwt);
  res = SetFileTime (hto, NULL, &flat, &flwt);
 
 
  CloseHandle (hto);
  CloseHandle (hto);
 
 
  if (res == 0)
  if (res == 0)
    return -1;
    return -1;
 
 
  /* Set file attributes in full mode. */
  /* Set file attributes in full mode. */
 
 
  if (mode == 1)
  if (mode == 1)
    {
    {
      DWORD attribs = GetFileAttributes (wfrom);
      DWORD attribs = GetFileAttributes (wfrom);
 
 
      if (attribs == INVALID_FILE_ATTRIBUTES)
      if (attribs == INVALID_FILE_ATTRIBUTES)
        return -1;
        return -1;
 
 
      res = SetFileAttributes (wto, attribs);
      res = SetFileAttributes (wto, attribs);
      if (res == 0)
      if (res == 0)
        return -1;
        return -1;
    }
    }
 
 
  return 0;
  return 0;
 
 
#else
#else
  GNAT_STRUCT_STAT fbuf;
  GNAT_STRUCT_STAT fbuf;
  struct utimbuf tbuf;
  struct utimbuf tbuf;
 
 
  if (GNAT_STAT (from, &fbuf) == -1)
  if (GNAT_STAT (from, &fbuf) == -1)
    {
    {
      return -1;
      return -1;
    }
    }
 
 
  tbuf.actime = fbuf.st_atime;
  tbuf.actime = fbuf.st_atime;
  tbuf.modtime = fbuf.st_mtime;
  tbuf.modtime = fbuf.st_mtime;
 
 
  if (utime (to, &tbuf) == -1)
  if (utime (to, &tbuf) == -1)
    {
    {
      return -1;
      return -1;
    }
    }
 
 
  if (mode == 1)
  if (mode == 1)
    {
    {
      if (chmod (to, fbuf.st_mode) == -1)
      if (chmod (to, fbuf.st_mode) == -1)
        {
        {
          return -1;
          return -1;
        }
        }
    }
    }
 
 
  return 0;
  return 0;
#endif
#endif
}
}
 
 
int
int
__gnat_lseek (int fd, long offset, int whence)
__gnat_lseek (int fd, long offset, int whence)
{
{
  return (int) lseek (fd, offset, whence);
  return (int) lseek (fd, offset, whence);
}
}
 
 
/* This function returns the major version number of GCC being used.  */
/* This function returns the major version number of GCC being used.  */
int
int
get_gcc_version (void)
get_gcc_version (void)
{
{
#ifdef IN_RTS
#ifdef IN_RTS
  return __GNUC__;
  return __GNUC__;
#else
#else
  return (int) (version_string[0] - '0');
  return (int) (version_string[0] - '0');
#endif
#endif
}
}
 
 
int
int
__gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED,
__gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED,
                          int close_on_exec_p ATTRIBUTE_UNUSED)
                          int close_on_exec_p ATTRIBUTE_UNUSED)
{
{
#if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
#if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
  int flags = fcntl (fd, F_GETFD, 0);
  int flags = fcntl (fd, F_GETFD, 0);
  if (flags < 0)
  if (flags < 0)
    return flags;
    return flags;
  if (close_on_exec_p)
  if (close_on_exec_p)
    flags |= FD_CLOEXEC;
    flags |= FD_CLOEXEC;
  else
  else
    flags &= ~FD_CLOEXEC;
    flags &= ~FD_CLOEXEC;
  return fcntl (fd, F_SETFD, flags | FD_CLOEXEC);
  return fcntl (fd, F_SETFD, flags | FD_CLOEXEC);
#elif defined(_WIN32)
#elif defined(_WIN32)
  HANDLE h = (HANDLE) _get_osfhandle (fd);
  HANDLE h = (HANDLE) _get_osfhandle (fd);
  if (h == (HANDLE) -1)
  if (h == (HANDLE) -1)
    return -1;
    return -1;
  if (close_on_exec_p)
  if (close_on_exec_p)
    return ! SetHandleInformation (h, HANDLE_FLAG_INHERIT, 0);
    return ! SetHandleInformation (h, HANDLE_FLAG_INHERIT, 0);
  return ! SetHandleInformation (h, HANDLE_FLAG_INHERIT,
  return ! SetHandleInformation (h, HANDLE_FLAG_INHERIT,
    HANDLE_FLAG_INHERIT);
    HANDLE_FLAG_INHERIT);
#else
#else
  /* TODO: Unimplemented. */
  /* TODO: Unimplemented. */
  return -1;
  return -1;
#endif
#endif
}
}
 
 
/* Indicates if platforms supports automatic initialization through the
/* Indicates if platforms supports automatic initialization through the
   constructor mechanism */
   constructor mechanism */
int
int
__gnat_binder_supports_auto_init (void)
__gnat_binder_supports_auto_init (void)
{
{
#ifdef VMS
#ifdef VMS
   return 0;
   return 0;
#else
#else
   return 1;
   return 1;
#endif
#endif
}
}
 
 
/* Indicates that Stand-Alone Libraries are automatically initialized through
/* Indicates that Stand-Alone Libraries are automatically initialized through
   the constructor mechanism */
   the constructor mechanism */
int
int
__gnat_sals_init_using_constructors (void)
__gnat_sals_init_using_constructors (void)
{
{
#if defined (__vxworks) || defined (__Lynx__) || defined (VMS)
#if defined (__vxworks) || defined (__Lynx__) || defined (VMS)
   return 0;
   return 0;
#else
#else
   return 1;
   return 1;
#endif
#endif
}
}
 
 
#ifdef RTX
#ifdef RTX
 
 
/* In RTX mode, the procedure to get the time (as file time) is different
/* 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,
   in RTSS mode and Win32 mode. In order to avoid duplicating an Ada file,
   we introduce an intermediate procedure to link against the corresponding
   we introduce an intermediate procedure to link against the corresponding
   one in each situation. */
   one in each situation. */
 
 
extern void GetTimeAsFileTime(LPFILETIME pTime);
extern void GetTimeAsFileTime(LPFILETIME pTime);
 
 
void GetTimeAsFileTime(LPFILETIME pTime)
void GetTimeAsFileTime(LPFILETIME pTime)
{
{
#ifdef RTSS
#ifdef RTSS
  RtGetRtssTimeAsFileTime (pTime); /* RTSS interface */
  RtGetRtssTimeAsFileTime (pTime); /* RTSS interface */
#else
#else
  GetSystemTimeAsFileTime (pTime); /* w32 interface */
  GetSystemTimeAsFileTime (pTime); /* w32 interface */
#endif
#endif
}
}
 
 
#ifdef RTSS
#ifdef RTSS
/* Add symbol that is required to link. It would otherwise be taken from
/* 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
   libgcc.a and it would try to use the gcc constructors that are not
   supported by Microsoft linker. */
   supported by Microsoft linker. */
 
 
extern void __main (void);
extern void __main (void);
 
 
void __main (void) {}
void __main (void) {}
#endif
#endif
#endif
#endif
 
 
#if defined (linux) || defined(__GLIBC__)
#if defined (linux) || defined(__GLIBC__)
/* pthread affinity support */
/* pthread affinity support */
 
 
int __gnat_pthread_setaffinity_np (pthread_t th,
int __gnat_pthread_setaffinity_np (pthread_t th,
                                   size_t cpusetsize,
                                   size_t cpusetsize,
                                   const void *cpuset);
                                   const void *cpuset);
 
 
#ifdef CPU_SETSIZE
#ifdef CPU_SETSIZE
#include <pthread.h>
#include <pthread.h>
int
int
__gnat_pthread_setaffinity_np (pthread_t th,
__gnat_pthread_setaffinity_np (pthread_t th,
                               size_t cpusetsize,
                               size_t cpusetsize,
                               const cpu_set_t *cpuset)
                               const cpu_set_t *cpuset)
{
{
  return pthread_setaffinity_np (th, cpusetsize, cpuset);
  return pthread_setaffinity_np (th, cpusetsize, cpuset);
}
}
#else
#else
int
int
__gnat_pthread_setaffinity_np (pthread_t th ATTRIBUTE_UNUSED,
__gnat_pthread_setaffinity_np (pthread_t th ATTRIBUTE_UNUSED,
                               size_t cpusetsize ATTRIBUTE_UNUSED,
                               size_t cpusetsize ATTRIBUTE_UNUSED,
                               const void *cpuset ATTRIBUTE_UNUSED)
                               const void *cpuset ATTRIBUTE_UNUSED)
{
{
  return 0;
  return 0;
}
}
#endif
#endif
#endif
#endif
 
 
#if defined (linux)
#if defined (linux)
/* There is no function in the glibc to retrieve the LWP of the current
/* 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
   thread. We need to do a system call in order to retrieve this
   information. */
   information. */
#include <sys/syscall.h>
#include <sys/syscall.h>
void *__gnat_lwp_self (void)
void *__gnat_lwp_self (void)
{
{
   return (void *) syscall (__NR_gettid);
   return (void *) syscall (__NR_gettid);
}
}
#endif
#endif
 
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.