adaint.h, adaint.c (DIR_SEPARATOR): Use _T() macro for Unicode support.

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.

From-SVN: r111029

gcc/ada/adaint.h

@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *          Copyright (C) 1992-2005, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-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- *
@@ -30,7 +30,13 @@
  *                                                                          *
  ****************************************************************************/
 
+#include <sys/stat.h>
 #include <stdio.h>
+
+#ifdef _WIN32
+#include "mingw32.h"
+#endif
+
 #include <dirent.h>
 
 typedef long OS_Time; /* Type corresponding to GNAT.OS_Lib.OS_Time */
@@ -68,7 +74,9 @@ extern int    __gnat_open_append                   (char *, int);
 extern long   __gnat_file_length                   (int);
 extern long   __gnat_named_file_length             (char *);
 extern void   __gnat_tmp_name			   (char *);
-extern char  *__gnat_readdir                       (DIR *, char *);
+extern DIR   *__gnat_opendir                       (char *);
+extern char  *__gnat_readdir                       (DIR *, char *, int *);
+extern int    __gnat_closedir                      (DIR *);
 extern int    __gnat_readdir_is_thread_safe        (void);
 
 extern OS_Time __gnat_file_time_name                (char *);
@@ -76,8 +84,7 @@ extern OS_Time __gnat_file_time_fd                  (int);
 /* return -1 in case of error */
 
 extern void   __gnat_set_file_time_name		   (char *, time_t);
-extern void   __gnat_get_env_value_ptr             (char *, int *,
-						    char **);
+
 extern int    __gnat_dup			   (int);
 extern int    __gnat_dup2			   (int, int);
 extern int    __gnat_file_exists		   (char *);
@@ -98,7 +105,6 @@ extern char  *__gnat_locate_exec_on_path	   (char *);
 extern char  *__gnat_locate_regular_file           (char *, char *);
 extern void   __gnat_maybe_glob_args               (int *, char ***);
 extern void   __gnat_os_exit			   (int);
-extern void   __gnat_set_env_value		   (char *, char *);
 extern char  *__gnat_get_libraries_from_registry   (void);
 extern int    __gnat_to_canonical_file_list_init   (char *, int);
 extern char  *__gnat_to_canonical_file_list_next   (void);

gcc/ada/env.c

