adaint.c:

2007-04-06  Olivier Hainque  <hainque@adacore.com>

	* adaint.c: 
	(convert_addresses): Adjust prototype and dummy definition to expect an
	 extra file_name argument.

	* gmem.c (__gnat_convert_addresses): Wrapper to convert_addresses,
	filling the now expected file_name argument with the appropriate
	argv[0] expansion.
	(__gnat_gmem_a2l_initialize, __gnat_gmem_read_next_frame): Use it.
	(tracebk): Array of void * instead of char *, corresponding to what
	 convert_addresses expects.
	(exename): New static global, to hold the executable file name to be
	used in all convert_addresses invocations.
	(gmem_read_backtrace, __gnat_gmem_symbolic): Account for tracebk type
	change.
	(__gnat_gmem_a2l_initialize): Resolve exename.
	(__gnat_convert_addresses): Use exename as the convert_addresses
	file_name argument.

	* g-trasym.adb (Symbolic_Traceback): Adjust signature of imported
	"convert_addresses", now expecting a filename argument. Import the
	necessary entities to compute the filename to use and pass it to
	convert_addresses.

From-SVN: r123544

gcc/ada/adaint.c

@@ -324,6 +324,14 @@ to_ptr32 (char **ptr64)
 #define MAYBE_TO_PTR32(argv) argv
 #endif
 
+OS_Time
+__gnat_current_time
+  (void)
+{
+  time_t res = time (NULL);
+  return (OS_Time) res;
+}
+
 void
 __gnat_to_gm_time
   (OS_Time *p_time,
@@ -418,8 +426,8 @@ __gnat_try_lock (char *dir, char *file)
   TCHAR wfile[GNAT_MAX_PATH_LEN];
   TCHAR wdir[GNAT_MAX_PATH_LEN];
 
-  S2WS (wdir, dir, GNAT_MAX_PATH_LEN);
-  S2WS (wfile, file, GNAT_MAX_PATH_LEN);
+  S2WSU (wdir, dir, GNAT_MAX_PATH_LEN);
+  S2WSU (wfile, file, GNAT_MAX_PATH_LEN);
 
   _stprintf (wfull_path, _T("%s%c%s"), wdir, _T(DIR_SEPARATOR), wfile);
   fd = _topen (wfull_path, O_CREAT | O_EXCL, 0600);
@@ -542,7 +550,7 @@ __gnat_get_current_dir (char *dir, int *length)
 
   _tgetcwd (wdir, *length);
 
-  WS2S (dir, wdir, GNAT_MAX_PATH_LEN);
+  WS2SU (dir, wdir, GNAT_MAX_PATH_LEN);
 
 #elif defined (VMS)
    /* Force Unix style, which is what GNAT uses internally.  */
@@ -612,31 +620,44 @@ __gnat_get_debuggable_suffix_ptr (int *len, const char **value)
 }
 
 FILE *
-__gnat_fopen (char *path, char *mode)
+__gnat_fopen (char *path, char *mode, int encoding)
 {
 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE)
   TCHAR wpath[GNAT_MAX_PATH_LEN];
   TCHAR wmode[10];
 
-  S2WS (wpath, path, GNAT_MAX_PATH_LEN);
   S2WS (wmode, mode, 10);
+
+  if (encoding == Encoding_UTF8)
+    S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
+  else
+    S2WS (wpath, path, GNAT_MAX_PATH_LEN);
+
   return _tfopen (wpath, wmode);
+#elif defined (VMS)
+  return decc$fopen (path, mode);
 #else
   return fopen (path, mode);
 #endif
 }
 
-
 FILE *
-__gnat_freopen (char *path, char *mode, FILE *stream)
+__gnat_freopen (char *path, char *mode, FILE *stream, int encoding)
 {
 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE)
   TCHAR wpath[GNAT_MAX_PATH_LEN];
   TCHAR wmode[10];
 
-  S2WS (wpath, path, GNAT_MAX_PATH_LEN);
   S2WS (wmode, mode, 10);
+
+  if (encoding == Encoding_UTF8)
+    S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
+  else
+    S2WS (wpath, path, GNAT_MAX_PATH_LEN);
+
   return _tfreopen (wpath, wmode, stream);
+#elif defined (VMS)
+  return decc$freopen (path, mode, stream);
 #else
   return freopen (path, mode, stream);
 #endif
