|
111
|
1 /****************************************************************************
|
|
|
2 * *
|
|
|
3 * GNAT COMPILER COMPONENTS *
|
|
|
4 * *
|
|
|
5 * A D A D E C O D E *
|
|
|
6 * *
|
|
|
7 * C Implementation File *
|
|
|
8 * *
|
|
131
|
9 * Copyright (C) 2001-2018, Free Software Foundation, Inc. *
|
|
111
|
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
|
|
|
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 *);
|
|
|
60
|
|
|
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);
|
|
|
64
|
|
|
65 /* Set to nonzero if we have written any verbose info. */
|
|
|
66 static int verbose_info;
|
|
|
67
|
|
|
68 /* Add TEXT to end of ADA_NAME, putting a leading " (" or ", ", depending
|
|
|
69 on VERBOSE_INFO. */
|
|
|
70
|
|
|
71 static 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
|
|
|
81 static int
|
|
|
82 has_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
|
|
|
89 static int
|
|
|
90 has_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
|
|
|
100 static void
|
|
|
101 ostrcpy (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
|
|
|
156 void
|
|
|
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. */
|
|
131
|
333 memcpy (optoken, trans_table[k][1], oplen);
|
|
111
|
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
|
|
|
368 extern "C" {
|
|
|
369 #endif
|
|
|
370
|
|
|
371 void
|
|
|
372 get_encoding (const char *coded_name, char *encoding)
|
|
|
373 {
|
|
|
374 char * dest_index = encoding;
|
|
|
375 const char *p;
|
|
|
376 int found = 0;
|
|
|
377 int count = 0;
|
|
|
378
|
|
|
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. */
|
|
|
384
|
|
|
385 for (p = coded_name; *p != '\0'; p++)
|
|
|
386 {
|
|
|
387 if (*p != '_')
|
|
|
388 count = 0;
|
|
|
389 else
|
|
|
390 if (++count == 3)
|
|
|
391 {
|
|
|
392 count = 0;
|
|
|
393
|
|
|
394 if (found)
|
|
|
395 {
|
|
|
396 dest_index = dest_index - 2;
|
|
|
397 *dest_index++ = ':';
|
|
|
398 }
|
|
|
399
|
|
|
400 p++;
|
|
|
401 found = 1;
|
|
|
402 }
|
|
|
403
|
|
|
404 if (found)
|
|
|
405 *dest_index++ = *p;
|
|
|
406 }
|
|
|
407
|
|
|
408 *dest_index = '\0';
|
|
|
409 }
|
|
|
410
|
|
|
411 #ifdef __cplusplus
|
|
|
412 }
|
|
|
413 #endif
|
