1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
7 * C Implementation File *
9 * Copyright (C) 2001-2023, 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 ****************************************************************************/
37 #include "adaint.h" /* for a macro version of xstrdup. */
40 #define ISDIGIT(c) isdigit(c)
44 #define PARMS(ARGS) ARGS
47 #include "adadecode.h"
49 static void add_verbose (const char *, char *);
50 static int has_prefix (const char *, const char *);
51 static int has_suffix (const char *, const char *);
53 /* This is a safe version of strcpy that can be used with overlapped
54 pointers. Does nothing if s2 <= s1. */
55 static void ostrcpy (char *s1
, char *s2
);
57 /* Set to nonzero if we have written any verbose info. */
58 static int verbose_info
;
60 /* Add TEXT to end of ADA_NAME, putting a leading " (" or ", ", depending
63 static void add_verbose (const char *text
, char *ada_name
)
65 strcat (ada_name
, verbose_info
? ", " : " (");
66 strcat (ada_name
, text
);
71 /* Returns 1 if NAME starts with PREFIX. */
74 has_prefix (const char *name
, const char *prefix
)
76 return strncmp (name
, prefix
, strlen (prefix
)) == 0;
79 /* Returns 1 if NAME ends with SUFFIX. */
82 has_suffix (const char *name
, const char *suffix
)
84 int nlen
= strlen (name
);
85 int slen
= strlen (suffix
);
87 return nlen
> slen
&& strncmp (name
+ nlen
- slen
, suffix
, slen
) == 0;
90 /* Safe overlapped pointers version of strcpy. */
93 ostrcpy (char *s1
, char *s2
)
97 while (*s2
) *s1
++ = *s2
++;
102 /* This function will return the Ada name from the encoded form.
103 The Ada coding is done in exp_dbug.ads and this is the inverse function.
104 see exp_dbug.ads for full encoding rules, a short description is added
105 below. Right now only objects and routines are handled. Ada types are
106 stripped of their encodings.
108 CODED_NAME is the encoded entity name.
110 ADA_NAME is a pointer to a buffer, it will receive the Ada name. A safe
111 size for this buffer is: strlen (coded_name) * 2 + 60. (60 is for the
112 verbose information).
114 VERBOSE is nonzero if more information about the entity is to be
115 added at the end of the Ada name and surrounded by ( and ).
117 Coded name Ada name verbose info
118 ---------------------------------------------------------------------
119 _ada_xyz xyz library level
121 x__yTKB x.y task body
123 x__yX x.y body nested
124 x__yXb x.y body nested
126 x__y$2 x.y overloaded
127 x__y__3 x.y overloaded
149 __gnat_decode (const char *coded_name
, char *ada_name
, int verbose
)
157 /* Deal with empty input early. This allows assuming non-null length
158 later on, simplifying coding. In principle, it should be our callers
159 business not to call here for empty inputs. It is easy enough to
160 allow it, however, and might allow simplifications upstream so is not
161 a bad thing per se. We need a guard in any case. */
163 if (*coded_name
== '\0')
169 /* Check for library level subprogram. */
170 else if (has_prefix (coded_name
, "_ada_"))
172 strcpy (ada_name
, coded_name
+ 5);
176 strcpy (ada_name
, coded_name
);
178 /* Check for the first triple underscore in the name. This indicates
179 that the name represents a type with encodings; in this case, we
180 need to strip the encodings. */
184 if ((encodings
= (char *) strstr (ada_name
, "___")) != NULL
)
190 /* Check for task body. */
191 if (has_suffix (ada_name
, "TKB"))
193 ada_name
[strlen (ada_name
) - 3] = '\0';
197 if (has_suffix (ada_name
, "B"))
199 ada_name
[strlen (ada_name
) - 1] = '\0';
203 /* Check for body-nested entity: X[bn] */
204 if (has_suffix (ada_name
, "X"))
206 ada_name
[strlen (ada_name
) - 1] = '\0';
210 if (has_suffix (ada_name
, "Xb"))
212 ada_name
[strlen (ada_name
) - 2] = '\0';
216 if (has_suffix (ada_name
, "Xn"))
218 ada_name
[strlen (ada_name
) - 2] = '\0';
222 /* Change instance of TK__ (object declared inside a task) to __. */
226 while ((tktoken
= (char *) strstr (ada_name
, "TK__")) != NULL
)
228 ostrcpy (tktoken
, tktoken
+ 2);
233 /* Check for overloading: name terminated by $nn or __nn. */
235 int len
= strlen (ada_name
);
239 while (ISDIGIT ((int) ada_name
[(int) len
- 1 - n_digits
]))
242 /* Check if we have $ or __ before digits. */
243 if (ada_name
[len
- 1 - n_digits
] == '$')
245 ada_name
[len
- 1 - n_digits
] = '\0';
248 else if (ada_name
[len
- 1 - n_digits
] == '_'
249 && ada_name
[len
- 1 - n_digits
- 1] == '_')
251 ada_name
[len
- 1 - n_digits
- 1] = '\0';
256 /* Check for nested subprogram ending in .nnnn and strip suffix. */
258 int last
= strlen (ada_name
) - 1;
260 while (ISDIGIT (ada_name
[last
]) && last
> 0)
265 if (ada_name
[last
] == '.')
267 ada_name
[last
] = (char) 0;
271 /* Change all "__" to ".". */
273 int len
= strlen (ada_name
);
278 if (ada_name
[k
] == '_' && ada_name
[k
+1] == '_')
281 ostrcpy (ada_name
+ k
+ 1, ada_name
+ k
+ 2);
288 /* Checks for operator name. */
290 const char *trans_table
[][2]
291 = {{"Oabs", "\"abs\""}, {"Oand", "\"and\""}, {"Omod", "\"mod\""},
292 {"Onot", "\"not\""}, {"Oor", "\"or\""}, {"Orem", "\"rem\""},
293 {"Oxor", "\"xor\""}, {"Oeq", "\"=\""}, {"One", "\"/=\""},
294 {"Olt", "\"<\""}, {"Ole", "\"<=\""}, {"Ogt", "\">\""},
295 {"Oge", "\">=\""}, {"Oadd", "\"+\""}, {"Osubtract", "\"-\""},
296 {"Oconcat", "\"&\""}, {"Omultiply", "\"*\""}, {"Odivide", "\"/\""},
297 {"Oexpon", "\"**\""}, {NULL
, NULL
} };
304 if ((optoken
= (char *) strstr (ada_name
, trans_table
[k
][0])) != NULL
)
306 int codedlen
= strlen (trans_table
[k
][0]);
307 int oplen
= strlen (trans_table
[k
][1]);
309 if (codedlen
> oplen
)
310 /* We shrink the space. */
311 ostrcpy (optoken
, optoken
+ codedlen
- oplen
);
312 else if (oplen
> codedlen
)
314 /* We need more space. */
315 int len
= strlen (ada_name
);
316 int space
= oplen
- codedlen
;
317 int num_to_move
= &ada_name
[len
] - optoken
;
320 for (t
= 0; t
< num_to_move
; t
++)
321 ada_name
[len
+ space
- t
- 1] = ada_name
[len
- t
- 1];
324 /* Write symbol in the space. */
325 memcpy (optoken
, trans_table
[k
][1], oplen
);
330 /* Check for table's ending. */
331 if (trans_table
[k
][0] == NULL
)
336 /* If verbose mode is on, we add some information to the Ada name. */
340 add_verbose ("overloaded", ada_name
);
343 add_verbose ("library level", ada_name
);
346 add_verbose ("body nested", ada_name
);
349 add_verbose ("in task", ada_name
);
352 add_verbose ("task body", ada_name
);
354 if (verbose_info
== 1)
355 strcat (ada_name
, ")");
364 get_encoding (const char *coded_name
, char *encoding
)
366 char * dest_index
= encoding
;
371 /* The heuristics is the following: we assume that the first triple
372 underscore in an encoded name indicates the beginning of the
373 first encoding, and that subsequent triple underscores indicate
374 the next encodings. We assume that the encodings are always at the
375 end of encoded names. */
377 for (p
= coded_name
; *p
!= '\0'; p
++)
388 dest_index
= dest_index
- 2;