@@ -661,7 +682,7 @@ __gnat_open_read (char *path, int fmode)
  {
    TCHAR wpath[GNAT_MAX_PATH_LEN];
 
-   S2WS (wpath, path, GNAT_MAX_PATH_LEN);
+   S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
    fd = _topen (wpath, O_RDONLY | o_fmode, 0444);
  }
 #else
@@ -702,7 +723,7 @@ __gnat_open_rw (char *path, int fmode)
   {
     TCHAR wpath[GNAT_MAX_PATH_LEN];
 
-    S2WS (wpath, path, GNAT_MAX_PATH_LEN);
+    S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
     fd = _topen (wpath, O_RDWR | o_fmode, PERM);
   }
 #else
@@ -728,7 +749,7 @@ __gnat_open_create (char *path, int fmode)
   {
     TCHAR wpath[GNAT_MAX_PATH_LEN];
 
-    S2WS (wpath, path, GNAT_MAX_PATH_LEN);
+    S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
     fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM);
   }
 #else
@@ -750,7 +771,7 @@ __gnat_create_output_file (char *path)
   {
     TCHAR wpath[GNAT_MAX_PATH_LEN];
 
-    S2WS (wpath, path, GNAT_MAX_PATH_LEN);
+    S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
     fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM);
   }
 #else
@@ -776,7 +797,7 @@ __gnat_open_append (char *path, int fmode)
   {
     TCHAR wpath[GNAT_MAX_PATH_LEN];
 
-    S2WS (wpath, path, GNAT_MAX_PATH_LEN);
+    S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
     fd = _topen (wpath, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM);
   }
 #else
