2006-02-13 Pascal Obry <obry@adacore.com>

	    Nicolas Roche  <roche@adacore.com>
	    Arnaud Charlet  <charlet@adacore.com>

	* adaint.h, adaint.c (DIR_SEPARATOR): Use _T() macro for Unicode
	support.
	(__gnat_try_lock): Add unicode support by using a specific section on
	Windows.
	(__gnat_get_current_dir): Idem.
	(__gnat_open_read): Idem.
	(__gnat_open_rw): Idem.
	(__gnat_open_create): Idem.
	(__gnat_create_output_file): Idem.
	(__gnat_open_append): Idem.
	(__gnat_open_new): Idem.
	(__gnat_file_time_name): Idem.
	(__gnat_set_file_time_name): Idem.
	(__gnat_stat): Idem.
	(win32_no_block_spawn): Idem.
	(__gnat_locate_exec_on_path): Idem.
	(__gnat_opendir): New routine.
	(__gnat_closedir): Idem.
	(__gnat_readdir): Add new parameter length (pointer to int). Update
	implementation to use it and add specific Win32 code for Unicode
	support.
	(__gnat_get_env_value_ptr): Remove. Replaced by __gnat_getenv in env.c
	(__gnat_set_env_value): Remove. Replaced by __gnat_setenv in env.c
	(convert_addresses): Do not define this dummy routine on VMS.

	* mingw32.h (GNAT_UNICODE_SUPPORT): New definition, if set the GNAT
	runtime Unicode support will be activated.
	(S2WS): String to Wide-String conversion. This version just copy a
	string in non Unicode version.
	(WS2S): Wide-String to String conversion. This version just copy a
	string in non Unicode version.

	* g-dirope.adb: (Close): Now import __gnat_closedir from adaint.c.
	(Open): Now import __gnat_opendir from adaint.c.
	(Read): Change the implementation to support unicode characters. It is
	not possible to use strlen() on Windows as this version supports only
	standard ASCII characters. So the length of the directory entry is now
	returned from the imported __gnat_readdir routine.
	Update copyright notice.

	* s-crtl-vms64.ads, s-crtl.ads: (closedir): Moved to adaint.c.
	(opendir): Moved to adaint.c.

	* g-os_lib.adb (Copy_Time_Stamp): Fix off-by-one range computation.
	(Get_Directory): Fix wrong indexing.
	(Getenv): replace __gnat_get_env_value_ptr from adaint.c by
	__gnat_getenv from env.c
	(Setenv): replace __gnat_set_env_value from adaint.c by __gnat_setenv
	from env.c

	* env.h, env.c: New file.

	* s-scaval.adb (Initialize): Replace __gnat_get_env_value_ptr from
	adaint.c by __gnat_getenv from env.c

	* s-shasto.adb (Initialize): replace __gnat_get_env_value_ptr from
	adaint.c by __gnat_getenv from env.c

	* Make-lang.in: Add env.o in the list of C object needed by gnat1
	and gnatbind.
	Update dependencies.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@111029 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 314 insertions, 0 deletions

