* *
* C Implementation File *
* *
- * Copyright (C) 1992-2003, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2005, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
#ifdef VMS
#define _POSIX_EXIT 1
+#define HOST_EXECUTABLE_SUFFIX ".exe"
+#define HOST_OBJECT_SUFFIX ".obj"
#endif
#ifdef IN_RTS
/* Header files and definitions for __gnat_set_file_time_name. */
-#include <rms.h>
-#include <atrdef.h>
-#include <fibdef.h>
-#include <stsdef.h>
-#include <iodef.h>
+#include <vms/rms.h>
+#include <vms/atrdef.h>
+#include <vms/fibdef.h>
+#include <vms/stsdef.h>
+#include <vms/iodef.h>
#include <errno.h>
-#include <descrip.h>
+#include <vms/descrip.h>
#include <string.h>
#include <unixlib.h>
#if defined (_WIN32)
#include <dir.h>
#include <windows.h>
+#undef DIR_SEPARATOR
+#define DIR_SEPARATOR '\\'
#endif
#include "adaint.h"
system provides the routine readdir_r. */
#undef HAVE_READDIR_R
\f
+#if defined(VMS) && defined (__LONG_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 */
+
+typedef __char_ptr32 *__char_ptr_char_ptr32 __attribute__ ((mode (SI)));
+
+static __char_ptr_char_ptr32
+to_ptr32 (char **ptr64)
+{
+ int argc;
+ __char_ptr_char_ptr32 short_argv;
+
+ for (argc=0; ptr64[argc]; argc++);
+
+ /* Reallocate argv with 32 bit pointers. */
+ short_argv = (__char_ptr_char_ptr32) decc$malloc
+ (sizeof (__char_ptr32) * (argc + 1));
+
+ for (argc=0; ptr64[argc]; argc++)
+ short_argv[argc] = (__char_ptr32) decc$strdup (ptr64[argc]);
+
+ short_argv[argc] = (__char_ptr32) 0;
+ return short_argv;
+
+}
+#define MAYBE_TO_PTR32(argv) to_ptr32 (argv)
+#else
+#define MAYBE_TO_PTR32(argv) argv
+#endif
+
void
__gnat_to_gm_time
(OS_Time *p_time,
int fd;
sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
- sprintf (temp_file, "%s-%ld-%ld", dir, (long) getpid(), (long) getppid ());
+ sprintf (temp_file, "%s%cTMP-%ld-%ld",
+ dir, DIR_SEPARATOR, (long)getpid(), (long)getppid ());
/* Create the temporary file and write the process number. */
fd = open (temp_file, O_CREAT | O_WRONLY, 0600);
}
int
+__gnat_create_output_file (char *path)
+{
+ int fd;
+#if defined (VMS)
+ fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM,
+ "rfm=stmlf", "ctx=rec", "rat=none", "rop=nlk",
+ "shr=del,get,put,upd");
+#else
+ fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM);
+#endif
+
+ return fd < 0 ? -1 : fd;
+}
+
+int
__gnat_open_append (char *path, int fmode)
{
int fd;
strcpy (path, "GNAT-XXXXXX");
-#if defined (linux) && !defined (__vxworks)
+#if (defined (__FreeBSD__) || defined (linux)) && !defined (__vxworks)
return mkstemp (path);
#elif defined (__Lynx__)
mktemp (path);
return (statbuf.st_size);
}
+/* Return the number of bytes in the specified named file. */
+
+long
+__gnat_named_file_length (char *name)
+{
+ int ret;
+ struct stat statbuf;
+
+ ret = __gnat_stat (name, &statbuf);
+ if (ret || !S_ISREG (statbuf.st_mode))
+ return 0;
+
+ return (statbuf.st_size);
+}
+
/* Create a temporary filename and put it in string pointed to by
TMP_FILENAME. */
free (pname);
}
-#elif defined (linux)
+#elif defined (linux) || defined (__FreeBSD__)
#define MAX_SAFE_PATH 1000
char *tmpdir = getenv ("TMPDIR");
return NULL;
#else
- struct dirent *dirent = readdir (dirp);
+ struct dirent *dirent = (struct dirent *) readdir (dirp);
if (dirent != NULL)
{
/* Return a GNAT time stamp given a file name. */
-time_t
+OS_Time
__gnat_file_time_name (char *name)
{
int fd = open (name, O_RDONLY | O_BINARY);
time_t ret = __gnat_file_time_fd (fd);
close (fd);
- return ret;
+ return (OS_Time)ret;
#elif defined (_WIN32)
time_t ret = 0;
ret = win32_filetime (h);
CloseHandle (h);
}
- return ret;
+ return (OS_Time) ret;
#else
struct stat statbuf;
- (void) __gnat_stat (name, &statbuf);
+ if (__gnat_stat (name, &statbuf) != 0) {
+ return (OS_Time)-1;
+ } else {
#ifdef VMS
- /* VMS has file versioning. */
- return statbuf.st_ctime;
+ /* VMS has file versioning. */
+ return (OS_Time)statbuf.st_ctime;
#else
- return statbuf.st_mtime;
+ return (OS_Time)statbuf.st_mtime;
#endif
+ }
#endif
}
/* Return a GNAT time stamp given a file descriptor. */
-time_t
+OS_Time
__gnat_file_time_fd (int fd)
{
/* The following workaround code is due to the fact that under EMX and
tot_secs += file_hour * 3600;
tot_secs += file_min * 60;
tot_secs += file_tsec * 2;
- return tot_secs;
+ return (OS_Time) tot_secs;
#elif defined (_WIN32)
HANDLE h = (HANDLE) _get_osfhandle (fd);
time_t ret = win32_filetime (h);
- return ret;
+ return (OS_Time) ret;
#else
struct stat statbuf;
- (void) fstat (fd, &statbuf);
-
+ if (fstat (fd, &statbuf) != 0) {
+ return (OS_Time) -1;
+ } else {
#ifdef VMS
- /* VMS has file versioning. */
- return statbuf.st_ctime;
+ /* VMS has file versioning. */
+ return (OS_Time) statbuf.st_ctime;
#else
- return statbuf.st_mtime;
+ return (OS_Time) statbuf.st_mtime;
#endif
+ }
#endif
}
struct descriptor_s
{
unsigned short len, mbz;
- char *adr;
+ __char_ptr32 adr;
};
typedef struct _ile3
{
unsigned short len, code;
- char *adr;
+ __char_ptr32 adr;
unsigned short *retlen_adr;
} ile_s;
{
value_size = name_size = 256;
res = RegEnumValue (reg_key, index, name, &name_size, 0,
- &type, value, &value_size);
+ &type, (LPBYTE)value, &value_size);
if (res == ERROR_SUCCESS && type == REG_SZ)
{
}
int
-__gnat_is_absolute_path (char *name)
+__gnat_is_absolute_path (char *name, int length)
{
- return (*name == '/' || *name == DIR_SEPARATOR
+ return (length != 0) &&
+ (*name == '/' || *name == DIR_SEPARATOR
#if defined (__EMX__) || defined (MSDOS) || defined (WINNT)
- || (strlen (name) > 1 && isalpha (name[0]) && name[1] == ':')
+ || (length > 1 && isalpha (name[0]) && name[1] == ':')
#endif
);
}
}
void
+__gnat_set_executable (char *name)
+{
+#ifndef __vxworks
+ struct stat statbuf;
+
+ if (stat (name, &statbuf) == 0)
+ {
+ statbuf.st_mode = statbuf.st_mode | S_IXUSR;
+ chmod (name, statbuf.st_mode);
+ }
+#endif
+}
+
+void
__gnat_set_readonly (char *name)
{
#ifndef __vxworks
#if defined (__vxworks)
return 0;
-#elif defined (_AIX) || defined (unix)
+#elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
int ret;
struct stat statbuf;
#endif
}
-#ifdef VMS
-/* Defined in VMS header files. */
-#if defined (__ALPHA)
-#define fork() (decc$$alloc_vfork_blocks() >= 0 ? \
- LIB$GET_CURRENT_INVO_CONTEXT (decc$$get_vfork_jmpbuf()) : -1)
-#elif defined (__IA64)
-#define fork() (decc$$alloc_vfork_blocks() >= 0 ? \
- LIB$I64_GET_CURR_INVO_CONTEXT(decc$$get_vfork_jmpbuf()) : -1)
-#endif
-#endif
-
#if defined (sun) && defined (__SVR4)
/* Using fork on Solaris will duplicate all the threads. fork1, which
duplicates only the active thread, must be used instead, or spawning
int pid ATTRIBUTE_UNUSED;
#if defined (MSDOS) || defined (_WIN32)
- status = spawnvp (P_WAIT, args[0],(const char* const*)args);
+ /* args[0] must be quotes as it could contain a full pathname with spaces */
+ char *args_0 = args[0];
+ args[0] = (char *)xmalloc (strlen (args_0) + 3);
+ strcpy (args[0], "\"");
+ strcat (args[0], args_0);
+ strcat (args[0], "\"");
+
+ status = spawnvp (P_WAIT, args_0, (const char* const*)args);
+
+ /* restore previous value */
+ free (args[0]);
+ args[0] = (char *)args_0;
+
if (status < 0)
return -1;
else
if (pid == 0)
{
/* The child. */
- if (execv (args[0], args) != 0)
+ if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
#if defined (VMS)
return -1; /* execv is in parent context on VMS. */
#else
return 0;
}
+/* Create a copy of the given file descriptor.
+ Return -1 if an error occurred. */
+
+int
+__gnat_dup (int oldfd)
+{
+#if defined (__vxworks)
+ /* Not supported on VxWorks. */
+ return -1;
+#else
+ return dup (oldfd);
+#endif
+}
+
+/* Make newfd be the copy of oldfd, closing newfd first if necessary.
+ Return -1 if an error occurred. */
+
+int
+__gnat_dup2 (int oldfd, int newfd)
+{
+#if defined (__vxworks)
+ /* Not supported on VxWorks. */
+ return -1;
+#else
+ return dup2 (oldfd, newfd);
+#endif
+}
+
/* WIN32 code to implement a wait call that wait for any child process. */
#ifdef _WIN32
k++;
}
- result = CreateProcess (NULL, (char *) full_command, &SA, NULL, TRUE,
- NORMAL_PRIORITY_CLASS, NULL, NULL, &SI, &PI);
+ result = CreateProcess
+ (NULL, (char *) full_command, &SA, NULL, TRUE,
+ GetPriorityClass (GetCurrentProcess()), NULL, NULL, &SI, &PI);
free (full_command);
if (pid == 0)
{
/* The child. */
- if (execv (args[0], args) != 0)
+ if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
#if defined (VMS)
return -1; /* execv is in parent context on VMS. */
#else
return pid;
}
-int
-__gnat_waitpid (int pid)
-{
- int status = 0;
-
-#if defined (_WIN32)
- cwait (&status, pid, _WAIT_CHILD);
-#elif defined (__EMX__) || defined (MSDOS) || defined (__vxworks)
- /* Status is already zero, so nothing to do. */
-#else
- waitpid (pid, &status, 0);
- status = WEXITSTATUS (status);
-#endif
-
- return status;
-}
-
void
__gnat_os_exit (int status)
{
__gnat_locate_regular_file (char *file_name, char *path_val)
{
char *ptr;
- int absolute = __gnat_is_absolute_path (file_name);
+ int absolute = __gnat_is_absolute_path (file_name, strlen (file_name));
/* Handle absolute pathnames. */
if (absolute)
}
/* Translate a VMS syntax file specification into Unix syntax.
- If no indicators of VMS syntax found, return input string. */
+ If no indicators of VMS syntax found, check if its an uppercase
+ alphanumeric_ name and if so try it out as an environment
+ variable (logical name). If all else fails return the
+ input string. */
char *
__gnat_to_canonical_file_spec (char *filespec)
{
+ char *filespec1;
+
strncpy (new_canonical_filespec, "", MAXPATH);
if (strchr (filespec, ']') || strchr (filespec, ':'))
{
strncpy (new_canonical_filespec,
- (char *) decc$translate_vms (filespec),
- MAXPATH);
+ (char *) decc$translate_vms (filespec), MAXPATH);
+ }
+ else if ((strlen (filespec) == strspn (filespec,
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"))
+ && (filespec1 = getenv (filespec)))
+ {
+ strncpy (new_canonical_filespec,
+ (char *) decc$translate_vms (filespec1), MAXPATH);
}
else
{
#if defined (CROSS_COMPILE) \
|| (! (defined (sparc) && defined (sun) && defined (__SVR4)) \
&& ! (defined (linux) && defined (i386)) \
- && ! defined (hpux) \
+ && ! defined (__FreeBSD__) \
+ && ! defined (__hpux__) \
+ && ! defined (__APPLE__) \
&& ! defined (_AIX) \
&& ! (defined (__alpha__) && defined (__osf__)) \
- && ! defined (__MINGW32__))
+ && ! defined (__MINGW32__) \
+ && ! (defined (__mips) && defined (__sgi)))
/* Dummy function to satisfy g-trasym.o. Currently Solaris sparc, HP/UX,
GNU/Linux x86, Tru64 & Windows provide a non-dummy version of this
/* 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
- Windows as it is already done by the mdll module. */
-#if defined (_WIN32)
+ 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
+ anymore as it uses the GCC's -shared option */
+#if defined (_WIN32) \
+ && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
int __gnat_prj_add_obj_files = 0;
#else
int __gnat_prj_add_obj_files = 1;
extern void __gnat_install_locks (void (*) (void), void (*) (void));
/* This function offers a hook for libgnarl to set the
- locking subprograms for libgcc_eh. */
+ locking subprograms for libgcc_eh.
+ This is only needed on OpenVMS, since other platforms use standard
+ --enable-threads=posix option, or similar. */
void
__gnatlib_install_locks (void (*lock) (void) ATTRIBUTE_UNUSED,
void (*unlock) (void) ATTRIBUTE_UNUSED)
{
-#ifdef IN_RTS
+#if defined (IN_RTS) && defined (VMS)
__gnat_install_locks (lock, unlock);
/* There is a bootstrap path issue if adaint is build with this
symbol unresolved for the stage1 compiler. Since the compiler
a no-op in this case. */
#endif
}
+
+int
+__gnat_lseek (int fd, long offset, int whence)
+{
+ return (int) lseek (fd, offset, whence);
+}
+
+/* This function returns the version of GCC being used. Here it's GCC 3. */
+int
+get_gcc_version (void)
+{
+ return 3;
+}
+
+int
+__gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED,
+ int close_on_exec_p ATTRIBUTE_UNUSED)
+{
+#if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
+ int flags = fcntl (fd, F_GETFD, 0);
+ if (flags < 0)
+ return flags;
+ if (close_on_exec_p)
+ flags |= FD_CLOEXEC;
+ else
+ flags &= ~FD_CLOEXEC;
+ return fcntl (fd, F_SETFD, flags | FD_CLOEXEC);
+#else
+ return -1;
+ /* For the Windows case, we should use SetHandleInformation to remove
+ the HANDLE_INHERIT property from fd. This is not implemented yet,
+ but for our purposes (support of GNAT.Expect) this does not matter,
+ as by default handles are *not* inherited. */
+#endif
+}