1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
7 * C Implementation File *
9 * Copyright (C) 2001-2018, Free Software Foundation, Inc. *
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. *
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. *
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/>. *
27 * GNAT was originally developed by the GNAT team at New York University. *
28 * Extensive contributions were provided by Ada Core Technologies Inc. *
30 ****************************************************************************/
45 #include "adaint.h" /* for a macro version of xstrdup. */
48 #define ISDIGIT(c) isdigit(c)
52 #define PARMS(ARGS) ARGS
55 #include "adadecode.h"
57 static void add_verbose (const char *, char *);
58 static int has_prefix (const char *, const char *);
59 static int has_suffix (const char *, const char *);
61 /* This is a safe version of strcpy that can be used with overlapped
62 pointers. Does nothing if s2 <= s1. */
63 static void ostrcpy (char *s1
, char *s2
);
65 /* Set to nonzero if we have written any verbose info. */
66 static int verbose_info
;
68 /* Add TEXT to end of ADA_NAME, putting a leading " (" or ", ", depending
71 static void add_verbose (const char *text
, char *ada_name
)
73 strcat (ada_name
, verbose_info
? ", " : " (");
74 strcat (ada_name
, text
);
79 /* Returns 1 if NAME starts with PREFIX. */
82 has_prefix (const char *name
, const char *prefix
)
84 return strncmp (name
, prefix
, strlen (prefix
)) == 0;
87 /* Returns 1 if NAME ends with SUFFIX. */
90 has_suffix (const char *name
, const char *suffix
)
92 int nlen
= strlen (name
);
93 int slen
= strlen (suffix
);
95 return nlen
> slen
&& strncmp (name
+ nlen
- slen
, suffix
, slen
) == 0;
98 /* Safe overlapped pointers version of strcpy. */
101 ostrcpy (char *s1
, char *s2
)
105 while (*s2
) *s1
++ = *s2
++;
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.
116 CODED_NAME is the encoded entity name.
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).
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 ).
125 Coded name Ada name verbose info
126 ---------------------------------------------------------------------
127 _ada_xyz xyz library level
129 x__yTKB x.y task body
131 x__yX x.y body nested
132 x__yXb x.y body nested
134 x__y$2 x.y overloaded
135 x__y__3 x.y overloaded
157 __gnat_decode (const char *coded_name
, char *ada_name
, int verbose
)
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. */
171 if (*coded_name
== '\0')
177 /* Check for library level subprogram. */
178 else if (has_prefix (coded_name
, "_ada_"))
180 strcpy (ada_name
, coded_name
+ 5);
184 strcpy (ada_name
, coded_name
);
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. */
192 if ((encodings
= (char *) strstr (ada_name
, "___")) != NULL
)
198 /* Check for task body. */
199 if (has_suffix (ada_name
, "TKB"))
201 ada_name
[strlen (ada_name
) - 3] = '\0';
205 if (has_suffix (ada_name
, "B"))
207 ada_name
[strlen (ada_name
) - 1] = '\0';
211 /* Check for body-nested entity: X[bn] */
212 if (has_suffix (ada_name
, "X"))
214 ada_name
[strlen (ada_name
) - 1] = '\0';
218 if (has_suffix (ada_name
, "Xb"))
220 ada_name
[strlen (ada_name
) - 2] = '\0';
224 if (has_suffix (ada_name
, "Xn"))
226 ada_name
[strlen (ada_name
) - 2] = '\0';
230 /* Change instance of TK__ (object declared inside a task) to __. */
234 while ((tktoken
= (char *) strstr (ada_name
, "TK__")) != NULL
)
236 ostrcpy (tktoken
, tktoken
+ 2);
241 /* Check for overloading: name terminated by $nn or __nn. */
243 int len
= strlen (ada_name
);
247 while (ISDIGIT ((int) ada_name
[(int) len
- 1 - n_digits
]))
250 /* Check if we have $ or __ before digits. */
251 if (ada_name
[len
- 1 - n_digits
] == '$')
253 ada_name
[len
- 1 - n_digits
] = '\0';
256 else if (ada_name
[len
- 1 - n_digits
] == '_'
257 && ada_name
[len
- 1 - n_digits
- 1] == '_')
259 ada_name
[len
- 1 - n_digits
- 1] = '\0';
264 /* Check for nested subprogram ending in .nnnn and strip suffix. */
266 int last
= strlen (ada_name
) - 1;
268 while (ISDIGIT (ada_name
[last
]) && last
> 0)
273 if (ada_name
[last
] == '.')
275 ada_name
[last
] = (char) 0;
279 /* Change all "__" to ".". */
281 int len
= strlen (ada_name
);
286 if (ada_name
[k
] == '_' && ada_name
[k
+1] == '_')
289 ostrcpy (ada_name
+ k
+ 1, ada_name
+ k
+ 2);
296 /* Checks for operator name. */
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
} };
312 if ((optoken
= (char *) strstr (ada_name
, trans_table
[k
][0])) != NULL
)
314 int codedlen
= strlen (trans_table
[k
][0]);
315 int oplen
= strlen (trans_table
[k
][1]);
317 if (codedlen
> oplen
)
318 /* We shrink the space. */
319 ostrcpy (optoken
, optoken
+ codedlen
- oplen
);
320 else if (oplen
> codedlen
)
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
;
328 for (t
= 0; t
< num_to_move
; t
++)
329 ada_name
[len
+ space
- t
- 1] = ada_name
[len
- t
- 1];
332 /* Write symbol in the space. */
333 memcpy (optoken
, trans_table
[k
][1], oplen
);
338 /* Check for table's ending. */
339 if (trans_table
[k
][0] == NULL
)
344 /* If verbose mode is on, we add some information to the Ada name. */
348 add_verbose ("overloaded", ada_name
);
351 add_verbose ("library level", ada_name
);
354 add_verbose ("body nested", ada_name
);
357 add_verbose ("in task", ada_name
);
360 add_verbose ("task body", ada_name
);
362 if (verbose_info
== 1)
363 strcat (ada_name
, ")");
372 get_encoding (const char *coded_name
, char *encoding
)
374 char * dest_index
= encoding
;
379 /* The heuristics is the following: we assume that the first triple
380 underscore in an encoded name indicates the beginning of the
381 first encoding, and that subsequent triple underscores indicate
382 the next encodings. We assume that the encodings are always at the
383 end of encoded names. */
385 for (p
= coded_name
; *p
!= '\0'; p
++)
396 dest_index
= dest_index
- 2;