+/****************************************************************************
+ *                                                                          *
+ *                         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
+}

gcc/ada/env.h

+extern void __gnat_getenv (char *name, int *len, char **value);
+extern void __gnat_setenv (char *name, char *value);
+extern char **__gnat_environ (void);
+extern void __gnat_unsetenv (char *name);
+extern void __gnat_clearenv (void);
+

gcc/ada/g-dirope.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 1998-2005, AdaCore                     --
+--                     Copyright (C) 1998-2006, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -33,7 +33,6 @@
 
 with Ada.Characters.Handling;
 with Ada.Strings.Fixed;
-with Ada.Strings.Maps;
 
 with Unchecked_Deallocation;
 with Unchecked_Conversion;
@@ -187,6 +186,9 @@ package body GNAT.Directory_Operations is
       Discard : Integer;
       pragma Warnings (Off, Discard);
 
+      function closedir (directory : DIRs) return Integer;
+      pragma Import (C, closedir, "__gnat_closedir");
+
    begin
       if not Is_Open (Dir) then
          raise Directory_Error;
@@ -625,6 +627,9 @@ package body GNAT.Directory_Operations is
      (Dir      : out Dir_Type;
       Dir_Name : Dir_Name_Str)
    is
+      function opendir (file_name : String) return DIRs;
+      pragma Import (C, opendir, "__gnat_opendir");
+
       C_File_Name : constant String := Dir_Name & ASCII.NUL;
 
    begin
@@ -647,7 +652,7 @@ package body GNAT.Directory_Operations is
       Last : out Natural)
    is
       Filename_Addr : Address;
-      Filename_Len  : Integer;
+      Filename_Len  : aliased Integer;
 
       Buffer : array (0 .. Filename_Max + 12) of Character;
       --  12 is the size of the dirent structure (see dirent.h), without the
@@ -655,27 +660,24 @@ package body GNAT.Directory_Operations is
 
       function readdir_gnat
         (Directory : System.Address;
-         Buffer    : System.Address) return System.Address;
+         Buffer    : System.Address;
+         Last      : access Integer) return System.Address;
       pragma Import (C, readdir_gnat, "__gnat_readdir");
 
-      function strlen (S : Address) return Integer;
-      pragma Import (C, strlen, "strlen");
-
    begin
       if not Is_Open (Dir) then
          raise Directory_Error;
       end if;
 
       Filename_Addr :=
-        readdir_gnat (System.Address (Dir.all), Buffer'Address);
+        readdir_gnat
+          (System.Address (Dir.all), Buffer'Address, Filename_Len'Access);
 
       if Filename_Addr = System.Null_Address then
          Last := 0;
          return;
       end if;
 
-      Filename_Len  := strlen (Filename_Addr);
-
       if Str'Length > Filename_Len then
          Last := Str'First + Filename_Len - 1;
       else

gcc/ada/g-os_lib.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 1995-2005, AdaCore                     --
+--                     Copyright (C) 1995-2006, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -609,11 +609,11 @@ package body GNAT.OS_Lib is
             C_Source : String (1 .. Source'Length + 1);
             C_Dest   : String (1 .. Dest'Length + 1);
          begin
-            C_Source (1 .. C_Source'Length) := Source;
-            C_Source (C_Source'Last)        := ASCII.Nul;
+            C_Source (1 .. Source'Length) := Source;
+            C_Source (C_Source'Last)      := ASCII.NUL;
 
-            C_Dest (1 .. C_Dest'Length) := Dest;
-            C_Dest (C_Dest'Last)        := ASCII.Nul;
+            C_Dest (1 .. Dest'Length) := Dest;
+            C_Dest (C_Dest'Last)      := ASCII.NUL;
 
             if Copy_Attributes (C_Source'Address, C_Dest'Address, 0) = -1 then
                Success := False;
@@ -1057,7 +1057,7 @@ package body GNAT.OS_Lib is
 
    function Getenv (Name : String) return String_Access is
       procedure Get_Env_Value_Ptr (Name, Length, Ptr : Address);
-      pragma Import (C, Get_Env_Value_Ptr, "__gnat_get_env_value_ptr");
+      pragma Import (C, Get_Env_Value_Ptr, "__gnat_getenv");
 
       procedure Strncpy (Astring_Addr, Cstring : Address; N : Integer);
       pragma Import (C, Strncpy, "strncpy");
@@ -1702,12 +1702,11 @@ package body GNAT.OS_Lib is
          --  Directory given, add directory separator if needed
 
          if Dir'Length > 0 then
-            if Dir (Dir'Length) = Directory_Separator then
+            if Dir (Dir'Last) = Directory_Separator then
                return Directory;
             else
                declare
                   Result : String (1 .. Dir'Length + 1);
-
                begin
                   Result (1 .. Dir'Length) := Dir;
                   Result (Result'Length) := Directory_Separator;
@@ -2313,7 +2312,7 @@ package body GNAT.OS_Lib is
       F_Value : String (1 .. Value'Length + 1);
 
       procedure Set_Env_Value (Name, Value : System.Address);
-      pragma Import (C, Set_Env_Value, "__gnat_set_env_value");
+      pragma Import (C, Set_Env_Value, "__gnat_setenv");
 
    begin
       F_Name (1 .. Name'Length) := Name;

gcc/ada/mingw32.h

@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *          Copyright (C) 2002-2004, Free Software Foundation, Inc.         *
+ *          Copyright (C) 2002-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- *
@@ -36,6 +36,35 @@
 #ifndef _MINGW32_H
 #define _MINGW32_H
 
+
+
+/* Uncomment to activate the GNAT Unicode support. */
+/*#define GNAT_UNICODE_SUPPORT */
+
+#ifdef GNAT_UNICODE_SUPPORT
+#define _UNICODE /* For C runtime */
+#define UNICODE  /* For Win32 API */
+#endif
+
+#include <tchar.h>
+
+/* After including this file it is possible to use the character t as prefix
+   to routines. If GNAT_UNICODE_SUPPORT is defined then the unicode enabled
+   versions will be used. */
+
+/* Copy to/from wide-string, if GNAT_UNICODE_SUPPORT activated this will do
+   the proper translations using the UTF-8 encoding.  */
+
+#ifdef GNAT_UNICODE_SUPPORT
+#define S2WS(wstr,str,len) \
+   MultiByteToWideChar (CP_UTF8,0,str,-1,wstr,len);
+#define WS2S(str,wstr,len) \
+   WideCharToMultiByte (CP_UTF8,0,wstr,-1,str,len,NULL,NULL);
+#else
+#define S2WS(wstr,str,len) strncpy(wstr,str,len);
+#define WS2S(str,wstr,len) strncpy(str,wstr,len);
+#endif
+
 #include <stdlib.h>
 
 /* STD_MINGW: standard if MINGW32 version > 1.3, we have switched to this

gcc/ada/s-crtl-vms64.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                S p e c                                   --
 --                                                                          --
---         Copyright (C) 2004-2005 Free Software Foundation, Inc.           --
+--         Copyright (C) 2004-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- --
@@ -63,9 +63,6 @@ package System.CRTL is
    procedure clearerr (stream : FILEs);
    pragma Import (C, clearerr, "decc$clearerr");
 
-   function closedir (directory : DIRs) return Integer;
-   pragma Import (C, closedir, "decc$closedir");
-
    function dup  (handle : int) return int;
    pragma Import (C, dup, "decc$dup");
 
@@ -137,9 +134,6 @@ package System.CRTL is
    procedure mktemp (template : chars);
    pragma Import (C, mktemp, "decc$_mktemp64");
 
-   function opendir (file_name : String) return DIRs;
-   pragma Import (C, opendir, "decc$opendir");
-
    function pclose (stream : System.Address) return int;
    pragma Import (C, pclose, "decc$pclose");
 

gcc/ada/s-crtl.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2003-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2003-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- --
@@ -63,9 +63,6 @@ package System.CRTL is
    procedure clearerr (stream : FILEs);
    pragma Import (C, clearerr, "clearerr");
 
-   function closedir (directory : DIRs) return Integer;
-   pragma Import (C, closedir, "closedir");
-
    function dup  (handle : int) return int;
    pragma Import (C, dup, "dup");
 
@@ -137,9 +134,6 @@ package System.CRTL is
    procedure mktemp (template : chars);
    pragma Import (C, mktemp, "mktemp");
 
-   function opendir (file_name : String) return DIRs;
-   pragma Import (C, opendir, "opendir");
-
    function pclose (stream : System.Address) return int;
    pragma Import (C, pclose, "pclose");
 

gcc/ada/s-scaval.adb

@@ -44,7 +44,7 @@ package body System.Scalar_Values is
       C2 : Character := Mode2;
 
       procedure Get_Env_Value_Ptr (Name, Length, Ptr : Address);
-      pragma Import (C, Get_Env_Value_Ptr, "__gnat_get_env_value_ptr");
+      pragma Import (C, Get_Env_Value_Ptr, "__gnat_getenv");
 
       subtype String2 is String (1 .. 2);
       type String2_Ptr is access all String2;

gcc/ada/s-shasto.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1998-2002 Free Software Foundation, Inc.          --
+--          Copyright (C) 1998-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- --
@@ -34,7 +34,6 @@
 with Ada.Exceptions;
 with Ada.IO_Exceptions;
 with Ada.Streams;
-with Ada.Streams.Stream_IO;
 
 with System.Global_Locks;
 with System.Soft_Links;
@@ -86,7 +85,7 @@ package body System.Shared_Storage is
 
    procedure Write
      (Stream : in out File_Stream_Type;
-      Item   : in AS.Stream_Element_Array);
+      Item   : AS.Stream_Element_Array);
 
    subtype Hash_Header is Natural range 0 .. 30;
    --  Number of hash headers, related (for efficiency purposes only)
@@ -249,7 +248,7 @@ package body System.Shared_Storage is
 
    procedure Initialize is
       procedure Get_Env_Value_Ptr (Name, Length, Ptr : Address);
-      pragma Import (C, Get_Env_Value_Ptr, "__gnat_get_env_value_ptr");
+      pragma Import (C, Get_Env_Value_Ptr, "__gnat_getenv");
 
       procedure Strncpy (Astring_Addr, Cstring : Address; N : Integer);
       pragma Import (C, Strncpy, "strncpy");
@@ -331,7 +330,7 @@ package body System.Shared_Storage is
    -- Shared_Var_Close --
    ----------------------
 
-   procedure Shared_Var_Close (Var : in SIO.Stream_Access) is
+   procedure Shared_Var_Close (Var : SIO.Stream_Access) is
       pragma Warnings (Off, Var);
 
    begin
@@ -342,7 +341,7 @@ package body System.Shared_Storage is
    -- Shared_Var_Lock --
    ---------------------
 
-   procedure Shared_Var_Lock (Var : in String) is
+   procedure Shared_Var_Lock (Var : String) is
       pragma Warnings (Off, Var);
 
    begin
@@ -429,7 +428,7 @@ package body System.Shared_Storage is
    -- Shared_Var_Unlock --
    -----------------------
 
-   procedure Shared_Var_Unlock (Var : in String) is
+   procedure Shared_Var_Unlock (Var : String) is
       pragma Warnings (Off, Var);
 
    begin
@@ -522,7 +521,7 @@ package body System.Shared_Storage is
 
    procedure Write
      (Stream : in out File_Stream_Type;
-      Item   : in AS.Stream_Element_Array)
+      Item   : AS.Stream_Element_Array)
    is
    begin
       SIO.Write (Stream.File, Item);