2016-10-26 François Dumont <fdumont@gcc.gnu.org>
[official-gcc.git] / gcc / ada / adadecode.c
blob8c9c7ab7a88f78582af43f898e6b701bc7950662
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 ****************************************************************************/
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
41 #include <string.h>
42 #include <stdio.h>
43 #include <ctype.h>
45 #include "adaint.h" /* for a macro version of xstrdup. */
47 #ifndef ISDIGIT
48 #define ISDIGIT(c) isdigit(c)
49 #endif
51 #ifndef PARMS
52 #define PARMS(ARGS) ARGS
53 #endif
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
69 on VERBOSE_INFO. */
71 static void add_verbose (const char *text, char *ada_name)
73 strcat (ada_name, verbose_info ? ", " : " (");
74 strcat (ada_name, text);
76 verbose_info = 1;
79 /* Returns 1 if NAME starts with PREFIX. */
81 static int
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. */
89 static int
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. */
100 static void
101 ostrcpy (char *s1, char *s2)
103 if (s2 > s1)
105 while (*s2) *s1++ = *s2++;
106 *s1 = '\0';
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
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 "**" */
156 void
157 __gnat_decode (const char *coded_name, char *ada_name, int verbose)
159 int lib_subprog = 0;
160 int overloaded = 0;
161 int task_body = 0;
162 int in_task = 0;
163 int body_nested = 0;
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')
173 *ada_name = '\0';
174 return;
177 /* Check for library level subprogram. */
178 else if (has_prefix (coded_name, "_ada_"))
180 strcpy (ada_name, coded_name + 5);
181 lib_subprog = 1;
183 else
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. */
190 char *encodings;
192 if ((encodings = (char *) strstr (ada_name, "___")) != NULL)
194 *encodings = '\0';
198 /* Check for task body. */
199 if (has_suffix (ada_name, "TKB"))
201 ada_name[strlen (ada_name) - 3] = '\0';
202 task_body = 1;
205 if (has_suffix (ada_name, "B"))
207 ada_name[strlen (ada_name) - 1] = '\0';
208 task_body = 1;
211 /* Check for body-nested entity: X[bn] */
212 if (has_suffix (ada_name, "X"))
214 ada_name[strlen (ada_name) - 1] = '\0';
215 body_nested = 1;
218 if (has_suffix (ada_name, "Xb"))
220 ada_name[strlen (ada_name) - 2] = '\0';
221 body_nested = 1;
224 if (has_suffix (ada_name, "Xn"))
226 ada_name[strlen (ada_name) - 2] = '\0';
227 body_nested = 1;
230 /* Change instance of TK__ (object declared inside a task) to __. */
232 char *tktoken;
234 while ((tktoken = (char *) strstr (ada_name, "TK__")) != NULL)
236 ostrcpy (tktoken, tktoken + 2);
237 in_task = 1;
241 /* Check for overloading: name terminated by $nn or __nn. */
243 int len = strlen (ada_name);
244 int n_digits = 0;
246 if (len > 1)
247 while (ISDIGIT ((int) ada_name[(int) len - 1 - n_digits]))
248 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';
254 overloaded = 1;
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';
260 overloaded = 1;
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)
270 last--;
273 if (ada_name[last] == '.')
275 ada_name[last] = (char) 0;
279 /* Change all "__" to ".". */
281 int len = strlen (ada_name);
282 int k = 0;
284 while (k < len)
286 if (ada_name[k] == '_' && ada_name[k+1] == '_')
288 ada_name[k] = '.';
289 ostrcpy (ada_name + k + 1, ada_name + k + 2);
290 len = len - 1;
292 k++;
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} };
306 int k = 0;
308 while (1)
310 char *optoken;
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;
326 int t;
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 strncpy (optoken, trans_table[k][1], oplen);
335 else
336 k++;
338 /* Check for table's ending. */
339 if (trans_table[k][0] == NULL)
340 break;
344 /* If verbose mode is on, we add some information to the Ada name. */
345 if (verbose)
347 if (overloaded)
348 add_verbose ("overloaded", ada_name);
350 if (lib_subprog)
351 add_verbose ("library level", ada_name);
353 if (body_nested)
354 add_verbose ("body nested", ada_name);
356 if (in_task)
357 add_verbose ("in task", ada_name);
359 if (task_body)
360 add_verbose ("task body", ada_name);
362 if (verbose_info == 1)
363 strcat (ada_name, ")");
367 #ifdef __cplusplus
368 extern "C" {
369 #endif
371 void
372 get_encoding (const char *coded_name, char *encoding)
374 char * dest_index = encoding;
375 const char *p;
376 int found = 0;
377 int count = 0;
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++)
387 if (*p != '_')
388 count = 0;
389 else
390 if (++count == 3)
392 count = 0;
394 if (found)
396 dest_index = dest_index - 2;
397 *dest_index++ = ':';
400 p++;
401 found = 1;
404 if (found)
405 *dest_index++ = *p;
408 *dest_index = '\0';
411 #ifdef __cplusplus
413 #endif