diff --git a/gcc/ada/env.c b/gcc/ada/env.c
new file mode 100644
index 00000000000..039e09ced6e
--- /dev/null
+++ b/gcc/ada/env.c
@@ -0,0 +1,314 @@
+/****************************************************************************
+ *                                                                          *
+ *                         GNAT COMPILER COMPONENTS                         *
+ *                                                                          *
+ *                                  E N V                                   *
+ *                                                                          *
+ *                          C Implementation File                           *
+ *                                                                          *
+ *            Copyright (C) 2005-2006, Free Software Foundation, Inc.       *
+ *                                                                          *
+ * GNAT is free software;  you can  redistribute it  and/or modify it under *
+ * terms of the  GNU General Public License as published  by the Free Soft- *
+ * ware  Foundation;  either version 2,  or (at your option) any later ver- *
+ * sion.  GNAT is distributed in the hope that it will be useful, but WITH- *
+ * OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY *
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
+ * for  more details.  You should have  received  a copy of the GNU General *
+ * Public License  distributed with GNAT;  see file COPYING.  If not, write *
+ * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
+ * Boston, MA 02110-1301, USA.                                              *
+ *                                                                          *
+ * As a  special  exception,  if you  link  this file  with other  files to *
+ * produce an executable,  this file does not by itself cause the resulting *
+ * executable to be covered by the GNU General Public License. This except- *
+ * ion does not  however invalidate  any other reasons  why the  executable *
+ * file might be covered by the  GNU Public License.                        *
+ *                                                                          *
+ * GNAT was originally developed  by the GNAT team at  New York University. *
+ * Extensive contributions were provided by Ada Core Technologies Inc.      *
+ *                                                                          *
+ ****************************************************************************/
+
+#ifdef IN_RTS
+#include "tconfig.h"
+#include "tsystem.h"
+
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <time.h>
+#ifdef VMS
+#include <unixio.h>
+#endif
+
+#if defined (__APPLE__)
+#include <crt_externs.h>
+#endif
+
+#if defined (__MINGW32__)
+#include <stdlib.h>
+#endif
+
+#if defined (__vxworks) && ! (defined (__RTP__) || defined (__COREOS__))
+#include "envLib.h"
+extern char** ppGlobalEnviron;
+#endif
+
+/* We don't have libiberty, so use malloc.  */
+#define xmalloc(S) malloc (S)
+#else /* IN_RTS */
+#include "config.h"
+#include "system.h"
+#endif /* IN_RTS */
+
+#include "env.h"
+
+void
+__gnat_getenv (char *name, int *len, char **value)
+{
+  *value = getenv (name);
+  if (!*value)
+    *len = 0;
+  else
+    *len = strlen (*value);
+
+  return;
+}
+
+/* VMS specific declarations for set_env_value.  */
+
+#ifdef VMS
+
+static char *to_host_path_spec (char *);
+
+struct descriptor_s
+{
+  unsigned short len, mbz;
+  __char_ptr32 adr;
+};
+
+typedef struct _ile3
+{
+  unsigned short len, code;
+  __char_ptr32 adr;
+  unsigned short *retlen_adr;
+} ile_s;
+
+#endif
+
+void
+__gnat_setenv (char *name, char *value)
+{
+#ifdef MSDOS
+
+#elif defined (VMS)
+  struct descriptor_s name_desc;
+  /* Put in JOB table for now, so that the project stuff at least works.  */
+  struct descriptor_s table_desc = {7, 0, "LNM$JOB"};
+  char *host_pathspec = value;
+  char *copy_pathspec;
+  int num_dirs_in_pathspec = 1;
+  char *ptr;
+  long status;
+
+  name_desc.len = strlen (name);
+  name_desc.mbz = 0;
+  name_desc.adr = name;
+
+  if (*host_pathspec == 0)
+    /* deassign */
+    {
+      status = LIB$DELETE_LOGICAL (&name_desc, &table_desc);
+      /* no need to check status; if the logical name is not
+         defined, that's fine. */
+      return;
+    }
+
+  ptr = host_pathspec;
+  while (*ptr++)
+    if (*ptr == ',')
+      num_dirs_in_pathspec++;
+
+  {
+    int i, status;
+    ile_s *ile_array = alloca (sizeof (ile_s) * (num_dirs_in_pathspec + 1));
+    char *copy_pathspec = alloca (strlen (host_pathspec) + 1);
+    char *curr, *next;
+
+    strcpy (copy_pathspec, host_pathspec);
+    curr = copy_pathspec;
+    for (i = 0; i < num_dirs_in_pathspec; i++)
+      {
+	next = strchr (curr, ',');
+	if (next == 0)
+	  next = strchr (curr, 0);
+
+	*next = 0;
+	ile_array[i].len = strlen (curr);
+
+	/* Code 2 from lnmdef.h means it's a string.  */
+	ile_array[i].code = 2;
+	ile_array[i].adr = curr;
+
+	/* retlen_adr is ignored.  */
+	ile_array[i].retlen_adr = 0;
+	curr = next + 1;
+      }
+
+    /* Terminating item must be zero.  */
+    ile_array[i].len = 0;
+    ile_array[i].code = 0;
+    ile_array[i].adr = 0;
+    ile_array[i].retlen_adr = 0;
+
+    status = LIB$SET_LOGICAL (&name_desc, 0, &table_desc, 0, ile_array);
+    if ((status & 1) != 1)
+      LIB$SIGNAL (status);
+  }
+
+#elif defined (__vxworks) && defined (__RTP__)
+  setenv (name, value, 1);
+
+#else
+  int size = strlen (name) + strlen (value) + 2;
+  char *expression;
+
+  expression = (char *) xmalloc (size * sizeof (char));
+
+  sprintf (expression, "%s=%s", name, value);
+  putenv (expression);
+#if defined (__FreeBSD__) || defined (__APPLE__) || defined (__MINGW32__) \
+   ||(defined (__vxworks) && ! defined (__RTP__))
+  /* On some systems like FreeBSD, MacOS X and Windows, putenv is making
+     a copy of the expression string so we can free it after the call to
+     putenv */
+  free (expression);
+#endif
+#endif
+}
+
+char **
+__gnat_environ (void)
+{
+#if defined (VMS)
+  /* Not implemented */
+  return NULL;
+#elif defined (__APPLE__)
+  char ***result = _NSGetEnviron ();
+  return *result;
+#elif defined (__MINGW32__)
+  return _environ;
+#elif defined (sun)
+  extern char **_environ;
+  return _environ;
+#else
+#if ! (defined (__vxworks) && ! (defined (__RTP__) || defined (__COREOS__)))
+  /* in VxWorks kernel mode environ is macro and not a variable */
+  /* same thing on 653 in the CoreOS */
+  extern char **environ;
+#endif
+  return environ;
+#endif
+}
+
+void __gnat_unsetenv (char *name) {
+#if defined (VMS)
+  /* Not implemented */
+  return;
+#elif defined (__hpux__) || defined (sun) \
+     || (defined (__mips) && defined (__sgi)) \
+     || (defined (__vxworks) && ! defined (__RTP__)) \
+     || defined (_AIX)
+
+  /* On Solaris, HP-UX and IRIX there is no function to clear an environment
+     variable. So we look for the variable in the environ table and delete it
+     by setting the entry to NULL. This can clearly cause some memory leaks
+     but free cannot be used on this context as not all strings in the environ
+     have been allocated using malloc. To avoid this memory leak another
+     method can be used. It consists in forcing the reallocation of all the
+     strings in the environ table using malloc on the first call on the
+     functions related to environment variable management. The disavantage
+     is that if a program makes a direct call to getenv the return string
+     may be deallocated at some point. */
+  /* Note that on AIX, unsetenv is not supported on 5.1 but it is on 5.3.
+     As we are still supporting AIX 5.1 we cannot use unsetenv */
+  char **env = __gnat_environ ();
+  int index = 0;
+  int size = strlen (name);
+
+  while (env[index] != NULL) {
+     if (strlen (env[index]) > size) {
+       if (strstr (env[index], name) == env[index] &&
+	   env[index][size] == '=') {
+#if defined (__vxworks) && ! defined (__RTP__)
+         /* on Vxworks we are sure that the string has been allocated using
+            malloc */
+         free (env[index]);
+#endif
+         while (env[index] != NULL) {
+          env[index]=env[index + 1];
+          index++;
+         }
+       } else
+           index++;
+     } else
+         index++;
+  }
+#elif defined (__MINGW32__)
+  /* On Windows platform putenv ("key=") is equivalent to unsetenv (a
+     subsequent call to getenv ("key") will return NULL and not the "\0"
+     string */
+  int size = strlen (name) + 2;
+  char *expression;
+  expression = (char *) xmalloc (size * sizeof (char));
+
+  sprintf (expression, "%s=", name);
+  putenv (expression);
+  free (expression);
+#else
+  unsetenv (name);
+#endif
+}
+
+void __gnat_clearenv (void) {
+#if defined (VMS)
+  /* not implemented */
+  return;
+#elif defined (sun) || (defined (__mips) && defined (__sgi)) \
+   || (defined (__vxworks) && ! defined (__RTP__)) || defined (__Lynx__)
+  /* On Solaris, IRIX, VxWorks (not RTPs), and Lynx there is no system
+     call to unset a variable or to clear the environment so set all
+     the entries in the environ table to NULL (see comment in
+     __gnat_unsetenv for more explanation). */
+  char **env = __gnat_environ ();
+  int index = 0;
+
+  while (env[index] != NULL) {
+    env[index]=NULL;
+    index++;
+  }
+#elif defined (__MINGW32__) || defined (__FreeBSD__) || defined (__APPLE__) \
+   || (defined (__vxworks) && defined (__RTP__))
+  /* On Windows, FreeBSD and MacOS there is no function to clean all the
+     environment but there is a "clean" way to unset a variable. So go
+     through the environ table and call __gnat_unsetenv on all entries */
+  char **env = __gnat_environ ();
+  int size;
+
+  while (env[0] != NULL) {
+    size = 0;
+    while (env[0][size] != '=')
+      size++;
+    /* create a string that contains "name" */
+    size++;
+    {
+      char expression[size];
+      strncpy (expression, env[0], size);
+      expression[size - 1] = 0;
+      __gnat_unsetenv (expression);
+    }
+  }
+#else
+  clearenv ();
+#endif
+}