1/****************************************************************************
2 *                                                                          *
3 *                         GNAT COMPILER COMPONENTS                         *
4 *                                                                          *
5 *                            A D A D E C O D E                             *
6 *                                                                          *
7 *                          C Implementation File                           *
8 *                                                                          *
9 *           Copyright (C) 2001-2015, Free Software Foundation, Inc.        *
10 *                                                                          *
11 * GNAT is free software;  you can  redistribute it  and/or modify it under *
12 * terms of the  GNU General Public License as published  by the Free Soft- *
13 * ware  Foundation;  either version 3,  or (at your option) any later ver- *
14 * sion.  GNAT is distributed in the hope that it will be useful, but WITH- *
15 * OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY *
16 * or FITNESS FOR A PARTICULAR PURPOSE.                                     *
17 *                                                                          *
18 * As a special exception under Section 7 of GPL version 3, you are granted *
19 * additional permissions described in the GCC Runtime Library Exception,   *
20 * version 3.1, as published by the Free Software Foundation.               *
21 *                                                                          *
22 * You should have received a copy of the GNU General Public License and    *
23 * a copy of the GCC Runtime Library Exception along with this program;     *
24 * see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    *
25 * <http://www.gnu.org/licenses/>.                                          *
26 *                                                                          *
27 * GNAT was originally developed  by the GNAT team at  New York University. *
28 * Extensive contributions were provided by Ada Core Technologies Inc.      *
29 *                                                                          *
30 ****************************************************************************/
31
32
33#if defined(IN_RTS)
34#include "tconfig.h"
35#include "tsystem.h"
36#elif defined(IN_GCC)
37#include "config.h"
38#include "system.h"
39#endif
40
41#include <string.h>
42#include <stdio.h>
43#include <ctype.h>
44
45#include "adaint.h"  /* for a macro version of xstrdup.  */
46
47#ifndef ISDIGIT
48#define ISDIGIT(c) isdigit(c)
49#endif
50
51#ifndef PARMS
52#define PARMS(ARGS) ARGS
53#endif
54
55#include "adadecode.h"
56
57static void add_verbose (const char *, char *);
58static int has_prefix (const char *, const char *);
59static int has_suffix (const char *, const char *);
60
61/* This is a safe version of strcpy that can be used with overlapped
62   pointers. Does nothing if s2 <= s1.  */
63static void ostrcpy (char *s1, char *s2);
64
65/* Set to nonzero if we have written any verbose info.  */
66static int verbose_info;
67
68/* Add TEXT to end of ADA_NAME, putting a leading " (" or ", ", depending
69   on VERBOSE_INFO.  */
70
71static void add_verbose (const char *text, char *ada_name)
72{
73  strcat (ada_name, verbose_info ? ", " : " (");
74  strcat (ada_name, text);
75
76  verbose_info = 1;
77}
78
79/* Returns 1 if NAME starts with PREFIX.  */
80
81static int
82has_prefix (const char *name, const char *prefix)
83{
84  return strncmp (name, prefix, strlen (prefix)) == 0;
85}
86
87/* Returns 1 if NAME ends with SUFFIX.  */
88
89static int
90has_suffix (const char *name, const char *suffix)
91{
92  int nlen = strlen (name);
93  int slen = strlen (suffix);
94
95  return nlen > slen && strncmp (name + nlen - slen, suffix, slen) == 0;
96}
97
98/* Safe overlapped pointers version of strcpy.  */
99
100static void
101ostrcpy (char *s1, char *s2)
102{
103  if (s2 > s1)
104    {
105      while (*s2) *s1++ = *s2++;
106      *s1 = '\0';
107    }
108}
109
110/* This function will return the Ada name from the encoded form.
111   The Ada coding is done in exp_dbug.ads and this is the inverse function.
112   see exp_dbug.ads for full encoding rules, a short description is added
113   below. Right now only objects and routines are handled. Ada types are
114   stripped of their encodings.
115
116   CODED_NAME is the encoded entity name.
117
118   ADA_NAME is a pointer to a buffer, it will receive the Ada name. A safe
119   size for this buffer is: strlen (coded_name) * 2 + 60. (60 is for the
120   verbose information).
121
122   VERBOSE is nonzero if more information about the entity is to be
123   added at the end of the Ada name and surrounded by ( and ).
124
125     Coded name           Ada name                verbose info
126  ---------------------------------------------------------------------
127  _ada_xyz                xyz                     library level
128  x__y__z                 x.y.z
129  x__yTKB                 x.y                     task body
130  x__yB                   x.y                     task body
131  x__yX                   x.y                     body nested
132  x__yXb                  x.y                     body nested
133  xTK__y                  x.y                     in task
134  x__y$2                  x.y                     overloaded
135  x__y__3                 x.y                     overloaded
136  x__Oabs                 "abs"
137  x__Oand                 "and"
138  x__Omod                 "mod"
139  x__Onot                 "not"
140  x__Oor                  "or"
141  x__Orem                 "rem"
142  x__Oxor                 "xor"
143  x__Oeq                  "="
144  x__One                  "/="
145  x__Olt                  "<"
146  x__Ole                  "<="
147  x__Ogt                  ">"
148  x__Oge                  ">="
149  x__Oadd                 "+"
150  x__Osubtract            "-"
151  x__Oconcat              "&"
152  x__Omultiply            "*"
153  x__Odivide              "/"
154  x__Oexpon               "**"     */
155
156void
157__gnat_decode (const char *coded_name, char *ada_name, int verbose)
158{
159  int lib_subprog = 0;
160  int overloaded = 0;
161  int task_body = 0;
162  int in_task = 0;
163  int body_nested = 0;
164
165  /* Deal with empty input early.  This allows assuming non-null length
166     later on, simplifying coding.  In principle, it should be our callers
167     business not to call here for empty inputs.  It is easy enough to
168     allow it, however, and might allow simplifications upstream so is not
169     a bad thing per se.  We need a guard in any case.  */
170
171  if (*coded_name == '\0')
172    {
173      *ada_name = '\0';
174      return;
175    }
176
177  /* Check for library level subprogram.  */
178  else if (has_prefix (coded_name, "_ada_"))
179    {
180      strcpy (ada_name, coded_name + 5);
181      lib_subprog = 1;
182    }
183  else
184    strcpy (ada_name, coded_name);
185
186  /* Check for the first triple underscore in the name. This indicates
187     that the name represents a type with encodings; in this case, we
188     need to strip the encodings.  */
189  {
190    char *encodings;
191
192    if ((encodings = (char *) strstr (ada_name, "___")) != NULL)
193      {
194	*encodings = '\0';
195      }
196  }
197
198  /* Check for task body.  */
199  if (has_suffix (ada_name, "TKB"))
200    {
201      ada_name[strlen (ada_name) - 3] = '\0';
202      task_body = 1;
203    }
204
205  if (has_suffix (ada_name, "B"))
206    {
207      ada_name[strlen (ada_name) - 1] = '\0';
208      task_body = 1;
209    }
210
211  /* Check for body-nested entity: X[bn] */
212  if (has_suffix (ada_name, "X"))
213    {
214      ada_name[strlen (ada_name) - 1] = '\0';
215      body_nested = 1;
216    }
217
218  if (has_suffix (ada_name, "Xb"))
219    {
220      ada_name[strlen (ada_name) - 2] = '\0';
221      body_nested = 1;
222    }
223
224  if (has_suffix (ada_name, "Xn"))
225    {
226      ada_name[strlen (ada_name) - 2] = '\0';
227      body_nested = 1;
228    }
229
230  /* Change instance of TK__ (object declared inside a task) to __.  */
231  {
232    char *tktoken;
233
234    while ((tktoken = (char *) strstr (ada_name, "TK__")) != NULL)
235      {
236	ostrcpy (tktoken, tktoken + 2);
237	in_task = 1;
238      }
239  }
240
241  /* Check for overloading: name terminated by $nn or __nn.  */
242  {
243    int len = strlen (ada_name);
244    int n_digits = 0;
245
246    if (len > 1)
247      while (ISDIGIT ((int) ada_name[(int) len - 1 - n_digits]))
248	n_digits++;
249
250    /* Check if we have $ or __ before digits.  */
251    if (ada_name[len - 1 - n_digits] == '$')
252      {
253	ada_name[len - 1 - n_digits] = '\0';
254	overloaded = 1;
255      }
256    else if (ada_name[len - 1 - n_digits] == '_'
257	     && ada_name[len - 1 - n_digits - 1] == '_')
258      {
259	ada_name[len - 1 - n_digits - 1] = '\0';
260	overloaded = 1;
261      }
262  }
263
264  /* Check for nested subprogram ending in .nnnn and strip suffix. */
265  {
266    int last = strlen (ada_name) - 1;
267
268    while (ISDIGIT (ada_name[last]) && last > 0)
269      {
270        last--;
271      }
272
273    if (ada_name[last] == '.')
274      {
275        ada_name[last] = (char) 0;
276      }
277  }
278
279  /* Change all "__" to ".". */
280  {
281    int len = strlen (ada_name);
282    int k = 0;
283
284    while (k < len)
285      {
286	if (ada_name[k] == '_' && ada_name[k+1] == '_')
287	  {
288	    ada_name[k] = '.';
289	    ostrcpy (ada_name + k + 1, ada_name + k + 2);
290	    len = len - 1;
291	  }
292	k++;
293      }
294  }
295
296  /* Checks for operator name.  */
297  {
298    const char *trans_table[][2]
299      = {{"Oabs", "\"abs\""},  {"Oand", "\"and\""},    {"Omod", "\"mod\""},
300	 {"Onot", "\"not\""},  {"Oor", "\"or\""},      {"Orem", "\"rem\""},
301	 {"Oxor", "\"xor\""},  {"Oeq", "\"=\""},       {"One", "\"/=\""},
302	 {"Olt", "\"<\""},     {"Ole", "\"<=\""},      {"Ogt", "\">\""},
303	 {"Oge", "\">=\""},    {"Oadd", "\"+\""},      {"Osubtract", "\"-\""},
304	 {"Oconcat", "\"&\""}, {"Omultiply", "\"*\""}, {"Odivide", "\"/\""},
305	 {"Oexpon", "\"**\""}, {NULL, NULL} };
306    int k = 0;
307
308    while (1)
309      {
310	char *optoken;
311
312	if ((optoken = (char *) strstr (ada_name, trans_table[k][0])) != NULL)
313	  {
314	    int codedlen = strlen (trans_table[k][0]);
315	    int oplen = strlen (trans_table[k][1]);
316
317	    if (codedlen > oplen)
318	      /* We shrink the space.  */
319	      ostrcpy (optoken, optoken + codedlen - oplen);
320	    else if (oplen > codedlen)
321	      {
322		/* We need more space.  */
323		int len = strlen (ada_name);
324		int space = oplen - codedlen;
325		int num_to_move = &ada_name[len] - optoken;
326		int t;
327
328		for (t = 0; t < num_to_move; t++)
329		  ada_name[len + space - t - 1] = ada_name[len - t - 1];
330	      }
331
332	    /* Write symbol in the space.  */
333	    strncpy (optoken, trans_table[k][1], oplen);
334	  }
335	else
336	  k++;
337
338	/* Check for table's ending.  */
339	if (trans_table[k][0] == NULL)
340	  break;
341      }
342  }
343
344  /* If verbose mode is on, we add some information to the Ada name.  */
345  if (verbose)
346    {
347      if (overloaded)
348	add_verbose ("overloaded", ada_name);
349
350      if (lib_subprog)
351	add_verbose ("library level", ada_name);
352
353      if (body_nested)
354	add_verbose ("body nested", ada_name);
355
356      if (in_task)
357	add_verbose ("in task", ada_name);
358
359      if (task_body)
360	add_verbose ("task body", ada_name);
361
362      if (verbose_info == 1)
363	strcat (ada_name, ")");
364    }
365}
366
367#ifdef __cplusplus
368extern "C" {
369#endif
370
371#ifdef IN_RTS
372char *
373ada_demangle (const char *coded_name)
374{
375  char ada_name[2048];
376
377  __gnat_decode (coded_name, ada_name, 0);
378  return xstrdup (ada_name);
379}
380#endif
381
382void
383get_encoding (const char *coded_name, char *encoding)
384{
385  char * dest_index = encoding;
386  const char *p;
387  int found = 0;
388  int count = 0;
389
390  /* The heuristics is the following: we assume that the first triple
391     underscore in an encoded name indicates the beginning of the
392     first encoding, and that subsequent triple underscores indicate
393     the next encodings. We assume that the encodings are always at the
394     end of encoded names.  */
395
396  for (p = coded_name; *p != '\0'; p++)
397    {
398      if (*p != '_')
399	count = 0;
400      else
401	if (++count == 3)
402	  {
403	    count = 0;
404
405	    if (found)
406	      {
407		dest_index = dest_index - 2;
408		*dest_index++ = ':';
409	      }
410
411	    p++;
412	    found = 1;
413	  }
414
415      if (found)
416	*dest_index++ = *p;
417    }
418
419  *dest_index = '\0';
420}
421
422#ifdef __cplusplus
423}
424#endif
425