@@ -804,7 +825,7 @@ __gnat_open_new (char *path, int fmode)
   {
     TCHAR wpath[GNAT_MAX_PATH_LEN];
 
-    S2WS (wpath, path, GNAT_MAX_PATH_LEN);
+    S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
     fd = _topen (wpath, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
   }
 #else
@@ -940,7 +961,7 @@ DIR* __gnat_opendir (char *name)
 #ifdef __MINGW32__
   TCHAR wname[GNAT_MAX_PATH_LEN];
 
-  S2WS (wname, name, GNAT_MAX_PATH_LEN);
+  S2WSU (wname, name, GNAT_MAX_PATH_LEN);
   return (DIR*)_topendir (wname);
 
 #else
@@ -959,7 +980,7 @@ __gnat_readdir (DIR *dirp, char *buffer, int *len)
 
   if (dirent != NULL)
     {
-      WS2S (buffer, dirent->d_name, GNAT_MAX_PATH_LEN);
+      WS2SU (buffer, dirent->d_name, GNAT_MAX_PATH_LEN);
       *len = strlen (buffer);
 
       return buffer;
@@ -1058,7 +1079,7 @@ __gnat_file_time_name (char *name)
   time_t ret = -1;
   TCHAR wname[GNAT_MAX_PATH_LEN];
 
-  S2WS (wname, name, GNAT_MAX_PATH_LEN);
+  S2WSU (wname, name, GNAT_MAX_PATH_LEN);
 
   HANDLE h = CreateFile
     (wname, GENERIC_READ, FILE_SHARE_READ, 0,
@@ -1195,7 +1216,7 @@ __gnat_set_file_time_name (char *name, time_t time_stamp)
   } t_write;
   TCHAR wname[GNAT_MAX_PATH_LEN];
 
-  S2WS (wname, name, GNAT_MAX_PATH_LEN);
+  S2WSU (wname, name, GNAT_MAX_PATH_LEN);
 
   HANDLE h  = CreateFile
     (wname, GENERIC_WRITE, FILE_SHARE_WRITE, NULL,
@@ -1462,7 +1483,7 @@ __gnat_stat (char *name, struct stat *statbuf)
   int name_len;
   TCHAR last_char;
 
-  S2WS (wname, name, GNAT_MAX_PATH_LEN + 2);
+  S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2);
   name_len = _tcslen (wname);
 
   if (name_len > GNAT_MAX_PATH_LEN)
@@ -1854,7 +1875,7 @@ win32_no_block_spawn (char *command, char *args[])
     int wsize = csize * 2;
     TCHAR *wcommand = (TCHAR *) xmalloc (wsize);
 
-    S2WS (wcommand, full_command, wsize);
+    S2WSU (wcommand, full_command, wsize);
 
     free (full_command);
 
@@ -2145,7 +2166,7 @@ __gnat_locate_exec_on_path (char *exec_name)
 
   apath_val = alloca (EXPAND_BUFFER_SIZE);
 
-  WS2S (apath_val, wapath_val, EXPAND_BUFFER_SIZE);
+  WS2SU (apath_val, wapath_val, EXPAND_BUFFER_SIZE);
   return __gnat_locate_exec (exec_name, apath_val);
 
 #else
@@ -2623,7 +2644,8 @@ _flush_cache()
    version of this procedure in libaddr2line.a.  */
 
 void
-convert_addresses (void *addrs ATTRIBUTE_UNUSED,
+convert_addresses (const char *file_name ATTRIBUTE_UNUSED,
+		   void *addrs ATTRIBUTE_UNUSED,
 		   int n_addr ATTRIBUTE_UNUSED,
 		   void *buf ATTRIBUTE_UNUSED,
 		   int *len ATTRIBUTE_UNUSED)

gcc/ada/g-trasym.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 1999-2005, AdaCore                     --
+--                     Copyright (C) 1999-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- --
@@ -44,38 +44,104 @@ package body GNAT.Traceback.Symbolic is
 
    package TSL renames System.Soft_Links;
 
+   --  To perform the raw addresses to symbolic form translation we rely on a
+   --  libaddr2line symbolizer which examines debug info from a provided
+   --  executable file name, and an absolute path is needed to ensure the file
+   --  is always found. This is "__gnat_locate_exec_on_path (gnat_argv [0])"
+   --  for our executable file, a fairly heavy operation so we cache the
+   --  result.
+
+   Exename : System.Address;
+   --  Pointer to the name of the executable file to be used on all
+   --  invocations of the libaddr2line symbolization service.
+
+   Exename_Resolved : Boolean := False;
+   --  Flag to indicate whether we have performed the executable file name
+   --  resolution already. Relying on a not null Exename for this purpose
+   --  would be potentially inefficient as this is what we will get if the
+   --  resolution attempt fails.
+
    ------------------------
    -- Symbolic_Traceback --
    ------------------------
 
    function Symbolic_Traceback (Traceback : Tracebacks_Array) return String is
+
       procedure convert_addresses
-        (addrs  : System.Address;
-         n_addr : Integer;
-         buf    : System.Address;
-         len    : System.Address);
+        (filename : System.Address;
+         addrs    : System.Address;
+         n_addrs  : Integer;
+         buf      : System.Address;
+         len      : System.Address);
       pragma Import (C, convert_addresses, "convert_addresses");
-      --  This is the procedure version of the Ada aware addr2line that will
-      --  use argv[0] as the executable containing the debug information.
+      --  This is the procedure version of the Ada aware addr2line.  It places
+      --  in BUF a string representing the symbolic translation of the N_ADDRS
+      --  raw addresses provided in ADDRS, looked up in debug information from
+      --  FILENAME.  LEN is filled with the result length.
+      --
       --  This procedure is provided by libaddr2line on targets that support
-      --  it. A dummy version is in a-adaint.c for other targets so that build
+      --  it. A dummy version is in adaint.c for other targets so that build
       --  of shared libraries doesn't generate unresolved symbols.
       --
       --  Note that this procedure is *not* thread-safe.
 
+      type Argv_Array is array (0 .. 0) of System.Address;
+      gnat_argv : access Argv_Array;
+      pragma Import (C, gnat_argv, "gnat_argv");
+
+      function locate_exec_on_path
+        (c_exename : System.Address) return System.Address;
+      pragma Import (C, locate_exec_on_path, "__gnat_locate_exec_on_path");
+
       Res : String (1 .. 256 * Traceback'Length);
       Len : Integer;
 
+      use type System.Address;
+
    begin
-      if Traceback'Length > 0 then
-         TSL.Lock_Task.all;
+      --  The symbolic translation of an empty set of addresses is the
+      --  the empty string.
+
+      if Traceback'Length <= 0 then
+         return "";
+      end if;
+
+      --  If our input set of raw addresses is not empty, resort to the
+      --  libaddr2line service to symbolize it all.
+
+      --  Compute, cache and provide the absolute path to our executable file
+      --  name as the binary file where the relevant debug information is to
+      --  be found. If the executable file name resolution fails, we have no
+      --  sensible basis to invoke the symbolizer at all.
+
+      --  Protect all this against concurrent accesses explicitely, as the
+      --  underlying services are potentially thread unsafe.
+
+      TSL.Lock_Task.all;
+
+      if not Exename_Resolved then
+         Exename := locate_exec_on_path (gnat_argv (0));
+         Exename_Resolved := True;
+      end if;
+
+      if Exename /= System.Null_Address then
          convert_addresses
-           (Traceback'Address, Traceback'Length, Res (1)'Address, Len'Address);
-         TSL.Unlock_Task.all;
+           (Exename, Traceback'Address, Traceback'Length,
+            Res (1)'Address, Len'Address);
+      end if;
+
+      TSL.Unlock_Task.all;
+
+      --  Return what the addr2line symbolizer has produced if we have called
+      --  it (the executable name resolution succeeded), or an empty string
+      --  otherwise.
+
+      if Exename /= System.Null_Address then
          return Res (1 .. Len);
       else
          return "";
       end if;
+
    end Symbolic_Traceback;
 
    function Symbolic_Traceback (E : Exception_Occurrence) return String is

gcc/ada/gmem.c

@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *         Copyright (C) 2000-2003 Free Software Foundation, Inc.           *
+ *         Copyright (C) 2000-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- *
@@ -54,7 +54,7 @@ static FILE *gmemfile;
 
 /* tb_len is the number of call level supported by this module */
 #define tb_len 200
-static char * tracebk [tb_len];
+static void * tracebk [tb_len];
 static int cur_tb_len, cur_tb_pos;
 
 #define LOG_EOF   '*'
@@ -67,8 +67,34 @@ struct struct_storage_elmt {
   size_t Size;
 };
 
-extern void
-convert_addresses (char *addrs[], int n_addr, void *buf, int *len);
+static void
+__gnat_convert_addresses (void *addrs[], int n_addrs, void *buf, int *len);
+/* Place in BUF a string representing the symbolic translation of N_ADDRS raw
+   addresses provided in ADDRS.  LEN is filled with the result length.
+
+   This is a GNAT specific interface to the libaddr2line convert_addresses
+   routine.  The latter examines debug info from a provided executable file
+   name to perform the translation into symbolic form of an input sequence of
+   raw binary addresses.  It attempts to open the file from the provided name
+   "as is", so an an absolute path must be provided to ensure the file is
+   always found.  We compute this name once, at initialization time.  */
+
+static const char * exename = 0;
+
+extern void convert_addresses (const char * , void *[], int, void *, int *);
+extern char  *__gnat_locate_exec_on_path (char *);
+/* ??? Both of these extern functions are prototyped in adaint.h, which
+   also refers to "time_t" hence needs complex extra header inclusions to
+   be satisfied on every target.  */
+
+static void
+__gnat_convert_addresses (void *addrs[], int n_addrs, void *buf, int *len)
+{
+  if (exename != 0)
+    convert_addresses (exename, addrs, n_addrs, buf, len);
+  else
+    *len = 0;
+}
 
 /* reads backtrace information from gmemfile placing them in tracebk
    array. cur_tb_len is the size of this array
@@ -78,7 +104,7 @@ static void
 gmem_read_backtrace (void)
 {
   fread (&cur_tb_len, sizeof (int), 1, gmemfile);
-  fread (tracebk, sizeof (char *), cur_tb_len, gmemfile);
+  fread (tracebk, sizeof (void *), cur_tb_len, gmemfile);
   cur_tb_pos = 0;
 }
 
@@ -106,14 +132,11 @@ int __gnat_gmem_initialize (char *dumpname)
 
 /* initialize addr2line library */
 
-void __gnat_gmem_a2l_initialize (char *exename)
+void __gnat_gmem_a2l_initialize (char *exearg)
 {
-  extern char **gnat_argv;
-  char s [100];
-  int l;
-
-  gnat_argv [0] = exename;
-  convert_addresses (tracebk, 1, s, &l);
+  /* Resolve the executable filename to use in later invocations of
+     the libaddr2line symbolization service.  */
+  exename = __gnat_locate_exec_on_path (exearg);
 }
 
 /* Read next allocation of deallocation information from the GMEM file and
@@ -172,8 +195,7 @@ void __gnat_gmem_read_next_frame (void** addr)
 
 void __gnat_gmem_symbolic (void * addr, char* buf, int* length)
 {
-  char* addresses [] = { (char*)addr };
-  extern char** gnat_argv;
+  void * addresses [] = { addr };
 
-  convert_addresses (addresses, 1, buf, length);
+  __gnat_convert_addresses (addresses, 1, buf, length);
 }