Branch data Line data Source code
1 : : /* Print GENERIC declaration (functions, variables, types) trees coming from
2 : : the C and C++ front-ends as well as macros in Ada syntax.
3 : : Copyright (C) 2010-2024 Free Software Foundation, Inc.
4 : : Adapted from tree-pretty-print.cc by Arnaud Charlet <charlet@adacore.com>
5 : :
6 : : This file is part of GCC.
7 : :
8 : : GCC is free software; you can redistribute it and/or modify it under
9 : : the terms of the GNU General Public License as published by the Free
10 : : Software Foundation; either version 3, or (at your option) any later
11 : : version.
12 : :
13 : : GCC is distributed in the hope that it will be useful, but WITHOUT ANY
14 : : WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 : : FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16 : : for more details.
17 : :
18 : : You should have received a copy of the GNU General Public License
19 : : along with GCC; see the file COPYING3. If not see
20 : : <http://www.gnu.org/licenses/>. */
21 : :
22 : : #include "config.h"
23 : : #include "system.h"
24 : : #include "coretypes.h"
25 : : #include "tm.h"
26 : : #include "stringpool.h"
27 : : #include "tree.h"
28 : : #include "c-ada-spec.h"
29 : : #include "fold-const.h"
30 : : #include "c-pragma.h"
31 : : #include "diagnostic.h"
32 : : #include "stringpool.h"
33 : : #include "attribs.h"
34 : : #include "bitmap.h"
35 : :
36 : : /* Local functions, macros and variables. */
37 : : static int dump_ada_node (pretty_printer *, tree, tree, int, bool, bool);
38 : : static int dump_ada_declaration (pretty_printer *, tree, tree, int);
39 : : static void dump_ada_structure (pretty_printer *, tree, tree, bool, int);
40 : : static char *to_ada_name (const char *, bool *);
41 : :
42 : : #define INDENT(SPACE) \
43 : : do { int i; for (i = 0; i<SPACE; i++) pp_space (buffer); } while (0)
44 : :
45 : : #define INDENT_INCR 3
46 : :
47 : : /* Global hook used to perform C++ queries on nodes. */
48 : : static int (*cpp_check) (tree, cpp_operation) = NULL;
49 : :
50 : : /* Global variables used in macro-related callbacks. */
51 : : static int max_ada_macros;
52 : : static int store_ada_macro_index;
53 : : static const char *macro_source_file;
54 : :
55 : : /* Given a cpp MACRO, compute the max length BUFFER_LEN of the macro, as well
56 : : as max length PARAM_LEN of arguments for fun_like macros, and also set
57 : : SUPPORTED to 0 if the macro cannot be mapped to an Ada construct. */
58 : :
59 : : static void
60 : 5 : macro_length (const cpp_macro *macro, int *supported, int *buffer_len,
61 : : int *param_len)
62 : : {
63 : 5 : int i;
64 : 5 : unsigned j;
65 : :
66 : 5 : *supported = 1;
67 : 5 : *buffer_len = 0;
68 : 5 : *param_len = 0;
69 : :
70 : 5 : if (macro->fun_like)
71 : : {
72 : 0 : (*param_len)++;
73 : 0 : for (i = 0; i < macro->paramc; i++)
74 : : {
75 : 0 : cpp_hashnode *param = macro->parm.params[i];
76 : :
77 : 0 : *param_len += NODE_LEN (param);
78 : :
79 : 0 : if (i + 1 < macro->paramc)
80 : : {
81 : 0 : *param_len += 2; /* ", " */
82 : : }
83 : 0 : else if (macro->variadic)
84 : : {
85 : 0 : *supported = 0;
86 : 0 : return;
87 : : }
88 : : }
89 : 0 : *param_len += 2; /* ")\0" */
90 : : }
91 : :
92 : 10 : for (j = 0; j < macro->count; j++)
93 : : {
94 : 5 : const cpp_token *token = ¯o->exp.tokens[j];
95 : :
96 : 5 : if (token->flags & PREV_WHITE)
97 : 0 : (*buffer_len)++;
98 : :
99 : 5 : if (token->flags & STRINGIFY_ARG || token->flags & PASTE_LEFT)
100 : : {
101 : 0 : *supported = 0;
102 : 0 : return;
103 : : }
104 : :
105 : 5 : if (token->type == CPP_MACRO_ARG)
106 : 0 : *buffer_len +=
107 : 0 : NODE_LEN (macro->parm.params[token->val.macro_arg.arg_no - 1]);
108 : : else
109 : : /* Include enough extra space to handle e.g. special characters. */
110 : 5 : *buffer_len += (cpp_token_len (token) + 1) * 8;
111 : : }
112 : :
113 : 5 : (*buffer_len)++;
114 : : }
115 : :
116 : : /* Dump all digits/hex chars from NUMBER to BUFFER and return a pointer
117 : : to the character after the last character written. If FLOAT_P is true,
118 : : this is a floating-point number. */
119 : :
120 : : static unsigned char *
121 : 5 : dump_number (unsigned char *number, unsigned char *buffer, bool float_p)
122 : : {
123 : 5 : while (*number != '\0'
124 : 25 : && *number != (float_p ? 'F' : 'U')
125 : 25 : && *number != (float_p ? 'f' : 'u')
126 : 25 : && *number != 'l'
127 : 55 : && *number != 'L')
128 : 25 : *buffer++ = *number++;
129 : :
130 : 5 : return buffer;
131 : : }
132 : :
133 : : /* Handle escape character C and convert to an Ada character into BUFFER.
134 : : Return a pointer to the character after the last character written, or
135 : : NULL if the escape character is not supported. */
136 : :
137 : : static unsigned char *
138 : 0 : handle_escape_character (unsigned char *buffer, char c)
139 : : {
140 : 0 : switch (c)
141 : : {
142 : 0 : case '"':
143 : 0 : *buffer++ = '"';
144 : 0 : *buffer++ = '"';
145 : 0 : break;
146 : :
147 : 0 : case 'n':
148 : 0 : strcpy ((char *) buffer, "\" & ASCII.LF & \"");
149 : 0 : buffer += 16;
150 : 0 : break;
151 : :
152 : 0 : case 'r':
153 : 0 : strcpy ((char *) buffer, "\" & ASCII.CR & \"");
154 : 0 : buffer += 16;
155 : 0 : break;
156 : :
157 : 0 : case 't':
158 : 0 : strcpy ((char *) buffer, "\" & ASCII.HT & \"");
159 : 0 : buffer += 16;
160 : 0 : break;
161 : :
162 : : default:
163 : : return NULL;
164 : : }
165 : :
166 : : return buffer;
167 : : }
168 : :
169 : : /* Callback used to count the number of macros from cpp_forall_identifiers.
170 : : PFILE and V are not used. NODE is the current macro to consider. */
171 : :
172 : : static int
173 : 419497 : count_ada_macro (cpp_reader *pfile ATTRIBUTE_UNUSED, cpp_hashnode *node,
174 : : void *v ATTRIBUTE_UNUSED)
175 : : {
176 : 419497 : if (cpp_user_macro_p (node) && *NODE_NAME (node) != '_')
177 : : {
178 : 235 : const cpp_macro *macro = node->value.macro;
179 : 235 : if (macro->count && LOCATION_FILE (macro->line) == macro_source_file)
180 : 5 : max_ada_macros++;
181 : : }
182 : :
183 : 419497 : return 1;
184 : : }
185 : :
186 : : /* Callback used to store relevant macros from cpp_forall_identifiers.
187 : : PFILE is not used. NODE is the current macro to store if relevant.
188 : : MACROS is an array of cpp_hashnode* used to store NODE. */
189 : :
190 : : static int
191 : 419497 : store_ada_macro (cpp_reader *pfile ATTRIBUTE_UNUSED,
192 : : cpp_hashnode *node, void *macros)
193 : : {
194 : 419497 : if (cpp_user_macro_p (node) && *NODE_NAME (node) != '_')
195 : : {
196 : 235 : const cpp_macro *macro = node->value.macro;
197 : 235 : if (macro->count
198 : 235 : && LOCATION_FILE (macro->line) == macro_source_file)
199 : 5 : ((cpp_hashnode **) macros)[store_ada_macro_index++] = node;
200 : : }
201 : 419497 : return 1;
202 : : }
203 : :
204 : : /* Callback used to compare (during qsort) macros. NODE1 and NODE2 are the
205 : : two macro nodes to compare. */
206 : :
207 : : static int
208 : 0 : compare_macro (const void *node1, const void *node2)
209 : : {
210 : 0 : typedef const cpp_hashnode *const_hnode;
211 : :
212 : 0 : const_hnode n1 = *(const const_hnode *) node1;
213 : 0 : const_hnode n2 = *(const const_hnode *) node2;
214 : :
215 : 0 : return n1->value.macro->line - n2->value.macro->line;
216 : : }
217 : :
218 : : /* Dump in PP all relevant macros appearing in FILE. */
219 : :
220 : : static void
221 : 115 : dump_ada_macros (pretty_printer *pp, const char* file)
222 : : {
223 : 115 : int num_macros = 0, prev_line = -1;
224 : 115 : cpp_hashnode **macros;
225 : :
226 : : /* Initialize file-scope variables. */
227 : 115 : max_ada_macros = 0;
228 : 115 : store_ada_macro_index = 0;
229 : 115 : macro_source_file = file;
230 : :
231 : : /* Count all potentially relevant macros, and then sort them by sloc. */
232 : 115 : cpp_forall_identifiers (parse_in, count_ada_macro, NULL);
233 : 115 : macros = XALLOCAVEC (cpp_hashnode *, max_ada_macros);
234 : 115 : cpp_forall_identifiers (parse_in, store_ada_macro, macros);
235 : 115 : qsort (macros, max_ada_macros, sizeof (cpp_hashnode *), compare_macro);
236 : :
237 : 120 : for (int j = 0; j < max_ada_macros; j++)
238 : : {
239 : 5 : cpp_hashnode *node = macros[j];
240 : 5 : const cpp_macro *macro = node->value.macro;
241 : 5 : unsigned i;
242 : 5 : int supported = 1, prev_is_one = 0, buffer_len, param_len;
243 : 5 : int is_string = 0, is_char = 0;
244 : 5 : char *ada_name;
245 : 5 : unsigned char *s, *params, *buffer, *buf_param, *char_one = NULL, *tmp;
246 : :
247 : 5 : macro_length (macro, &supported, &buffer_len, ¶m_len);
248 : 5 : s = buffer = XALLOCAVEC (unsigned char, buffer_len);
249 : 5 : params = buf_param = XALLOCAVEC (unsigned char, param_len);
250 : :
251 : 5 : if (supported)
252 : : {
253 : 5 : if (macro->fun_like)
254 : : {
255 : 0 : *buf_param++ = '(';
256 : 0 : for (i = 0; i < macro->paramc; i++)
257 : : {
258 : 0 : cpp_hashnode *param = macro->parm.params[i];
259 : :
260 : 0 : memcpy (buf_param, NODE_NAME (param), NODE_LEN (param));
261 : 0 : buf_param += NODE_LEN (param);
262 : :
263 : 0 : if (i + 1 < macro->paramc)
264 : : {
265 : 0 : *buf_param++ = ',';
266 : 0 : *buf_param++ = ' ';
267 : : }
268 : 0 : else if (macro->variadic)
269 : : {
270 : 0 : supported = 0;
271 : 0 : break;
272 : : }
273 : : }
274 : 0 : *buf_param++ = ')';
275 : 0 : *buf_param = '\0';
276 : : }
277 : :
278 : 10 : for (i = 0; supported && i < macro->count; i++)
279 : : {
280 : 5 : const cpp_token *token = ¯o->exp.tokens[i];
281 : 5 : int is_one = 0;
282 : :
283 : 5 : if (token->flags & PREV_WHITE)
284 : 0 : *buffer++ = ' ';
285 : :
286 : 5 : if (token->flags & STRINGIFY_ARG || token->flags & PASTE_LEFT)
287 : : {
288 : 0 : supported = 0;
289 : 0 : break;
290 : : }
291 : :
292 : 5 : switch (token->type)
293 : : {
294 : 0 : case CPP_MACRO_ARG:
295 : 0 : {
296 : 0 : cpp_hashnode *param =
297 : 0 : macro->parm.params[token->val.macro_arg.arg_no - 1];
298 : 0 : memcpy (buffer, NODE_NAME (param), NODE_LEN (param));
299 : 0 : buffer += NODE_LEN (param);
300 : : }
301 : 0 : break;
302 : :
303 : 0 : case CPP_EQ_EQ: *buffer++ = '='; break;
304 : 0 : case CPP_GREATER: *buffer++ = '>'; break;
305 : 0 : case CPP_LESS: *buffer++ = '<'; break;
306 : 0 : case CPP_PLUS: *buffer++ = '+'; break;
307 : 0 : case CPP_MINUS: *buffer++ = '-'; break;
308 : 0 : case CPP_MULT: *buffer++ = '*'; break;
309 : 0 : case CPP_DIV: *buffer++ = '/'; break;
310 : 0 : case CPP_COMMA: *buffer++ = ','; break;
311 : 0 : case CPP_OPEN_SQUARE:
312 : 0 : case CPP_OPEN_PAREN: *buffer++ = '('; break;
313 : 0 : case CPP_CLOSE_SQUARE: /* fallthrough */
314 : 0 : case CPP_CLOSE_PAREN: *buffer++ = ')'; break;
315 : 0 : case CPP_DEREF: /* fallthrough */
316 : 0 : case CPP_SCOPE: /* fallthrough */
317 : 0 : case CPP_DOT: *buffer++ = '.'; break;
318 : :
319 : 0 : case CPP_EQ: *buffer++ = ':'; *buffer++ = '='; break;
320 : 0 : case CPP_NOT_EQ: *buffer++ = '/'; *buffer++ = '='; break;
321 : 0 : case CPP_GREATER_EQ: *buffer++ = '>'; *buffer++ = '='; break;
322 : 0 : case CPP_LESS_EQ: *buffer++ = '<'; *buffer++ = '='; break;
323 : :
324 : 0 : case CPP_NOT:
325 : 0 : *buffer++ = 'n'; *buffer++ = 'o'; *buffer++ = 't'; break;
326 : 0 : case CPP_MOD:
327 : 0 : *buffer++ = 'm'; *buffer++ = 'o'; *buffer++ = 'd'; break;
328 : 0 : case CPP_AND:
329 : 0 : *buffer++ = 'a'; *buffer++ = 'n'; *buffer++ = 'd'; break;
330 : 0 : case CPP_OR:
331 : 0 : *buffer++ = 'o'; *buffer++ = 'r'; break;
332 : 0 : case CPP_XOR:
333 : 0 : *buffer++ = 'x'; *buffer++ = 'o'; *buffer++ = 'r'; break;
334 : 0 : case CPP_AND_AND:
335 : 0 : strcpy ((char *) buffer, " and then ");
336 : 0 : buffer += 10;
337 : 0 : break;
338 : 0 : case CPP_OR_OR:
339 : 0 : strcpy ((char *) buffer, " or else ");
340 : 0 : buffer += 9;
341 : 0 : break;
342 : :
343 : 0 : case CPP_PADDING:
344 : 0 : *buffer++ = ' ';
345 : 0 : is_one = prev_is_one;
346 : 0 : break;
347 : :
348 : : case CPP_COMMENT:
349 : : break;
350 : :
351 : 0 : case CPP_WSTRING:
352 : 0 : case CPP_STRING16:
353 : 0 : case CPP_STRING32:
354 : 0 : case CPP_UTF8STRING:
355 : 0 : case CPP_WCHAR:
356 : 0 : case CPP_CHAR16:
357 : 0 : case CPP_CHAR32:
358 : 0 : case CPP_UTF8CHAR:
359 : 0 : case CPP_NAME:
360 : 0 : if (!macro->fun_like)
361 : 0 : supported = 0;
362 : : else
363 : 0 : buffer
364 : 0 : = cpp_spell_token (parse_in, token, buffer, false);
365 : : break;
366 : :
367 : 0 : case CPP_STRING:
368 : 0 : if (is_string)
369 : : {
370 : 0 : *buffer++ = '&';
371 : 0 : *buffer++ = ' ';
372 : : }
373 : : else
374 : : is_string = 1;
375 : 0 : {
376 : 0 : const unsigned char *s = token->val.str.text;
377 : :
378 : 0 : for (; *s; s++)
379 : 0 : if (*s == '\\')
380 : : {
381 : 0 : s++;
382 : 0 : buffer = handle_escape_character (buffer, *s);
383 : 0 : if (buffer == NULL)
384 : : {
385 : 0 : supported = 0;
386 : 0 : break;
387 : : }
388 : : }
389 : : else
390 : 0 : *buffer++ = *s;
391 : : }
392 : : break;
393 : :
394 : 0 : case CPP_CHAR:
395 : 0 : is_char = 1;
396 : 0 : {
397 : 0 : unsigned chars_seen;
398 : 0 : int ignored;
399 : 0 : cppchar_t c;
400 : :
401 : 0 : c = cpp_interpret_charconst (parse_in, token,
402 : : &chars_seen, &ignored);
403 : 0 : if (c >= 32 && c <= 126)
404 : : {
405 : 0 : *buffer++ = '\'';
406 : 0 : *buffer++ = (char) c;
407 : 0 : *buffer++ = '\'';
408 : : }
409 : : else
410 : : {
411 : 0 : chars_seen = sprintf ((char *) buffer,
412 : : "Character'Val (%d)", (int) c);
413 : 0 : buffer += chars_seen;
414 : : }
415 : : }
416 : 0 : break;
417 : :
418 : 5 : case CPP_NUMBER:
419 : 5 : tmp = cpp_token_as_text (parse_in, token);
420 : :
421 : 5 : switch (*tmp)
422 : : {
423 : 5 : case '0':
424 : 5 : switch (tmp[1])
425 : : {
426 : 0 : case '\0':
427 : 0 : case 'l':
428 : 0 : case 'L':
429 : 0 : case 'u':
430 : 0 : case 'U':
431 : 0 : *buffer++ = '0';
432 : 0 : break;
433 : :
434 : 0 : case 'x':
435 : 0 : case 'X':
436 : 0 : *buffer++ = '1';
437 : 0 : *buffer++ = '6';
438 : 0 : *buffer++ = '#';
439 : 0 : buffer = dump_number (tmp + 2, buffer, false);
440 : 0 : *buffer++ = '#';
441 : 0 : break;
442 : :
443 : 0 : case 'b':
444 : 0 : case 'B':
445 : 0 : *buffer++ = '2';
446 : 0 : *buffer++ = '#';
447 : 0 : buffer = dump_number (tmp + 2, buffer, false);
448 : 0 : *buffer++ = '#';
449 : 0 : break;
450 : :
451 : 5 : default:
452 : : /* Dump floating-point constant unmodified. */
453 : 5 : if (strchr ((const char *)tmp, '.'))
454 : 5 : buffer = dump_number (tmp, buffer, true);
455 : : else
456 : : {
457 : 0 : *buffer++ = '8';
458 : 0 : *buffer++ = '#';
459 : 0 : buffer
460 : 0 : = dump_number (tmp + 1, buffer, false);
461 : 0 : *buffer++ = '#';
462 : : }
463 : : break;
464 : : }
465 : : break;
466 : :
467 : 0 : case '1':
468 : 0 : if (tmp[1] == '\0'
469 : : || tmp[1] == 'u'
470 : : || tmp[1] == 'U'
471 : : || tmp[1] == 'l'
472 : : || tmp[1] == 'L')
473 : : {
474 : 0 : is_one = 1;
475 : 0 : char_one = buffer;
476 : 0 : *buffer++ = '1';
477 : 0 : break;
478 : : }
479 : : /* fallthrough */
480 : :
481 : 0 : default:
482 : 0 : buffer
483 : 0 : = dump_number (tmp, buffer,
484 : 0 : strchr ((const char *)tmp, '.'));
485 : 0 : break;
486 : : }
487 : : break;
488 : :
489 : 0 : case CPP_LSHIFT:
490 : 0 : if (prev_is_one)
491 : : {
492 : : /* Replace "1 << N" by "2 ** N" */
493 : 0 : *char_one = '2';
494 : 0 : *buffer++ = '*';
495 : 0 : *buffer++ = '*';
496 : 0 : break;
497 : : }
498 : : /* fallthrough */
499 : :
500 : 0 : case CPP_RSHIFT:
501 : 0 : case CPP_COMPL:
502 : 0 : case CPP_QUERY:
503 : 0 : case CPP_EOF:
504 : 0 : case CPP_PLUS_EQ:
505 : 0 : case CPP_MINUS_EQ:
506 : 0 : case CPP_MULT_EQ:
507 : 0 : case CPP_DIV_EQ:
508 : 0 : case CPP_MOD_EQ:
509 : 0 : case CPP_AND_EQ:
510 : 0 : case CPP_OR_EQ:
511 : 0 : case CPP_XOR_EQ:
512 : 0 : case CPP_RSHIFT_EQ:
513 : 0 : case CPP_LSHIFT_EQ:
514 : 0 : case CPP_PRAGMA:
515 : 0 : case CPP_PRAGMA_EOL:
516 : 0 : case CPP_HASH:
517 : 0 : case CPP_PASTE:
518 : 0 : case CPP_OPEN_BRACE:
519 : 0 : case CPP_CLOSE_BRACE:
520 : 0 : case CPP_SEMICOLON:
521 : 0 : case CPP_ELLIPSIS:
522 : 0 : case CPP_PLUS_PLUS:
523 : 0 : case CPP_MINUS_MINUS:
524 : 0 : case CPP_DEREF_STAR:
525 : 0 : case CPP_DOT_STAR:
526 : 0 : case CPP_ATSIGN:
527 : 0 : case CPP_HEADER_NAME:
528 : 0 : case CPP_AT_NAME:
529 : 0 : case CPP_OTHER:
530 : 0 : case CPP_OBJC_STRING:
531 : 0 : default:
532 : 0 : if (!macro->fun_like)
533 : 0 : supported = 0;
534 : : else
535 : 0 : buffer = cpp_spell_token (parse_in, token, buffer, false);
536 : : break;
537 : : }
538 : :
539 : 5 : prev_is_one = is_one;
540 : : }
541 : :
542 : 5 : if (supported)
543 : 5 : *buffer = '\0';
544 : : }
545 : :
546 : 5 : if (macro->fun_like && supported)
547 : : {
548 : 0 : char *start = (char *) s;
549 : 0 : int is_function = 0;
550 : :
551 : 0 : pp_string (pp, " -- arg-macro: ");
552 : :
553 : 0 : if (*start == '(' && buffer[-1] == ')')
554 : : {
555 : 0 : start++;
556 : 0 : buffer[-1] = '\0';
557 : 0 : is_function = 1;
558 : 0 : pp_string (pp, "function ");
559 : : }
560 : : else
561 : : {
562 : 0 : pp_string (pp, "procedure ");
563 : : }
564 : :
565 : 0 : pp_string (pp, (const char *) NODE_NAME (node));
566 : 0 : pp_space (pp);
567 : 0 : pp_string (pp, (char *) params);
568 : 0 : pp_newline (pp);
569 : 0 : pp_string (pp, " -- ");
570 : :
571 : 0 : if (is_function)
572 : : {
573 : 0 : pp_string (pp, "return ");
574 : 0 : pp_string (pp, start);
575 : 0 : pp_semicolon (pp);
576 : : }
577 : : else
578 : 0 : pp_string (pp, start);
579 : :
580 : 0 : pp_newline (pp);
581 : 0 : }
582 : 5 : else if (supported)
583 : : {
584 : 5 : expanded_location sloc = expand_location (macro->line);
585 : :
586 : 5 : if (sloc.line != prev_line + 1 && prev_line > 0)
587 : 0 : pp_newline (pp);
588 : :
589 : 5 : num_macros++;
590 : 5 : prev_line = sloc.line;
591 : :
592 : 5 : pp_string (pp, " ");
593 : 5 : ada_name = to_ada_name ((const char *) NODE_NAME (node), NULL);
594 : 5 : pp_string (pp, ada_name);
595 : 5 : free (ada_name);
596 : 5 : pp_string (pp, " : ");
597 : :
598 : 5 : if (is_string)
599 : 0 : pp_string (pp, "aliased constant String");
600 : 5 : else if (is_char)
601 : 0 : pp_string (pp, "aliased constant Character");
602 : : else
603 : 5 : pp_string (pp, "constant");
604 : :
605 : 5 : pp_string (pp, " := ");
606 : 5 : pp_string (pp, (char *) s);
607 : :
608 : 5 : if (is_string)
609 : 0 : pp_string (pp, " & ASCII.NUL");
610 : :
611 : 5 : pp_string (pp, "; -- ");
612 : 5 : pp_string (pp, sloc.file);
613 : 5 : pp_colon (pp);
614 : 5 : pp_decimal_int (pp, sloc.line);
615 : 5 : pp_newline (pp);
616 : : }
617 : : else
618 : : {
619 : 0 : pp_string (pp, " -- unsupported macro: ");
620 : 0 : pp_string (pp, (const char *) cpp_macro_definition (parse_in, node));
621 : 0 : pp_newline (pp);
622 : : }
623 : : }
624 : :
625 : 115 : if (num_macros > 0)
626 : 5 : pp_newline (pp);
627 : 115 : }
628 : :
629 : : /* Current source file being handled. */
630 : : static const char *current_source_file;
631 : :
632 : : /* Return sloc of DECL, using sloc of last field if LAST is true. */
633 : :
634 : : static location_t
635 : 7396 : decl_sloc (const_tree decl, bool last)
636 : : {
637 : 7396 : tree field;
638 : :
639 : : /* Compare the declaration of struct-like types based on the sloc of their
640 : : last field (if LAST is true), so that more nested types collate before
641 : : less nested ones. */
642 : 7396 : if (TREE_CODE (decl) == TYPE_DECL
643 : 4337 : && !DECL_ORIGINAL_TYPE (decl)
644 : 3733 : && RECORD_OR_UNION_TYPE_P (TREE_TYPE (decl))
645 : 10169 : && (field = TYPE_FIELDS (TREE_TYPE (decl))))
646 : : {
647 : 2672 : if (last)
648 : 6017 : while (DECL_CHAIN (field))
649 : 4079 : field = DECL_CHAIN (field);
650 : 2672 : return DECL_SOURCE_LOCATION (field);
651 : : }
652 : :
653 : 4724 : return DECL_SOURCE_LOCATION (decl);
654 : : }
655 : :
656 : : /* Compare two locations LHS and RHS. */
657 : :
658 : : static int
659 : 2615 : compare_location (location_t lhs, location_t rhs)
660 : : {
661 : 2615 : expanded_location xlhs = expand_location (lhs);
662 : 2615 : expanded_location xrhs = expand_location (rhs);
663 : :
664 : 2615 : if (xlhs.file != xrhs.file)
665 : 0 : return filename_cmp (xlhs.file, xrhs.file);
666 : :
667 : 2615 : if (xlhs.line != xrhs.line)
668 : 2178 : return xlhs.line - xrhs.line;
669 : :
670 : 437 : if (xlhs.column != xrhs.column)
671 : 421 : return xlhs.column - xrhs.column;
672 : :
673 : : return 0;
674 : : }
675 : :
676 : : /* Compare two declarations (LP and RP) by their source location. */
677 : :
678 : : static int
679 : 2615 : compare_node (const void *lp, const void *rp)
680 : : {
681 : 2615 : const_tree lhs = *((const tree *) lp);
682 : 2615 : const_tree rhs = *((const tree *) rp);
683 : 2615 : const int ret
684 : 2615 : = compare_location (decl_sloc (lhs, true), decl_sloc (rhs, true));
685 : :
686 : 2615 : return ret ? ret : DECL_UID (lhs) - DECL_UID (rhs);
687 : : }
688 : :
689 : : /* Compare two comments (LP and RP) by their source location. */
690 : :
691 : : static int
692 : 0 : compare_comment (const void *lp, const void *rp)
693 : : {
694 : 0 : const cpp_comment *lhs = (const cpp_comment *) lp;
695 : 0 : const cpp_comment *rhs = (const cpp_comment *) rp;
696 : :
697 : 0 : return compare_location (lhs->sloc, rhs->sloc);
698 : : }
699 : :
700 : : static tree *to_dump = NULL;
701 : : static int to_dump_count = 0;
702 : :
703 : : /* Collect a list of declarations from T relevant to SOURCE_FILE to be dumped
704 : : by a subsequent call to dump_ada_nodes. */
705 : :
706 : : void
707 : 334 : collect_ada_nodes (tree t, const char *source_file)
708 : : {
709 : 334 : tree n;
710 : 334 : int i = to_dump_count;
711 : :
712 : : /* Count the likely relevant nodes: do not dump builtins (they are irrelevant
713 : : in the context of bindings) and namespaces (we do not handle them properly
714 : : yet). */
715 : 315317 : for (n = t; n; n = TREE_CHAIN (n))
716 : 314983 : if (!DECL_IS_UNDECLARED_BUILTIN (n)
717 : 398 : && TREE_CODE (n) != NAMESPACE_DECL
718 : 315381 : && LOCATION_FILE (decl_sloc (n, false)) == source_file)
719 : 390 : to_dump_count++;
720 : :
721 : : /* Allocate sufficient storage for all nodes. */
722 : 334 : to_dump = XRESIZEVEC (tree, to_dump, to_dump_count);
723 : :
724 : : /* Store the relevant nodes. */
725 : 315317 : for (n = t; n; n = TREE_CHAIN (n))
726 : 314983 : if (!DECL_IS_UNDECLARED_BUILTIN (n)
727 : 398 : && TREE_CODE (n) != NAMESPACE_DECL
728 : 315381 : && LOCATION_FILE (decl_sloc (n, false)) == source_file)
729 : 390 : to_dump[i++] = n;
730 : 334 : }
731 : :
732 : : /* Call back for walk_tree to clear the TREE_VISITED flag of TP. */
733 : :
734 : : static tree
735 : 390 : unmark_visited_r (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED,
736 : : void *data ATTRIBUTE_UNUSED)
737 : : {
738 : 390 : if (TREE_VISITED (*tp))
739 : 194 : TREE_VISITED (*tp) = 0;
740 : : else
741 : 196 : *walk_subtrees = 0;
742 : :
743 : 390 : return NULL_TREE;
744 : : }
745 : :
746 : : /* Print a COMMENT to the output stream PP. */
747 : :
748 : : static void
749 : 0 : print_comment (pretty_printer *pp, const char *comment)
750 : : {
751 : 0 : int len = strlen (comment);
752 : 0 : char *str = XALLOCAVEC (char, len + 1);
753 : 0 : char *tok;
754 : 0 : bool extra_newline = false;
755 : :
756 : 0 : memcpy (str, comment, len + 1);
757 : :
758 : : /* Trim C/C++ comment indicators. */
759 : 0 : if (str[len - 2] == '*' && str[len - 1] == '/')
760 : : {
761 : 0 : str[len - 2] = ' ';
762 : 0 : str[len - 1] = '\0';
763 : : }
764 : 0 : str += 2;
765 : :
766 : 0 : tok = strtok (str, "\n");
767 : 0 : while (tok) {
768 : 0 : pp_string (pp, " --");
769 : 0 : pp_string (pp, tok);
770 : 0 : pp_newline (pp);
771 : 0 : tok = strtok (NULL, "\n");
772 : :
773 : : /* Leave a blank line after multi-line comments. */
774 : 0 : if (tok)
775 : : extra_newline = true;
776 : : }
777 : :
778 : 0 : if (extra_newline)
779 : 0 : pp_newline (pp);
780 : 0 : }
781 : :
782 : : /* Dump nodes into PP relevant to SOURCE_FILE, as collected by previous calls
783 : : to collect_ada_nodes. */
784 : :
785 : : static void
786 : 115 : dump_ada_nodes (pretty_printer *pp, const char *source_file)
787 : : {
788 : 115 : int i, j;
789 : 115 : cpp_comment_table *comments;
790 : :
791 : : /* Sort the table of declarations to dump by sloc. */
792 : 115 : qsort (to_dump, to_dump_count, sizeof (tree), compare_node);
793 : :
794 : : /* Fetch the table of comments. */
795 : 115 : comments = cpp_get_comments (parse_in);
796 : :
797 : : /* Sort the comments table by sloc. */
798 : 115 : if (comments->count > 1)
799 : 0 : qsort (comments->entries, comments->count, sizeof (cpp_comment),
800 : : compare_comment);
801 : :
802 : : /* Interleave comments and declarations in line number order. */
803 : : i = j = 0;
804 : : do
805 : : {
806 : : /* Advance j until comment j is in this file. */
807 : 115 : while (j != comments->count
808 : 115 : && LOCATION_FILE (comments->entries[j].sloc) != source_file)
809 : 0 : j++;
810 : :
811 : : /* Advance j until comment j is not a duplicate. */
812 : 115 : while (j < comments->count - 1
813 : 115 : && !compare_comment (&comments->entries[j],
814 : 0 : &comments->entries[j + 1]))
815 : 0 : j++;
816 : :
817 : : /* Write decls until decl i collates after comment j. */
818 : 505 : while (i != to_dump_count)
819 : : {
820 : 390 : if (j == comments->count
821 : 390 : || LOCATION_LINE (decl_sloc (to_dump[i], false))
822 : 0 : < LOCATION_LINE (comments->entries[j].sloc))
823 : : {
824 : 390 : current_source_file = source_file;
825 : :
826 : 390 : if (dump_ada_declaration (pp, to_dump[i++], NULL_TREE,
827 : : INDENT_INCR))
828 : : {
829 : 260 : pp_newline (pp);
830 : 260 : pp_newline (pp);
831 : : }
832 : : }
833 : : else
834 : : break;
835 : : }
836 : :
837 : : /* Write comment j, if there is one. */
838 : 115 : if (j != comments->count)
839 : 0 : print_comment (pp, comments->entries[j++].comment);
840 : :
841 : 115 : } while (i != to_dump_count || j != comments->count);
842 : :
843 : : /* Clear the TREE_VISITED flag over each subtree we've dumped. */
844 : 505 : for (i = 0; i < to_dump_count; i++)
845 : 390 : walk_tree (&to_dump[i], unmark_visited_r, NULL, NULL);
846 : :
847 : : /* Finalize the to_dump table. */
848 : 115 : if (to_dump)
849 : : {
850 : 115 : free (to_dump);
851 : 115 : to_dump = NULL;
852 : 115 : to_dump_count = 0;
853 : : }
854 : 115 : }
855 : :
856 : : /* Dump a newline and indent BUFFER by SPC chars. */
857 : :
858 : : static void
859 : 976 : newline_and_indent (pretty_printer *buffer, int spc)
860 : : {
861 : 976 : pp_newline (buffer);
862 : 7322 : INDENT (spc);
863 : 976 : }
864 : :
865 : : struct with { char *s; const char *in_file; bool limited; };
866 : : static struct with *withs = NULL;
867 : : static int withs_max = 4096;
868 : : static int with_len = 0;
869 : :
870 : : /* Record a "with" clause on package S (a limited with if LIMITED_ACCESS is
871 : : true), if not already done. */
872 : :
873 : : static void
874 : 0 : append_withs (const char *s, bool limited_access)
875 : : {
876 : 0 : int i;
877 : :
878 : 0 : if (withs == NULL)
879 : 0 : withs = XNEWVEC (struct with, withs_max);
880 : :
881 : 0 : if (with_len == withs_max)
882 : : {
883 : 0 : withs_max *= 2;
884 : 0 : withs = XRESIZEVEC (struct with, withs, withs_max);
885 : : }
886 : :
887 : 0 : for (i = 0; i < with_len; i++)
888 : 0 : if (!strcmp (s, withs[i].s)
889 : 0 : && current_source_file == withs[i].in_file)
890 : : {
891 : 0 : withs[i].limited &= limited_access;
892 : 0 : return;
893 : : }
894 : :
895 : 0 : withs[with_len].s = xstrdup (s);
896 : 0 : withs[with_len].in_file = current_source_file;
897 : 0 : withs[with_len].limited = limited_access;
898 : 0 : with_len++;
899 : : }
900 : :
901 : : /* Reset "with" clauses. */
902 : :
903 : : static void
904 : 115 : reset_ada_withs (void)
905 : : {
906 : 115 : int i;
907 : :
908 : 115 : if (!withs)
909 : : return;
910 : :
911 : 0 : for (i = 0; i < with_len; i++)
912 : 0 : free (withs[i].s);
913 : 0 : free (withs);
914 : 0 : withs = NULL;
915 : 0 : withs_max = 4096;
916 : 0 : with_len = 0;
917 : : }
918 : :
919 : : /* Dump "with" clauses in F. */
920 : :
921 : : static void
922 : 115 : dump_ada_withs (FILE *f)
923 : : {
924 : 115 : int i;
925 : :
926 : 115 : fprintf (f, "with Interfaces.C; use Interfaces.C;\n");
927 : :
928 : 230 : for (i = 0; i < with_len; i++)
929 : 0 : fprintf
930 : 0 : (f, "%swith %s;\n", withs[i].limited ? "limited " : "", withs[i].s);
931 : 115 : }
932 : :
933 : : /* Return suitable Ada package name from FILE. */
934 : :
935 : : static char *
936 : 115 : get_ada_package (const char *file)
937 : : {
938 : 115 : const char *base;
939 : 115 : char *res;
940 : 115 : const char *s;
941 : 115 : int i;
942 : 115 : size_t plen;
943 : :
944 : 115 : s = strstr (file, "/include/");
945 : 115 : if (s)
946 : 0 : base = s + 9;
947 : : else
948 : 115 : base = lbasename (file);
949 : :
950 : 115 : if (ada_specs_parent == NULL)
951 : : plen = 0;
952 : : else
953 : 0 : plen = strlen (ada_specs_parent) + 1;
954 : :
955 : 115 : res = XNEWVEC (char, plen + strlen (base) + 1);
956 : 115 : if (ada_specs_parent != NULL) {
957 : 0 : strcpy (res, ada_specs_parent);
958 : 0 : res[plen - 1] = '.';
959 : : }
960 : :
961 : 2104 : for (i = plen; *base; base++, i++)
962 : 1989 : switch (*base)
963 : : {
964 : 0 : case '+':
965 : 0 : res[i] = 'p';
966 : 0 : break;
967 : :
968 : 460 : case '.':
969 : 460 : case '-':
970 : 460 : case '_':
971 : 460 : case '/':
972 : 460 : case '\\':
973 : 460 : res[i] = (i == 0 || res[i - 1] == '.' || res[i - 1] == '_') ? 'u' : '_';
974 : 460 : break;
975 : :
976 : 1529 : default:
977 : 1529 : res[i] = *base;
978 : 1529 : break;
979 : : }
980 : 115 : res[i] = '\0';
981 : :
982 : 115 : return res;
983 : : }
984 : :
985 : : static const char *ada_reserved[] = {
986 : : "abort", "abs", "abstract", "accept", "access", "aliased", "all", "and",
987 : : "array", "at", "begin", "body", "case", "constant", "declare", "delay",
988 : : "delta", "digits", "do", "else", "elsif", "end", "entry", "exception",
989 : : "exit", "for", "function", "generic", "goto", "if", "in", "interface", "is",
990 : : "limited", "loop", "mod", "new", "not", "null", "others", "out", "of", "or",
991 : : "overriding", "package", "pragma", "private", "procedure", "protected",
992 : : "raise", "range", "record", "rem", "renames", "requeue", "return", "reverse",
993 : : "select", "separate", "subtype", "synchronized", "tagged", "task",
994 : : "terminate", "then", "type", "until", "use", "when", "while", "with", "xor",
995 : : NULL};
996 : :
997 : : /* ??? would be nice to specify this list via a config file, so that users
998 : : can create their own dictionary of conflicts. */
999 : : static const char *c_duplicates[] = {
1000 : : /* system will cause troubles with System.Address. */
1001 : : "system",
1002 : :
1003 : : /* The following values have other definitions with same name/other
1004 : : casing. */
1005 : : "funmap",
1006 : : "rl_vi_fWord",
1007 : : "rl_vi_bWord",
1008 : : "rl_vi_eWord",
1009 : : "rl_readline_version",
1010 : : "_Vx_ushort",
1011 : : "USHORT",
1012 : : "XLookupKeysym",
1013 : : NULL};
1014 : :
1015 : : /* Return a declaration tree corresponding to TYPE. */
1016 : :
1017 : : static tree
1018 : 2026 : get_underlying_decl (tree type)
1019 : : {
1020 : 2026 : if (!type)
1021 : : return NULL_TREE;
1022 : :
1023 : : /* type is a declaration. */
1024 : 1895 : if (DECL_P (type))
1025 : : return type;
1026 : :
1027 : 693 : if (TYPE_P (type))
1028 : : {
1029 : : /* Strip qualifiers but do not look through typedefs. */
1030 : 693 : if (TYPE_QUALS_NO_ADDR_SPACE (type))
1031 : 10 : type = TYPE_MAIN_VARIANT (type);
1032 : :
1033 : : /* type is a typedef. */
1034 : 693 : if (TYPE_NAME (type) && DECL_P (TYPE_NAME (type)))
1035 : 402 : return TYPE_NAME (type);
1036 : :
1037 : : /* TYPE_STUB_DECL has been set for type. */
1038 : 291 : if (TYPE_STUB_DECL (type))
1039 : 74 : return TYPE_STUB_DECL (type);
1040 : : }
1041 : :
1042 : : return NULL_TREE;
1043 : : }
1044 : :
1045 : : /* Return whether TYPE has static fields. */
1046 : :
1047 : : static bool
1048 : 112 : has_static_fields (const_tree type)
1049 : : {
1050 : 112 : if (!type || !RECORD_OR_UNION_TYPE_P (type) || !COMPLETE_TYPE_P (type))
1051 : : return false;
1052 : :
1053 : 416 : for (tree fld = TYPE_FIELDS (type); fld; fld = TREE_CHAIN (fld))
1054 : 304 : if (VAR_P (fld) && DECL_NAME (fld))
1055 : : return true;
1056 : :
1057 : : return false;
1058 : : }
1059 : :
1060 : : /* Return whether TYPE corresponds to an Ada tagged type (has a dispatch
1061 : : table). */
1062 : :
1063 : : static bool
1064 : 278 : is_tagged_type (const_tree type)
1065 : : {
1066 : 278 : if (!type || !RECORD_OR_UNION_TYPE_P (type) || !COMPLETE_TYPE_P (type))
1067 : : return false;
1068 : :
1069 : 1046 : for (tree fld = TYPE_FIELDS (type); fld; fld = TREE_CHAIN (fld))
1070 : 862 : if (TREE_CODE (fld) == FUNCTION_DECL && DECL_VINDEX (fld))
1071 : : return true;
1072 : :
1073 : : return false;
1074 : : }
1075 : :
1076 : : /* Return whether TYPE has non-trivial methods, i.e. methods that do something
1077 : : for the objects of TYPE. In C++, all classes have implicit special methods,
1078 : : e.g. constructors and destructors, but they can be trivial if the type is
1079 : : sufficiently simple. */
1080 : :
1081 : : static bool
1082 : 586 : has_nontrivial_methods (tree type)
1083 : : {
1084 : 586 : if (!type || !RECORD_OR_UNION_TYPE_P (type) || !COMPLETE_TYPE_P (type))
1085 : : return false;
1086 : :
1087 : : /* Only C++ types can have methods. */
1088 : 575 : if (!cpp_check)
1089 : : return false;
1090 : :
1091 : : /* A non-trivial type has non-trivial special methods. */
1092 : 488 : if (!cpp_check (type, IS_TRIVIAL))
1093 : : return true;
1094 : :
1095 : : /* If there are user-defined methods, they are deemed non-trivial. */
1096 : 1688 : for (tree fld = TYPE_FIELDS (type); fld; fld = DECL_CHAIN (fld))
1097 : 1288 : if (TREE_CODE (fld) == FUNCTION_DECL && !DECL_ARTIFICIAL (fld))
1098 : : return true;
1099 : :
1100 : : return false;
1101 : : }
1102 : :
1103 : : #define INDEX_LENGTH 8
1104 : :
1105 : : /* Generate a legal Ada name from a C/C++ NAME and return a malloc'ed string.
1106 : : SPACE_FOUND, if not NULL, is used to indicate whether a space was found in
1107 : : NAME. */
1108 : :
1109 : : static char *
1110 : 1463 : to_ada_name (const char *name, bool *space_found)
1111 : : {
1112 : 1463 : const char **names;
1113 : 1463 : const int len = strlen (name);
1114 : 1463 : int j, len2 = 0;
1115 : 1463 : bool found = false;
1116 : 1463 : char *s = XNEWVEC (char, len * 2 + 5);
1117 : 1463 : char c;
1118 : :
1119 : 1463 : if (space_found)
1120 : 1458 : *space_found = false;
1121 : :
1122 : : /* Add "c_" prefix if name is an Ada reserved word. */
1123 : 106059 : for (names = ada_reserved; *names; names++)
1124 : 104616 : if (!strcasecmp (name, *names))
1125 : : {
1126 : 20 : s[len2++] = 'c';
1127 : 20 : s[len2++] = '_';
1128 : 20 : found = true;
1129 : 20 : break;
1130 : : }
1131 : :
1132 : 1463 : if (!found)
1133 : : /* Add "c_" prefix if name is a potential case sensitive duplicate. */
1134 : 14430 : for (names = c_duplicates; *names; names++)
1135 : 12987 : if (!strcmp (name, *names))
1136 : : {
1137 : 0 : s[len2++] = 'c';
1138 : 0 : s[len2++] = '_';
1139 : 0 : found = true;
1140 : 0 : break;
1141 : : }
1142 : :
1143 : 1483 : for (j = 0; name[j] == '_'; j++)
1144 : 20 : s[len2++] = 'u';
1145 : :
1146 : 1463 : if (j > 0)
1147 : 10 : s[len2++] = '_';
1148 : 1453 : else if (*name == '.' || *name == '$')
1149 : : {
1150 : 112 : s[0] = 'a';
1151 : 112 : s[1] = 'n';
1152 : 112 : s[2] = 'o';
1153 : 112 : s[3] = 'n';
1154 : 112 : len2 = 4;
1155 : 112 : j++;
1156 : : }
1157 : :
1158 : : /* Replace unsuitable characters for Ada identifiers. */
1159 : 7394 : for (; j < len; j++)
1160 : 5931 : switch (name[j])
1161 : : {
1162 : 16 : case ' ':
1163 : 16 : if (space_found)
1164 : 16 : *space_found = true;
1165 : 16 : s[len2++] = '_';
1166 : 16 : break;
1167 : :
1168 : : /* ??? missing some C++ operators. */
1169 : 0 : case '=':
1170 : 0 : s[len2++] = '_';
1171 : :
1172 : 0 : if (name[j + 1] == '=')
1173 : : {
1174 : 0 : j++;
1175 : 0 : s[len2++] = 'e';
1176 : 0 : s[len2++] = 'q';
1177 : : }
1178 : : else
1179 : : {
1180 : 0 : s[len2++] = 'a';
1181 : 0 : s[len2++] = 's';
1182 : : }
1183 : : break;
1184 : :
1185 : 0 : case '!':
1186 : 0 : s[len2++] = '_';
1187 : 0 : if (name[j + 1] == '=')
1188 : : {
1189 : 0 : j++;
1190 : 0 : s[len2++] = 'n';
1191 : 0 : s[len2++] = 'e';
1192 : : }
1193 : : break;
1194 : :
1195 : 0 : case '~':
1196 : 0 : s[len2++] = '_';
1197 : 0 : s[len2++] = 't';
1198 : 0 : s[len2++] = 'i';
1199 : 0 : break;
1200 : :
1201 : 0 : case '&':
1202 : 0 : case '|':
1203 : 0 : case '^':
1204 : 0 : s[len2++] = '_';
1205 : 0 : s[len2++] = name[j] == '&' ? 'a' : name[j] == '|' ? 'o' : 'x';
1206 : :
1207 : 0 : if (name[j + 1] == '=')
1208 : : {
1209 : 0 : j++;
1210 : 0 : s[len2++] = 'e';
1211 : : }
1212 : : break;
1213 : :
1214 : 0 : case '+':
1215 : 0 : case '-':
1216 : 0 : case '*':
1217 : 0 : case '/':
1218 : 0 : case '(':
1219 : 0 : case '[':
1220 : 0 : if (s[len2 - 1] != '_')
1221 : 0 : s[len2++] = '_';
1222 : :
1223 : 0 : switch (name[j + 1]) {
1224 : 0 : case '\0':
1225 : 0 : j++;
1226 : 0 : switch (name[j - 1]) {
1227 : 0 : case '+': s[len2++] = 'p'; break; /* + */
1228 : 0 : case '-': s[len2++] = 'm'; break; /* - */
1229 : 0 : case '*': s[len2++] = 't'; break; /* * */
1230 : 0 : case '/': s[len2++] = 'd'; break; /* / */
1231 : : }
1232 : : break;
1233 : :
1234 : 0 : case '=':
1235 : 0 : j++;
1236 : 0 : switch (name[j - 1]) {
1237 : 0 : case '+': s[len2++] = 'p'; break; /* += */
1238 : 0 : case '-': s[len2++] = 'm'; break; /* -= */
1239 : 0 : case '*': s[len2++] = 't'; break; /* *= */
1240 : 0 : case '/': s[len2++] = 'd'; break; /* /= */
1241 : : }
1242 : 0 : s[len2++] = 'a';
1243 : 0 : break;
1244 : :
1245 : 0 : case '-': /* -- */
1246 : 0 : j++;
1247 : 0 : s[len2++] = 'm';
1248 : 0 : s[len2++] = 'm';
1249 : 0 : break;
1250 : :
1251 : 0 : case '+': /* ++ */
1252 : 0 : j++;
1253 : 0 : s[len2++] = 'p';
1254 : 0 : s[len2++] = 'p';
1255 : 0 : break;
1256 : :
1257 : 0 : case ')': /* () */
1258 : 0 : j++;
1259 : 0 : s[len2++] = 'o';
1260 : 0 : s[len2++] = 'p';
1261 : 0 : break;
1262 : :
1263 : 0 : case ']': /* [] */
1264 : 0 : j++;
1265 : 0 : s[len2++] = 'o';
1266 : 0 : s[len2++] = 'b';
1267 : 0 : break;
1268 : : }
1269 : :
1270 : : break;
1271 : :
1272 : 0 : case '<':
1273 : 0 : case '>':
1274 : 0 : c = name[j] == '<' ? 'l' : 'g';
1275 : 0 : s[len2++] = '_';
1276 : :
1277 : 0 : switch (name[j + 1]) {
1278 : 0 : case '\0':
1279 : 0 : s[len2++] = c;
1280 : 0 : s[len2++] = 't';
1281 : 0 : break;
1282 : 0 : case '=':
1283 : 0 : j++;
1284 : 0 : s[len2++] = c;
1285 : 0 : s[len2++] = 'e';
1286 : 0 : break;
1287 : 0 : case '>':
1288 : 0 : j++;
1289 : 0 : s[len2++] = 's';
1290 : 0 : s[len2++] = 'r';
1291 : 0 : break;
1292 : 0 : case '<':
1293 : 0 : j++;
1294 : 0 : s[len2++] = 's';
1295 : 0 : s[len2++] = 'l';
1296 : 0 : break;
1297 : : default:
1298 : : break;
1299 : : }
1300 : : break;
1301 : :
1302 : 424 : case '_':
1303 : 424 : if (len2 && s[len2 - 1] == '_')
1304 : 0 : s[len2++] = 'u';
1305 : : /* fall through */
1306 : :
1307 : 5915 : default:
1308 : 5915 : s[len2++] = name[j];
1309 : : }
1310 : :
1311 : 1463 : if (s[len2 - 1] == '_')
1312 : 0 : s[len2++] = 'u';
1313 : :
1314 : 1463 : s[len2] = '\0';
1315 : :
1316 : 1463 : return s;
1317 : : }
1318 : :
1319 : : /* Return true if DECL refers to a C++ class type for which a
1320 : : separate enclosing package has been or should be generated. */
1321 : :
1322 : : static bool
1323 : 136 : separate_class_package (tree decl)
1324 : : {
1325 : 136 : tree type = TREE_TYPE (decl);
1326 : 136 : return has_nontrivial_methods (type) || has_static_fields (type);
1327 : : }
1328 : :
1329 : : static bool package_prefix = true;
1330 : :
1331 : : /* Dump in BUFFER the name of an identifier NODE of type TYPE, following Ada
1332 : : syntax. LIMITED_ACCESS indicates whether NODE can be accessed through a
1333 : : limited 'with' clause rather than a regular 'with' clause. */
1334 : :
1335 : : static void
1336 : 1458 : pp_ada_tree_identifier (pretty_printer *buffer, tree node, tree type,
1337 : : bool limited_access)
1338 : : {
1339 : 1458 : const char *name = IDENTIFIER_POINTER (node);
1340 : 1458 : bool space_found = false;
1341 : 1458 : char *s = to_ada_name (name, &space_found);
1342 : 1458 : tree decl = get_underlying_decl (type);
1343 : :
1344 : 1458 : if (decl)
1345 : : {
1346 : : /* If the entity comes from another file, generate a package prefix. */
1347 : 1327 : const expanded_location xloc = expand_location (decl_sloc (decl, false));
1348 : :
1349 : 1327 : if (xloc.line && xloc.file && xloc.file != current_source_file)
1350 : : {
1351 : 0 : switch (TREE_CODE (type))
1352 : : {
1353 : 0 : case ENUMERAL_TYPE:
1354 : 0 : case INTEGER_TYPE:
1355 : 0 : case REAL_TYPE:
1356 : 0 : case FIXED_POINT_TYPE:
1357 : 0 : case BOOLEAN_TYPE:
1358 : 0 : case REFERENCE_TYPE:
1359 : 0 : case POINTER_TYPE:
1360 : 0 : case ARRAY_TYPE:
1361 : 0 : case RECORD_TYPE:
1362 : 0 : case UNION_TYPE:
1363 : 0 : case TYPE_DECL:
1364 : 0 : if (package_prefix)
1365 : : {
1366 : 0 : char *s1 = get_ada_package (xloc.file);
1367 : 0 : append_withs (s1, limited_access);
1368 : 0 : pp_string (buffer, s1);
1369 : 0 : pp_dot (buffer);
1370 : 0 : free (s1);
1371 : : }
1372 : : break;
1373 : : default:
1374 : : break;
1375 : : }
1376 : :
1377 : : /* Generate the additional package prefix for C++ classes. */
1378 : 0 : if (separate_class_package (decl))
1379 : : {
1380 : 0 : pp_string (buffer, "Class_");
1381 : 0 : pp_string (buffer, s);
1382 : 0 : pp_dot (buffer);
1383 : : }
1384 : : }
1385 : : }
1386 : :
1387 : 1458 : if (space_found)
1388 : 16 : if (!strcmp (s, "short_int"))
1389 : 0 : pp_string (buffer, "short");
1390 : 16 : else if (!strcmp (s, "short_unsigned_int"))
1391 : 0 : pp_string (buffer, "unsigned_short");
1392 : 16 : else if (!strcmp (s, "unsigned_int"))
1393 : 0 : pp_string (buffer, "unsigned");
1394 : 16 : else if (!strcmp (s, "long_int"))
1395 : 0 : pp_string (buffer, "long");
1396 : 16 : else if (!strcmp (s, "long_unsigned_int"))
1397 : 0 : pp_string (buffer, "unsigned_long");
1398 : 16 : else if (!strcmp (s, "long_long_int"))
1399 : 0 : pp_string (buffer, "Long_Long_Integer");
1400 : 16 : else if (!strcmp (s, "long_long_unsigned_int"))
1401 : : {
1402 : 0 : if (package_prefix)
1403 : : {
1404 : 0 : append_withs ("Interfaces.C.Extensions", false);
1405 : 0 : pp_string (buffer, "Extensions.unsigned_long_long");
1406 : : }
1407 : : else
1408 : 0 : pp_string (buffer, "unsigned_long_long");
1409 : : }
1410 : : else
1411 : 16 : pp_string(buffer, s);
1412 : : else
1413 : 1442 : if (!strcmp (s, "u_Bool") || !strcmp (s, "bool"))
1414 : : {
1415 : 0 : if (package_prefix)
1416 : : {
1417 : 0 : append_withs ("Interfaces.C.Extensions", false);
1418 : 0 : pp_string (buffer, "Extensions.bool");
1419 : : }
1420 : : else
1421 : 0 : pp_string (buffer, "bool");
1422 : : }
1423 : : else
1424 : 1442 : pp_string(buffer, s);
1425 : :
1426 : 1458 : free (s);
1427 : 1458 : }
1428 : :
1429 : : /* Dump in BUFFER the assembly name of T. */
1430 : :
1431 : : static void
1432 : 153 : pp_asm_name (pretty_printer *buffer, tree t)
1433 : : {
1434 : 153 : tree name = DECL_ASSEMBLER_NAME (t);
1435 : 153 : char *ada_name = XALLOCAVEC (char, IDENTIFIER_LENGTH (name) + 1), *s;
1436 : 153 : const char *ident = IDENTIFIER_POINTER (name);
1437 : :
1438 : 2493 : for (s = ada_name; *ident; ident++)
1439 : : {
1440 : 2340 : if (*ident == ' ')
1441 : : break;
1442 : 2340 : else if (*ident != '*')
1443 : 2340 : *s++ = *ident;
1444 : : }
1445 : :
1446 : 153 : *s = '\0';
1447 : 153 : pp_string (buffer, ada_name);
1448 : 153 : }
1449 : :
1450 : : /* Dump in BUFFER the name of a DECL node if set, in Ada syntax.
1451 : : LIMITED_ACCESS indicates whether NODE can be accessed via a
1452 : : limited 'with' clause rather than a regular 'with' clause. */
1453 : :
1454 : : static void
1455 : 1047 : dump_ada_decl_name (pretty_printer *buffer, tree decl, bool limited_access)
1456 : : {
1457 : 1047 : if (DECL_NAME (decl))
1458 : 1040 : pp_ada_tree_identifier (buffer, DECL_NAME (decl), decl, limited_access);
1459 : : else
1460 : : {
1461 : 7 : tree type_name = TYPE_NAME (TREE_TYPE (decl));
1462 : :
1463 : 7 : if (!type_name)
1464 : : {
1465 : 0 : pp_string (buffer, "anon");
1466 : 0 : if (TREE_CODE (decl) == FIELD_DECL)
1467 : 0 : pp_decimal_int (buffer, DECL_UID (decl));
1468 : : else
1469 : 0 : pp_decimal_int (buffer, TYPE_UID (TREE_TYPE (decl)));
1470 : : }
1471 : 7 : else if (TREE_CODE (type_name) == IDENTIFIER_NODE)
1472 : 7 : pp_ada_tree_identifier (buffer, type_name, decl, limited_access);
1473 : : }
1474 : 1047 : }
1475 : :
1476 : : /* Dump in BUFFER a name for the type T, which is a TYPE without TYPE_NAME. */
1477 : :
1478 : : static void
1479 : 84 : dump_anonymous_type_name (pretty_printer *buffer, tree t)
1480 : : {
1481 : 84 : pp_string (buffer, "anon");
1482 : :
1483 : 84 : switch (TREE_CODE (t))
1484 : : {
1485 : 58 : case ARRAY_TYPE:
1486 : 58 : pp_string (buffer, "_array");
1487 : 58 : break;
1488 : 10 : case ENUMERAL_TYPE:
1489 : 10 : pp_string (buffer, "_enum");
1490 : 10 : break;
1491 : 14 : case RECORD_TYPE:
1492 : 14 : pp_string (buffer, "_struct");
1493 : 14 : break;
1494 : 2 : case UNION_TYPE:
1495 : 2 : pp_string (buffer, "_union");
1496 : 2 : break;
1497 : 0 : default:
1498 : 0 : pp_string (buffer, "_unknown");
1499 : 0 : break;
1500 : : }
1501 : :
1502 : 84 : pp_decimal_int (buffer, TYPE_UID (t));
1503 : 84 : }
1504 : :
1505 : : /* Dump in BUFFER aspect Import on a given node T. SPC is the current
1506 : : indentation level. */
1507 : :
1508 : : static void
1509 : 137 : dump_ada_import (pretty_printer *buffer, tree t, int spc)
1510 : : {
1511 : 137 : const char *name = IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (t));
1512 : 137 : const bool is_stdcall
1513 : 137 : = TREE_CODE (t) == FUNCTION_DECL
1514 : 137 : && lookup_attribute ("stdcall", TYPE_ATTRIBUTES (TREE_TYPE (t)));
1515 : :
1516 : 137 : pp_string (buffer, "with Import => True, ");
1517 : :
1518 : 137 : newline_and_indent (buffer, spc + 5);
1519 : :
1520 : 137 : if (is_stdcall)
1521 : 0 : pp_string (buffer, "Convention => Stdcall, ");
1522 : 137 : else if (name[0] == '_' && name[1] == 'Z')
1523 : 124 : pp_string (buffer, "Convention => CPP, ");
1524 : : else
1525 : 13 : pp_string (buffer, "Convention => C, ");
1526 : :
1527 : 137 : newline_and_indent (buffer, spc + 5);
1528 : :
1529 : 137 : tree sec = lookup_attribute ("section", DECL_ATTRIBUTES (t));
1530 : 137 : if (sec)
1531 : : {
1532 : 0 : pp_string (buffer, "Linker_Section => \"");
1533 : 0 : pp_string (buffer, TREE_STRING_POINTER (TREE_VALUE (TREE_VALUE (sec))));
1534 : 0 : pp_string (buffer, "\", ");
1535 : 0 : newline_and_indent (buffer, spc + 5);
1536 : : }
1537 : :
1538 : 137 : pp_string (buffer, "External_Name => \"");
1539 : :
1540 : 137 : if (is_stdcall)
1541 : 0 : pp_string (buffer, IDENTIFIER_POINTER (DECL_NAME (t)));
1542 : : else
1543 : 137 : pp_asm_name (buffer, t);
1544 : :
1545 : 137 : pp_string (buffer, "\";");
1546 : 137 : }
1547 : :
1548 : : /* Check whether T and its type have different names, and append "the_"
1549 : : otherwise in BUFFER. */
1550 : :
1551 : : static void
1552 : 276 : check_type_name_conflict (pretty_printer *buffer, tree t)
1553 : : {
1554 : 276 : tree tmp = TREE_TYPE (t);
1555 : :
1556 : 373 : while (TREE_CODE (tmp) == POINTER_TYPE && !TYPE_NAME (tmp))
1557 : 97 : tmp = TREE_TYPE (tmp);
1558 : :
1559 : 276 : if (TREE_CODE (tmp) != FUNCTION_TYPE)
1560 : : {
1561 : 271 : const char *s;
1562 : :
1563 : 271 : if (TREE_CODE (tmp) == IDENTIFIER_NODE)
1564 : 0 : s = IDENTIFIER_POINTER (tmp);
1565 : 271 : else if (!TYPE_NAME (tmp))
1566 : : s = "";
1567 : 255 : else if (TREE_CODE (TYPE_NAME (tmp)) == IDENTIFIER_NODE)
1568 : 5 : s = IDENTIFIER_POINTER (TYPE_NAME (tmp));
1569 : 250 : else if (!DECL_NAME (TYPE_NAME (tmp)))
1570 : : s = "";
1571 : : else
1572 : 250 : s = IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp)));
1573 : :
1574 : 271 : if (!strcasecmp (IDENTIFIER_POINTER (DECL_NAME (t)), s))
1575 : 0 : pp_string (buffer, "the_");
1576 : : }
1577 : 276 : }
1578 : :
1579 : : /* Dump in BUFFER a function declaration FUNC in Ada syntax.
1580 : : IS_METHOD indicates whether FUNC is a C++ method.
1581 : : IS_CONSTRUCTOR whether FUNC is a C++ constructor.
1582 : : IS_DESTRUCTOR whether FUNC is a C++ destructor.
1583 : : SPC is the current indentation level. */
1584 : :
1585 : : static void
1586 : 149 : dump_ada_function_declaration (pretty_printer *buffer, tree func,
1587 : : bool is_method, bool is_constructor,
1588 : : bool is_destructor, int spc)
1589 : : {
1590 : 149 : tree type = TREE_TYPE (func);
1591 : 149 : tree arg = TYPE_ARG_TYPES (type);
1592 : 149 : tree t;
1593 : 149 : char buf[18];
1594 : 149 : int num, num_args = 0, have_args = true, have_ellipsis = false;
1595 : :
1596 : : /* Compute number of arguments. */
1597 : 149 : if (arg)
1598 : : {
1599 : 341 : while (TREE_CHAIN (arg) && arg != error_mark_node)
1600 : : {
1601 : 192 : num_args++;
1602 : 192 : arg = TREE_CHAIN (arg);
1603 : : }
1604 : :
1605 : 149 : if (TREE_CODE (TREE_VALUE (arg)) != VOID_TYPE)
1606 : : {
1607 : 0 : num_args++;
1608 : 0 : have_ellipsis = true;
1609 : : }
1610 : : }
1611 : :
1612 : 149 : if (is_constructor)
1613 : 16 : num_args--;
1614 : :
1615 : 149 : if (is_destructor)
1616 : : num_args = 1;
1617 : :
1618 : 149 : if (num_args > 2)
1619 : 0 : newline_and_indent (buffer, spc + 1);
1620 : :
1621 : 149 : if (num_args > 0)
1622 : : {
1623 : 129 : pp_space (buffer);
1624 : 129 : pp_left_paren (buffer);
1625 : : }
1626 : :
1627 : : /* For a function, see if we have the corresponding arguments. */
1628 : 149 : if (TREE_CODE (func) == FUNCTION_DECL)
1629 : : {
1630 : 139 : arg = DECL_ARGUMENTS (func);
1631 : 321 : for (t = arg, num = 0; t; t = DECL_CHAIN (t))
1632 : 182 : num++;
1633 : 139 : if (num < num_args)
1634 : : arg = NULL_TREE;
1635 : : }
1636 : : else
1637 : : arg = NULL_TREE;
1638 : :
1639 : : /* Otherwise, only print the types. */
1640 : 139 : if (!arg)
1641 : : {
1642 : 14 : have_args = false;
1643 : 14 : arg = TYPE_ARG_TYPES (type);
1644 : : }
1645 : :
1646 : 149 : if (is_constructor)
1647 : 16 : arg = TREE_CHAIN (arg);
1648 : :
1649 : : /* Print the argument names (if available) and types. */
1650 : 325 : for (num = 1; num <= num_args; num++)
1651 : : {
1652 : 176 : if (have_args)
1653 : : {
1654 : 166 : if (DECL_NAME (arg))
1655 : : {
1656 : 131 : check_type_name_conflict (buffer, arg);
1657 : 131 : pp_ada_tree_identifier (buffer, DECL_NAME (arg), NULL_TREE,
1658 : : false);
1659 : 131 : pp_string (buffer, " : ");
1660 : : }
1661 : : else
1662 : : {
1663 : 35 : sprintf (buf, "arg%d : ", num);
1664 : 35 : pp_string (buffer, buf);
1665 : : }
1666 : :
1667 : 166 : dump_ada_node (buffer, TREE_TYPE (arg), type, spc, false, true);
1668 : : }
1669 : : else
1670 : : {
1671 : 10 : sprintf (buf, "arg%d : ", num);
1672 : 10 : pp_string (buffer, buf);
1673 : 10 : dump_ada_node (buffer, TREE_VALUE (arg), type, spc, false, true);
1674 : : }
1675 : :
1676 : : /* If the type is a pointer to a tagged type, we need to differentiate
1677 : : virtual methods from the rest (non-virtual methods, static member
1678 : : or regular functions) and import only them as primitive operations,
1679 : : because they make up the virtual table which is mirrored on the Ada
1680 : : side by the dispatch table. So we add 'Class to the type of every
1681 : : parameter that is not the first one of a method which either has a
1682 : : slot in the virtual table or is a constructor. */
1683 : 176 : if (TREE_TYPE (arg)
1684 : 166 : && POINTER_TYPE_P (TREE_TYPE (arg))
1685 : 120 : && is_tagged_type (TREE_TYPE (TREE_TYPE (arg)))
1686 : 248 : && !(num == 1 && is_method && (DECL_VINDEX (func) || is_constructor)))
1687 : 16 : pp_string (buffer, "'Class");
1688 : :
1689 : 176 : arg = TREE_CHAIN (arg);
1690 : :
1691 : 176 : if (num < num_args)
1692 : : {
1693 : 47 : pp_semicolon (buffer);
1694 : :
1695 : 47 : if (num_args > 2)
1696 : 0 : newline_and_indent (buffer, spc + INDENT_INCR);
1697 : : else
1698 : 47 : pp_space (buffer);
1699 : : }
1700 : : }
1701 : :
1702 : 149 : if (have_ellipsis)
1703 : : {
1704 : 0 : pp_string (buffer, " -- , ...");
1705 : 0 : newline_and_indent (buffer, spc + INDENT_INCR);
1706 : : }
1707 : :
1708 : 149 : if (num_args > 0)
1709 : 129 : pp_right_paren (buffer);
1710 : :
1711 : 149 : if (is_constructor || !VOID_TYPE_P (TREE_TYPE (type)))
1712 : : {
1713 : 115 : pp_string (buffer, " return ");
1714 : 115 : tree rtype = is_constructor ? DECL_CONTEXT (func) : TREE_TYPE (type);
1715 : 115 : dump_ada_node (buffer, rtype, rtype, spc, false, true);
1716 : : }
1717 : 149 : }
1718 : :
1719 : : /* Dump in BUFFER all the domains associated with an array NODE,
1720 : : in Ada syntax. SPC is the current indentation level. */
1721 : :
1722 : : static void
1723 : 29 : dump_ada_array_domains (pretty_printer *buffer, tree node, int spc)
1724 : : {
1725 : 29 : bool first = true;
1726 : :
1727 : 29 : pp_left_paren (buffer);
1728 : :
1729 : 58 : for (; TREE_CODE (node) == ARRAY_TYPE; node = TREE_TYPE (node))
1730 : : {
1731 : 29 : tree domain = TYPE_DOMAIN (node);
1732 : :
1733 : 29 : if (domain)
1734 : : {
1735 : 25 : tree min = TYPE_MIN_VALUE (domain);
1736 : 25 : tree max = TYPE_MAX_VALUE (domain);
1737 : :
1738 : 25 : if (!first)
1739 : 0 : pp_string (buffer, ", ");
1740 : 25 : first = false;
1741 : :
1742 : 25 : if (min)
1743 : 25 : dump_ada_node (buffer, min, NULL_TREE, spc, false, true);
1744 : 25 : pp_string (buffer, " .. ");
1745 : :
1746 : : /* If the upper bound is zero, gcc may generate a NULL_TREE
1747 : : for TYPE_MAX_VALUE rather than an integer_cst. */
1748 : 25 : if (max)
1749 : 25 : dump_ada_node (buffer, max, NULL_TREE, spc, false, true);
1750 : : else
1751 : 0 : pp_string (buffer, "0");
1752 : : }
1753 : : else
1754 : : {
1755 : 4 : pp_string (buffer, "size_t");
1756 : 4 : first = false;
1757 : : }
1758 : : }
1759 : 29 : pp_right_paren (buffer);
1760 : 29 : }
1761 : :
1762 : : /* Dump in BUFFER file:line information related to NODE. */
1763 : :
1764 : : static void
1765 : 471 : dump_sloc (pretty_printer *buffer, tree node)
1766 : : {
1767 : 471 : expanded_location xloc;
1768 : :
1769 : 471 : if (DECL_P (node))
1770 : 471 : xloc = expand_location (DECL_SOURCE_LOCATION (node));
1771 : 0 : else if (EXPR_HAS_LOCATION (node))
1772 : 0 : xloc = expand_location (EXPR_LOCATION (node));
1773 : : else
1774 : : xloc.file = NULL;
1775 : :
1776 : 471 : if (xloc.file)
1777 : : {
1778 : 471 : pp_string (buffer, xloc.file);
1779 : 471 : pp_colon (buffer);
1780 : 471 : pp_decimal_int (buffer, xloc.line);
1781 : : }
1782 : 471 : }
1783 : :
1784 : : /* Return true if type T designates a 1-dimension array of "char". */
1785 : :
1786 : : static bool
1787 : 58 : is_char_array (tree t)
1788 : : {
1789 : 58 : int num_dim = 0;
1790 : :
1791 : 116 : while (TREE_CODE (t) == ARRAY_TYPE)
1792 : : {
1793 : 58 : num_dim++;
1794 : 58 : t = TREE_TYPE (t);
1795 : : }
1796 : :
1797 : 58 : return num_dim == 1
1798 : 58 : && TREE_CODE (t) == INTEGER_TYPE
1799 : 66 : && id_equal (DECL_NAME (TYPE_NAME (t)), "char");
1800 : : }
1801 : :
1802 : : /* Dump in BUFFER an array type NODE in Ada syntax. SPC is the indentation
1803 : : level. */
1804 : :
1805 : : static void
1806 : 29 : dump_ada_array_type (pretty_printer *buffer, tree node, int spc)
1807 : : {
1808 : 29 : const bool char_array = is_char_array (node);
1809 : :
1810 : : /* Special case char arrays. */
1811 : 29 : if (char_array)
1812 : 0 : pp_string (buffer, "Interfaces.C.char_array ");
1813 : : else
1814 : 29 : pp_string (buffer, "array ");
1815 : :
1816 : : /* Print the dimensions. */
1817 : 29 : dump_ada_array_domains (buffer, node, spc);
1818 : :
1819 : : /* Print the component type. */
1820 : 29 : if (!char_array)
1821 : : {
1822 : : tree tmp = node;
1823 : 58 : while (TREE_CODE (tmp) == ARRAY_TYPE)
1824 : 29 : tmp = TREE_TYPE (tmp);
1825 : :
1826 : 29 : pp_string (buffer, " of ");
1827 : :
1828 : 29 : if (TREE_CODE (tmp) != POINTER_TYPE)
1829 : 24 : pp_string (buffer, "aliased ");
1830 : :
1831 : 29 : if (TYPE_NAME (tmp)
1832 : 29 : || (!RECORD_OR_UNION_TYPE_P (tmp)
1833 : 5 : && TREE_CODE (tmp) != ENUMERAL_TYPE))
1834 : 25 : dump_ada_node (buffer, tmp, node, spc, false, true);
1835 : : else
1836 : 4 : dump_anonymous_type_name (buffer, tmp);
1837 : : }
1838 : 29 : }
1839 : :
1840 : : /* Dump in BUFFER type names associated with a template, each prepended with
1841 : : '_'. TYPES is the TREE_PURPOSE of a DECL_TEMPLATE_INSTANTIATIONS. SPC is
1842 : : the indentation level. */
1843 : :
1844 : : static void
1845 : 16 : dump_template_types (pretty_printer *buffer, tree types, int spc)
1846 : : {
1847 : 48 : for (int i = 0; i < TREE_VEC_LENGTH (types); i++)
1848 : : {
1849 : 32 : tree elem = TREE_VEC_ELT (types, i);
1850 : 32 : pp_underscore (buffer);
1851 : :
1852 : 32 : if (!dump_ada_node (buffer, elem, NULL_TREE, spc, false, true))
1853 : : {
1854 : 0 : pp_string (buffer, "unknown");
1855 : 0 : pp_scalar (buffer, HOST_SIZE_T_PRINT_UNSIGNED,
1856 : : (fmt_size_t) TREE_HASH (elem));
1857 : : }
1858 : : }
1859 : 16 : }
1860 : :
1861 : : /* Dump in BUFFER the contents of all class instantiations associated with
1862 : : a given template T. SPC is the indentation level. */
1863 : :
1864 : : static int
1865 : 12 : dump_ada_template (pretty_printer *buffer, tree t, int spc)
1866 : : {
1867 : : /* DECL_SIZE_UNIT is DECL_TEMPLATE_INSTANTIATIONS in this context. */
1868 : 12 : tree inst = DECL_SIZE_UNIT (t);
1869 : : /* This emulates DECL_TEMPLATE_RESULT in this context. */
1870 : 12 : struct tree_template_decl {
1871 : : struct tree_decl_common common;
1872 : : tree arguments;
1873 : : tree result;
1874 : : };
1875 : 12 : tree result = ((struct tree_template_decl *) t)->result;
1876 : 12 : int num_inst = 0;
1877 : :
1878 : : /* Don't look at template declarations declaring something coming from
1879 : : another file. This can occur for template friend declarations. */
1880 : 12 : if (LOCATION_FILE (decl_sloc (result, false))
1881 : 12 : != LOCATION_FILE (decl_sloc (t, false)))
1882 : : return 0;
1883 : :
1884 : 24 : for (; inst && inst != error_mark_node; inst = TREE_CHAIN (inst))
1885 : : {
1886 : 12 : tree types = TREE_PURPOSE (inst);
1887 : 12 : tree instance = TREE_VALUE (inst);
1888 : :
1889 : 12 : if (TREE_VEC_LENGTH (types) == 0)
1890 : : break;
1891 : :
1892 : 12 : if (!RECORD_OR_UNION_TYPE_P (instance))
1893 : : break;
1894 : :
1895 : : /* We are interested in concrete template instantiations only: skip
1896 : : partially specialized nodes. */
1897 : 16 : if (RECORD_OR_UNION_TYPE_P (instance)
1898 : 12 : && cpp_check
1899 : 12 : && cpp_check (instance, HAS_DEPENDENT_TEMPLATE_ARGS))
1900 : 4 : continue;
1901 : :
1902 : 8 : num_inst++;
1903 : 32 : INDENT (spc);
1904 : 8 : pp_string (buffer, "package ");
1905 : 8 : package_prefix = false;
1906 : 8 : dump_ada_node (buffer, instance, t, spc, false, true);
1907 : 8 : dump_template_types (buffer, types, spc);
1908 : 8 : pp_string (buffer, " is");
1909 : 8 : spc += INDENT_INCR;
1910 : 8 : newline_and_indent (buffer, spc);
1911 : :
1912 : 8 : TREE_VISITED (get_underlying_decl (instance)) = 1;
1913 : 8 : pp_string (buffer, "type ");
1914 : 8 : dump_ada_node (buffer, instance, t, spc, false, true);
1915 : 8 : package_prefix = true;
1916 : :
1917 : 8 : if (is_tagged_type (instance))
1918 : 0 : pp_string (buffer, " is tagged limited ");
1919 : : else
1920 : 8 : pp_string (buffer, " is limited ");
1921 : :
1922 : 8 : dump_ada_node (buffer, instance, t, spc, false, false);
1923 : 8 : pp_newline (buffer);
1924 : 8 : spc -= INDENT_INCR;
1925 : 8 : newline_and_indent (buffer, spc);
1926 : :
1927 : 8 : pp_string (buffer, "end;");
1928 : 8 : newline_and_indent (buffer, spc);
1929 : 8 : pp_string (buffer, "use ");
1930 : 8 : package_prefix = false;
1931 : 8 : dump_ada_node (buffer, instance, t, spc, false, true);
1932 : 8 : dump_template_types (buffer, types, spc);
1933 : 8 : package_prefix = true;
1934 : 8 : pp_semicolon (buffer);
1935 : 8 : pp_newline (buffer);
1936 : 8 : pp_newline (buffer);
1937 : : }
1938 : :
1939 : 12 : return num_inst > 0;
1940 : : }
1941 : :
1942 : : /* Return true if NODE is a simple enumeral type that can be mapped to an
1943 : : Ada enumeration type directly. */
1944 : :
1945 : : static bool
1946 : 60 : is_simple_enum (tree node)
1947 : : {
1948 : 60 : HOST_WIDE_INT count = 0;
1949 : :
1950 : 130 : for (tree value = TYPE_VALUES (node); value; value = TREE_CHAIN (value))
1951 : : {
1952 : 100 : tree int_val = TREE_VALUE (value);
1953 : :
1954 : 100 : if (TREE_CODE (int_val) != INTEGER_CST)
1955 : 100 : int_val = DECL_INITIAL (int_val);
1956 : :
1957 : 100 : if (!tree_fits_shwi_p (int_val) || tree_to_shwi (int_val) != count)
1958 : : return false;
1959 : :
1960 : 70 : count++;
1961 : : }
1962 : :
1963 : : return true;
1964 : : }
1965 : :
1966 : : /* Dump in BUFFER the declaration of enumeral NODE of type TYPE in Ada syntax.
1967 : : SPC is the indentation level. */
1968 : :
1969 : : static void
1970 : 30 : dump_ada_enum_type (pretty_printer *buffer, tree node, tree type, int spc)
1971 : : {
1972 : 30 : if (is_simple_enum (node))
1973 : : {
1974 : 15 : bool first = true;
1975 : 15 : spc += INDENT_INCR;
1976 : 15 : newline_and_indent (buffer, spc - 1);
1977 : 15 : pp_left_paren (buffer);
1978 : 50 : for (tree value = TYPE_VALUES (node); value; value = TREE_CHAIN (value))
1979 : : {
1980 : 35 : if (first)
1981 : : first = false;
1982 : : else
1983 : : {
1984 : 20 : pp_comma (buffer);
1985 : 20 : newline_and_indent (buffer, spc);
1986 : : }
1987 : :
1988 : 35 : pp_ada_tree_identifier (buffer, TREE_PURPOSE (value), node, false);
1989 : : }
1990 : 15 : pp_string (buffer, ")");
1991 : 15 : spc -= INDENT_INCR;
1992 : 15 : newline_and_indent (buffer, spc);
1993 : 15 : pp_string (buffer, "with Convention => C");
1994 : : }
1995 : : else
1996 : : {
1997 : 15 : if (TYPE_UNSIGNED (node))
1998 : 10 : pp_string (buffer, "unsigned");
1999 : : else
2000 : 5 : pp_string (buffer, "int");
2001 : :
2002 : 60 : for (tree value = TYPE_VALUES (node); value; value = TREE_CHAIN (value))
2003 : : {
2004 : 45 : tree int_val = TREE_VALUE (value);
2005 : :
2006 : 45 : if (TREE_CODE (int_val) != INTEGER_CST)
2007 : 45 : int_val = DECL_INITIAL (int_val);
2008 : :
2009 : 45 : pp_semicolon (buffer);
2010 : 45 : newline_and_indent (buffer, spc);
2011 : :
2012 : 45 : if (TYPE_NAME (node))
2013 : 42 : dump_ada_node (buffer, node, NULL_TREE, spc, false, true);
2014 : 3 : else if (type)
2015 : 0 : dump_ada_node (buffer, type, NULL_TREE, spc, false, true);
2016 : : else
2017 : 3 : dump_anonymous_type_name (buffer, node);
2018 : 45 : pp_underscore (buffer);
2019 : 45 : pp_ada_tree_identifier (buffer, TREE_PURPOSE (value), node, false);
2020 : :
2021 : 45 : pp_string (buffer, " : constant ");
2022 : :
2023 : 45 : if (TYPE_NAME (node))
2024 : 42 : dump_ada_node (buffer, node, NULL_TREE, spc, false, true);
2025 : 3 : else if (type)
2026 : 0 : dump_ada_node (buffer, type, NULL_TREE, spc, false, true);
2027 : : else
2028 : 3 : dump_anonymous_type_name (buffer, node);
2029 : :
2030 : 45 : pp_string (buffer, " := ");
2031 : 45 : dump_ada_node (buffer, int_val, node, spc, false, true);
2032 : : }
2033 : : }
2034 : 30 : }
2035 : :
2036 : : /* Return true if NODE is the _Float32/_Float32x type. */
2037 : :
2038 : : static bool
2039 : 51 : is_float32 (tree node)
2040 : : {
2041 : 51 : if (!TYPE_NAME (node) || TREE_CODE (TYPE_NAME (node)) != TYPE_DECL)
2042 : : return false;
2043 : :
2044 : 51 : tree name = DECL_NAME (TYPE_NAME (node));
2045 : :
2046 : 51 : if (IDENTIFIER_POINTER (name) [0] != '_')
2047 : : return false;
2048 : :
2049 : 0 : return id_equal (name, "_Float32") || id_equal (name, "_Float32x");
2050 : : }
2051 : :
2052 : : /* Return true if NODE is the _Float64/_Float64x type. */
2053 : :
2054 : : static bool
2055 : 51 : is_float64 (tree node)
2056 : : {
2057 : 51 : if (!TYPE_NAME (node) || TREE_CODE (TYPE_NAME (node)) != TYPE_DECL)
2058 : : return false;
2059 : :
2060 : 51 : tree name = DECL_NAME (TYPE_NAME (node));
2061 : :
2062 : 51 : if (IDENTIFIER_POINTER (name) [0] != '_')
2063 : : return false;
2064 : :
2065 : 0 : return id_equal (name, "_Float64") || id_equal (name, "_Float64x");
2066 : : }
2067 : :
2068 : : /* Return true if NODE is the __float128/_Float128/_Float128x type. */
2069 : :
2070 : : static bool
2071 : 51 : is_float128 (tree node)
2072 : : {
2073 : 51 : if (!TYPE_NAME (node) || TREE_CODE (TYPE_NAME (node)) != TYPE_DECL)
2074 : : return false;
2075 : :
2076 : 51 : tree name = DECL_NAME (TYPE_NAME (node));
2077 : :
2078 : 51 : if (IDENTIFIER_POINTER (name) [0] != '_')
2079 : : return false;
2080 : :
2081 : 0 : return id_equal (name, "__float128")
2082 : 0 : || id_equal (name, "_Float128")
2083 : 0 : || id_equal (name, "_Float128x");
2084 : : }
2085 : :
2086 : : static bool bitfield_used = false;
2087 : : static bool packed_layout = false;
2088 : :
2089 : : /* Recursively dump in BUFFER Ada declarations corresponding to NODE of type
2090 : : TYPE. SPC is the indentation level. LIMITED_ACCESS indicates whether NODE
2091 : : can be referenced via a "limited with" clause. NAME_ONLY indicates whether
2092 : : we should only dump the name of NODE, instead of its full declaration. */
2093 : :
2094 : : static int
2095 : 2171 : dump_ada_node (pretty_printer *buffer, tree node, tree type, int spc,
2096 : : bool limited_access, bool name_only)
2097 : : {
2098 : 2171 : if (node == NULL_TREE)
2099 : : return 0;
2100 : :
2101 : 2171 : switch (TREE_CODE (node))
2102 : : {
2103 : 0 : case ERROR_MARK:
2104 : 0 : pp_string (buffer, "<<< error >>>");
2105 : 0 : return 0;
2106 : :
2107 : 45 : case IDENTIFIER_NODE:
2108 : 45 : pp_ada_tree_identifier (buffer, node, type, limited_access);
2109 : 45 : break;
2110 : :
2111 : 0 : case TREE_LIST:
2112 : 0 : pp_string (buffer, "--- unexpected node: TREE_LIST");
2113 : 0 : return 0;
2114 : :
2115 : 0 : case TREE_BINFO:
2116 : 0 : dump_ada_node (buffer, BINFO_TYPE (node), type, spc, limited_access,
2117 : : name_only);
2118 : 0 : return 0;
2119 : :
2120 : 0 : case TREE_VEC:
2121 : 0 : pp_string (buffer, "--- unexpected node: TREE_VEC");
2122 : 0 : return 0;
2123 : :
2124 : 0 : case NULLPTR_TYPE:
2125 : 0 : case VOID_TYPE:
2126 : 0 : if (package_prefix)
2127 : : {
2128 : 0 : append_withs ("System", false);
2129 : 0 : pp_string (buffer, "System.Address");
2130 : : }
2131 : : else
2132 : 0 : pp_string (buffer, "address");
2133 : : break;
2134 : :
2135 : 0 : case VECTOR_TYPE:
2136 : 0 : pp_string (buffer, "<vector>");
2137 : 0 : break;
2138 : :
2139 : 0 : case COMPLEX_TYPE:
2140 : 0 : if (is_float128 (TREE_TYPE (node)))
2141 : : {
2142 : 0 : append_withs ("Interfaces.C.Extensions", false);
2143 : 0 : pp_string (buffer, "Extensions.CFloat_128");
2144 : : }
2145 : 0 : else if (TREE_TYPE (node) == float_type_node)
2146 : : {
2147 : 0 : append_withs ("Ada.Numerics.Complex_Types", false);
2148 : 0 : pp_string (buffer, "Ada.Numerics.Complex_Types.Complex");
2149 : : }
2150 : 0 : else if (TREE_TYPE (node) == double_type_node)
2151 : : {
2152 : 0 : append_withs ("Ada.Numerics.Long_Complex_Types", false);
2153 : 0 : pp_string (buffer, "Ada.Numerics.Long_Complex_Types.Complex");
2154 : : }
2155 : 0 : else if (TREE_TYPE (node) == long_double_type_node)
2156 : : {
2157 : 0 : append_withs ("Ada.Numerics.Long_Long_Complex_Types", false);
2158 : 0 : pp_string (buffer, "Ada.Numerics.Long_Long_Complex_Types.Complex");
2159 : : }
2160 : : else
2161 : 0 : pp_string (buffer, "<complex>");
2162 : : break;
2163 : :
2164 : 150 : case ENUMERAL_TYPE:
2165 : 150 : if (name_only)
2166 : 138 : dump_ada_node (buffer, TYPE_NAME (node), node, spc, false, true);
2167 : : else
2168 : 12 : dump_ada_enum_type (buffer, node, type, spc);
2169 : : break;
2170 : :
2171 : 51 : case REAL_TYPE:
2172 : 51 : if (is_float32 (node))
2173 : : {
2174 : 0 : pp_string (buffer, "Float");
2175 : 0 : break;
2176 : : }
2177 : 51 : else if (is_float64 (node))
2178 : : {
2179 : 0 : pp_string (buffer, "Long_Float");
2180 : 0 : break;
2181 : : }
2182 : 51 : else if (is_float128 (node))
2183 : : {
2184 : 0 : append_withs ("Interfaces.C.Extensions", false);
2185 : 0 : pp_string (buffer, "Extensions.Float_128");
2186 : 0 : break;
2187 : : }
2188 : :
2189 : : /* fallthrough */
2190 : :
2191 : 258 : case INTEGER_TYPE:
2192 : 258 : case FIXED_POINT_TYPE:
2193 : 258 : case BOOLEAN_TYPE:
2194 : 258 : if (TYPE_NAME (node)
2195 : 258 : && !(TREE_CODE (TYPE_NAME (node)) == TYPE_DECL
2196 : 258 : && !strcmp (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (node))),
2197 : : "__int128")))
2198 : : {
2199 : 258 : if (TREE_CODE (TYPE_NAME (node)) == IDENTIFIER_NODE)
2200 : 0 : pp_ada_tree_identifier (buffer, TYPE_NAME (node), node,
2201 : : limited_access);
2202 : 258 : else if (TREE_CODE (TYPE_NAME (node)) == TYPE_DECL
2203 : 258 : && DECL_NAME (TYPE_NAME (node)))
2204 : 258 : dump_ada_decl_name (buffer, TYPE_NAME (node), limited_access);
2205 : : else
2206 : 0 : pp_string (buffer, "<unnamed type>");
2207 : : }
2208 : 0 : else if (TREE_CODE (node) == INTEGER_TYPE)
2209 : : {
2210 : 0 : append_withs ("Interfaces.C.Extensions", false);
2211 : 0 : bitfield_used = true;
2212 : :
2213 : 0 : if (TYPE_PRECISION (node) == 1)
2214 : 0 : pp_string (buffer, "Extensions.Unsigned_1");
2215 : : else
2216 : : {
2217 : 0 : pp_string (buffer, TYPE_UNSIGNED (node)
2218 : : ? "Extensions.Unsigned_"
2219 : : : "Extensions.Signed_");
2220 : 0 : pp_decimal_int (buffer, TYPE_PRECISION (node));
2221 : : }
2222 : : }
2223 : : else
2224 : 0 : pp_string (buffer, "<unnamed type>");
2225 : : break;
2226 : :
2227 : 155 : case POINTER_TYPE:
2228 : 155 : case REFERENCE_TYPE:
2229 : 155 : if (name_only && TYPE_NAME (node))
2230 : 10 : dump_ada_node (buffer, TYPE_NAME (node), node, spc, limited_access,
2231 : : true);
2232 : :
2233 : 145 : else if (TREE_CODE (TREE_TYPE (node)) == FUNCTION_TYPE)
2234 : : {
2235 : 10 : if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (node))))
2236 : 10 : pp_string (buffer, "access procedure");
2237 : : else
2238 : 0 : pp_string (buffer, "access function");
2239 : :
2240 : 10 : dump_ada_function_declaration (buffer, node, false, false, false,
2241 : : spc + INDENT_INCR);
2242 : :
2243 : : /* If we are dumping the full type, it means we are part of a
2244 : : type definition and need also a Convention C aspect. */
2245 : 10 : if (!name_only)
2246 : : {
2247 : 0 : newline_and_indent (buffer, spc);
2248 : 0 : pp_string (buffer, "with Convention => C");
2249 : : }
2250 : : }
2251 : : else
2252 : : {
2253 : 135 : tree ref_type = TREE_TYPE (node);
2254 : 135 : const unsigned int quals = TYPE_QUALS (ref_type);
2255 : 135 : bool is_access;
2256 : :
2257 : 135 : if (VOID_TYPE_P (ref_type))
2258 : : {
2259 : 0 : if (!name_only)
2260 : 0 : pp_string (buffer, "new ");
2261 : 0 : if (package_prefix)
2262 : : {
2263 : 0 : append_withs ("System", false);
2264 : 0 : pp_string (buffer, "System.Address");
2265 : : }
2266 : : else
2267 : 0 : pp_string (buffer, "address");
2268 : : }
2269 : : else
2270 : : {
2271 : 135 : if (TREE_CODE (node) == POINTER_TYPE
2272 : 127 : && TREE_CODE (ref_type) == INTEGER_TYPE
2273 : 135 : && id_equal (DECL_NAME (TYPE_NAME (ref_type)), "char"))
2274 : : {
2275 : 0 : if (!name_only)
2276 : 0 : pp_string (buffer, "new ");
2277 : :
2278 : 0 : if (package_prefix)
2279 : : {
2280 : 0 : pp_string (buffer, "Interfaces.C.Strings.chars_ptr");
2281 : 0 : append_withs ("Interfaces.C.Strings", false);
2282 : : }
2283 : : else
2284 : 0 : pp_string (buffer, "chars_ptr");
2285 : : }
2286 : : else
2287 : : {
2288 : 135 : tree stub = TYPE_STUB_DECL (ref_type);
2289 : 135 : tree type_name = TYPE_NAME (ref_type);
2290 : :
2291 : : /* For now, handle access-to-access as System.Address. */
2292 : 135 : if (TREE_CODE (ref_type) == POINTER_TYPE)
2293 : : {
2294 : 0 : if (package_prefix)
2295 : : {
2296 : 0 : append_withs ("System", false);
2297 : 0 : if (!name_only)
2298 : 0 : pp_string (buffer, "new ");
2299 : 0 : pp_string (buffer, "System.Address");
2300 : : }
2301 : : else
2302 : 0 : pp_string (buffer, "address");
2303 : 0 : return spc;
2304 : : }
2305 : :
2306 : 135 : if (!package_prefix)
2307 : : {
2308 : 0 : is_access = false;
2309 : 0 : pp_string (buffer, "access");
2310 : : }
2311 : 135 : else if (AGGREGATE_TYPE_P (ref_type))
2312 : : {
2313 : 135 : if (!type || TREE_CODE (type) != FUNCTION_DECL)
2314 : : {
2315 : 135 : is_access = true;
2316 : 135 : pp_string (buffer, "access ");
2317 : :
2318 : 135 : if (quals & TYPE_QUAL_CONST)
2319 : 18 : pp_string (buffer, "constant ");
2320 : 117 : else if (!name_only)
2321 : 10 : pp_string (buffer, "all ");
2322 : : }
2323 : 0 : else if (quals & TYPE_QUAL_CONST)
2324 : : {
2325 : 0 : is_access = false;
2326 : 0 : pp_string (buffer, "in ");
2327 : : }
2328 : : else
2329 : : {
2330 : 0 : is_access = true;
2331 : 0 : pp_string (buffer, "access ");
2332 : : }
2333 : : }
2334 : : else
2335 : : {
2336 : : /* We want to use regular with clauses for scalar types,
2337 : : as they are not involved in circular declarations. */
2338 : 0 : is_access = false;
2339 : 0 : pp_string (buffer, "access ");
2340 : :
2341 : 0 : if (!name_only)
2342 : 0 : pp_string (buffer, "all ");
2343 : : }
2344 : :
2345 : : /* If this is the anonymous original type of a typedef'ed
2346 : : type, then use the name of the latter. */
2347 : 135 : if (!type_name
2348 : 135 : && stub
2349 : 0 : && DECL_CHAIN (stub)
2350 : 0 : && TREE_CODE (DECL_CHAIN (stub)) == TYPE_DECL
2351 : 135 : && DECL_ORIGINAL_TYPE (DECL_CHAIN (stub)) == ref_type)
2352 : 0 : ref_type = TREE_TYPE (DECL_CHAIN (stub));
2353 : :
2354 : : /* Generate "access <type>" instead of "access <subtype>"
2355 : : if the subtype comes from another file, because subtype
2356 : : declarations do not contribute to the limited view of a
2357 : : package and thus subtypes cannot be referenced through
2358 : : a limited_with clause. */
2359 : 135 : else if (is_access)
2360 : : while (type_name
2361 : 135 : && TREE_CODE (type_name) == TYPE_DECL
2362 : 129 : && DECL_ORIGINAL_TYPE (type_name)
2363 : 172 : && TYPE_NAME (DECL_ORIGINAL_TYPE (type_name)))
2364 : : {
2365 : 35 : const expanded_location xloc
2366 : 35 : = expand_location (decl_sloc (type_name, false));
2367 : 35 : if (xloc.line
2368 : 35 : && xloc.file
2369 : 35 : && xloc.file != current_source_file)
2370 : : {
2371 : 0 : ref_type = DECL_ORIGINAL_TYPE (type_name);
2372 : 0 : type_name = TYPE_NAME (ref_type);
2373 : : }
2374 : : else
2375 : : break;
2376 : : }
2377 : :
2378 : 135 : dump_ada_node (buffer, ref_type, ref_type, spc, is_access,
2379 : : true);
2380 : : }
2381 : : }
2382 : : }
2383 : : break;
2384 : :
2385 : 0 : case ARRAY_TYPE:
2386 : 0 : if (name_only)
2387 : 0 : dump_ada_node (buffer, TYPE_NAME (node), node, spc, limited_access,
2388 : : true);
2389 : : else
2390 : 0 : dump_ada_array_type (buffer, node, spc);
2391 : : break;
2392 : :
2393 : 533 : case RECORD_TYPE:
2394 : 533 : case UNION_TYPE:
2395 : 533 : if (name_only)
2396 : 393 : dump_ada_node (buffer, TYPE_NAME (node), node, spc, limited_access,
2397 : : true);
2398 : : else
2399 : 140 : dump_ada_structure (buffer, node, type, false, spc);
2400 : : break;
2401 : :
2402 : 103 : case INTEGER_CST:
2403 : : /* We treat the upper half of the sizetype range as negative. This
2404 : : is consistent with the internal treatment and makes it possible
2405 : : to generate the (0 .. -1) range for flexible array members. */
2406 : 103 : if (TREE_TYPE (node) == sizetype)
2407 : 50 : node = fold_convert (ssizetype, node);
2408 : 103 : if (tree_fits_shwi_p (node))
2409 : 103 : pp_wide_integer (buffer, tree_to_shwi (node));
2410 : 0 : else if (tree_fits_uhwi_p (node))
2411 : 0 : pp_unsigned_wide_integer (buffer, tree_to_uhwi (node));
2412 : : else
2413 : : {
2414 : 0 : wide_int val = wi::to_wide (node);
2415 : 0 : int i;
2416 : 0 : if (wi::neg_p (val))
2417 : : {
2418 : 0 : pp_minus (buffer);
2419 : 0 : val = -val;
2420 : : }
2421 : 0 : sprintf (pp_buffer (buffer)->digit_buffer,
2422 : : "16#%" HOST_WIDE_INT_PRINT "x",
2423 : 0 : val.elt (val.get_len () - 1));
2424 : 0 : for (i = val.get_len () - 2; i >= 0; i--)
2425 : 0 : sprintf (pp_buffer (buffer)->digit_buffer,
2426 : : HOST_WIDE_INT_PRINT_PADDED_HEX, val.elt (i));
2427 : 0 : pp_string (buffer, pp_buffer (buffer)->digit_buffer);
2428 : 0 : }
2429 : : break;
2430 : :
2431 : : case REAL_CST:
2432 : : case FIXED_CST:
2433 : : case COMPLEX_CST:
2434 : : case STRING_CST:
2435 : : case VECTOR_CST:
2436 : : return 0;
2437 : :
2438 : 753 : case TYPE_DECL:
2439 : 753 : if (DECL_IS_UNDECLARED_BUILTIN (node))
2440 : : {
2441 : : /* Don't print the declaration of built-in types. */
2442 : 0 : if (name_only)
2443 : : {
2444 : : /* If we're in the middle of a declaration, defaults to
2445 : : System.Address. */
2446 : 0 : if (package_prefix)
2447 : : {
2448 : 0 : append_withs ("System", false);
2449 : 0 : pp_string (buffer, "System.Address");
2450 : : }
2451 : : else
2452 : 0 : pp_string (buffer, "address");
2453 : : }
2454 : : }
2455 : 753 : else if (name_only)
2456 : 611 : dump_ada_decl_name (buffer, node, limited_access);
2457 : : else
2458 : : {
2459 : 142 : if (is_tagged_type (TREE_TYPE (node)))
2460 : : {
2461 : 16 : int first = true;
2462 : :
2463 : : /* Look for ancestors. */
2464 : 16 : for (tree fld = TYPE_FIELDS (TREE_TYPE (node));
2465 : 121 : fld;
2466 : 105 : fld = TREE_CHAIN (fld))
2467 : : {
2468 : 105 : if (!DECL_NAME (fld) && is_tagged_type (TREE_TYPE (fld)))
2469 : : {
2470 : 4 : if (first)
2471 : : {
2472 : 4 : pp_string (buffer, "limited new ");
2473 : 4 : first = false;
2474 : : }
2475 : : else
2476 : 0 : pp_string (buffer, " and ");
2477 : :
2478 : 4 : dump_ada_decl_name (buffer, TYPE_NAME (TREE_TYPE (fld)),
2479 : : false);
2480 : : }
2481 : : }
2482 : :
2483 : 20 : pp_string (buffer, first ? "tagged limited " : " with ");
2484 : : }
2485 : 126 : else if (has_nontrivial_methods (TREE_TYPE (node)))
2486 : 4 : pp_string (buffer, "limited ");
2487 : :
2488 : 142 : dump_ada_node (buffer, TREE_TYPE (node), type, spc, false, false);
2489 : : }
2490 : : break;
2491 : :
2492 : 174 : case FUNCTION_DECL:
2493 : 174 : case CONST_DECL:
2494 : 174 : case VAR_DECL:
2495 : 174 : case PARM_DECL:
2496 : 174 : case FIELD_DECL:
2497 : 174 : case NAMESPACE_DECL:
2498 : 174 : dump_ada_decl_name (buffer, node, false);
2499 : 174 : break;
2500 : :
2501 : : default:
2502 : : /* Ignore other nodes (e.g. expressions). */
2503 : : return 0;
2504 : : }
2505 : :
2506 : : return 1;
2507 : : }
2508 : :
2509 : : /* Dump in BUFFER NODE's methods. SPC is the indentation level. Return 1 if
2510 : : methods were printed, 0 otherwise. */
2511 : :
2512 : : static int
2513 : 144 : dump_ada_methods (pretty_printer *buffer, tree node, int spc)
2514 : : {
2515 : 144 : if (!has_nontrivial_methods (node))
2516 : : return 0;
2517 : :
2518 : 32 : pp_semicolon (buffer);
2519 : :
2520 : 32 : int res = 1;
2521 : 241 : for (tree fld = TYPE_FIELDS (node); fld; fld = DECL_CHAIN (fld))
2522 : 209 : if (TREE_CODE (fld) == FUNCTION_DECL)
2523 : : {
2524 : 149 : if (res)
2525 : : {
2526 : 60 : pp_newline (buffer);
2527 : 60 : pp_newline (buffer);
2528 : : }
2529 : :
2530 : 149 : res = dump_ada_declaration (buffer, fld, node, spc);
2531 : : }
2532 : :
2533 : : return 1;
2534 : : }
2535 : :
2536 : : /* Dump in BUFFER a forward declaration for TYPE present inside T.
2537 : : SPC is the indentation level. */
2538 : :
2539 : : static void
2540 : 468 : dump_forward_type (pretty_printer *buffer, tree type, tree t, int spc)
2541 : : {
2542 : 531 : tree decl = get_underlying_decl (type);
2543 : :
2544 : : /* Anonymous pointer and function types. */
2545 : 531 : if (!decl)
2546 : : {
2547 : 212 : if (TREE_CODE (type) == POINTER_TYPE)
2548 : 63 : dump_forward_type (buffer, TREE_TYPE (type), t, spc);
2549 : 149 : else if (TREE_CODE (type) == FUNCTION_TYPE)
2550 : : {
2551 : 89 : function_args_iterator args_iter;
2552 : 89 : tree arg;
2553 : 89 : dump_forward_type (buffer, TREE_TYPE (type), t, spc);
2554 : 278 : FOREACH_FUNCTION_ARGS (type, arg, args_iter)
2555 : 189 : dump_forward_type (buffer, arg, t, spc);
2556 : : }
2557 : 149 : return;
2558 : : }
2559 : :
2560 : 319 : if (DECL_IS_UNDECLARED_BUILTIN (decl) || TREE_VISITED (decl))
2561 : : return;
2562 : :
2563 : : /* Forward declarations are only needed within a given file. */
2564 : 30 : if (DECL_SOURCE_FILE (decl) != DECL_SOURCE_FILE (t))
2565 : : return;
2566 : :
2567 : 30 : if (TREE_CODE (type) == FUNCTION_TYPE)
2568 : : return;
2569 : :
2570 : : /* Generate an incomplete type declaration. */
2571 : 30 : pp_string (buffer, "type ");
2572 : 30 : dump_ada_node (buffer, decl, NULL_TREE, spc, false, true);
2573 : 30 : pp_semicolon (buffer);
2574 : 30 : newline_and_indent (buffer, spc);
2575 : :
2576 : : /* Only one incomplete declaration is legal for a given type. */
2577 : 30 : TREE_VISITED (decl) = 1;
2578 : : }
2579 : :
2580 : : /* Bitmap of anonymous types already dumped. Anonymous array types are shared
2581 : : throughout the compilation so it needs to be global. */
2582 : :
2583 : : static bitmap dumped_anonymous_types;
2584 : :
2585 : : static void dump_nested_type (pretty_printer *, tree, tree, int);
2586 : :
2587 : : /* Dump in BUFFER anonymous types nested inside T's definition. PARENT is the
2588 : : parent node of T. DUMPED_TYPES is the bitmap of already dumped types. SPC
2589 : : is the indentation level.
2590 : :
2591 : : In C anonymous nested tagged types have no name whereas in C++ they have
2592 : : one. In C their TYPE_DECL is at top level whereas in C++ it is nested.
2593 : : In both languages untagged types (pointers and arrays) have no name.
2594 : : In C++ the nested TYPE_DECLs can come after their associated FIELD_DECL.
2595 : :
2596 : : Therefore, in order to have a common processing for both languages, we
2597 : : disregard anonymous TYPE_DECLs at top level and here we make a first
2598 : : pass on the nested TYPE_DECLs and a second pass on the unnamed types. */
2599 : :
2600 : : static void
2601 : 176 : dump_nested_types (pretty_printer *buffer, tree t, int spc)
2602 : : {
2603 : 176 : tree type, field;
2604 : :
2605 : : /* Find possible anonymous pointers/arrays/structs/unions recursively. */
2606 : 176 : type = TREE_TYPE (t);
2607 : 176 : if (!type)
2608 : : return;
2609 : :
2610 : 697 : for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
2611 : 521 : if (TREE_CODE (field) == TYPE_DECL
2612 : 196 : && DECL_NAME (field) != DECL_NAME (t)
2613 : 52 : && !DECL_ORIGINAL_TYPE (field)
2614 : 569 : && TYPE_NAME (TREE_TYPE (field)) != TYPE_NAME (type))
2615 : 48 : dump_nested_type (buffer, field, t, spc);
2616 : :
2617 : 697 : for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
2618 : 521 : if (TREE_CODE (field) == FIELD_DECL && !TYPE_NAME (TREE_TYPE (field)))
2619 : 66 : dump_nested_type (buffer, field, t, spc);
2620 : : }
2621 : :
2622 : : /* Dump in BUFFER the anonymous type of FIELD inside T. SPC is the indentation
2623 : : level. */
2624 : :
2625 : : static void
2626 : 118 : dump_nested_type (pretty_printer *buffer, tree field, tree t, int spc)
2627 : : {
2628 : 118 : tree field_type = TREE_TYPE (field);
2629 : 118 : tree decl, tmp;
2630 : :
2631 : 118 : switch (TREE_CODE (field_type))
2632 : : {
2633 : 31 : case POINTER_TYPE:
2634 : 31 : tmp = TREE_TYPE (field_type);
2635 : 31 : dump_forward_type (buffer, tmp, t, spc);
2636 : 31 : break;
2637 : :
2638 : 29 : case ARRAY_TYPE:
2639 : : /* Anonymous array types are shared. */
2640 : 29 : if (!bitmap_set_bit (dumped_anonymous_types, TYPE_UID (field_type)))
2641 : : return;
2642 : :
2643 : : /* Recurse on the element type if need be. */
2644 : 29 : tmp = TREE_TYPE (field_type);
2645 : 29 : while (TREE_CODE (tmp) == ARRAY_TYPE)
2646 : 0 : tmp = TREE_TYPE (tmp);
2647 : 29 : decl = get_underlying_decl (tmp);
2648 : 29 : if (decl
2649 : 24 : && !DECL_NAME (decl)
2650 : 4 : && DECL_SOURCE_FILE (decl) == DECL_SOURCE_FILE (t)
2651 : 33 : && !TREE_VISITED (decl))
2652 : : {
2653 : : /* Generate full declaration. */
2654 : 4 : dump_nested_type (buffer, decl, t, spc);
2655 : 4 : TREE_VISITED (decl) = 1;
2656 : : }
2657 : 25 : else if (!decl && TREE_CODE (tmp) == POINTER_TYPE)
2658 : 5 : dump_forward_type (buffer, TREE_TYPE (tmp), t, spc);
2659 : :
2660 : : /* Special case char arrays. */
2661 : 29 : if (is_char_array (field_type))
2662 : 0 : pp_string (buffer, "subtype ");
2663 : : else
2664 : 29 : pp_string (buffer, "type ");
2665 : :
2666 : 29 : dump_anonymous_type_name (buffer, field_type);
2667 : 29 : pp_string (buffer, " is ");
2668 : 29 : dump_ada_array_type (buffer, field_type, spc);
2669 : 29 : pp_semicolon (buffer);
2670 : 29 : newline_and_indent (buffer, spc);
2671 : 29 : break;
2672 : :
2673 : 18 : case ENUMERAL_TYPE:
2674 : 18 : if (is_simple_enum (field_type))
2675 : 9 : pp_string (buffer, "type ");
2676 : : else
2677 : 9 : pp_string (buffer, "subtype ");
2678 : :
2679 : 18 : if (TYPE_NAME (field_type))
2680 : 16 : dump_ada_node (buffer, field_type, NULL_TREE, spc, false, true);
2681 : : else
2682 : 2 : dump_anonymous_type_name (buffer, field_type);
2683 : 18 : pp_string (buffer, " is ");
2684 : 18 : dump_ada_enum_type (buffer, field_type, NULL_TREE, spc);
2685 : 18 : pp_semicolon (buffer);
2686 : 18 : newline_and_indent (buffer, spc);
2687 : 18 : break;
2688 : :
2689 : 40 : case RECORD_TYPE:
2690 : 40 : case UNION_TYPE:
2691 : 40 : dump_nested_types (buffer, field, spc);
2692 : :
2693 : 40 : pp_string (buffer, "type ");
2694 : :
2695 : 40 : if (TYPE_NAME (field_type))
2696 : 32 : dump_ada_node (buffer, field_type, NULL_TREE, spc, false, true);
2697 : : else
2698 : 8 : dump_anonymous_type_name (buffer, field_type);
2699 : :
2700 : 40 : if (TREE_CODE (field_type) == UNION_TYPE)
2701 : 5 : pp_string (buffer, " (discr : unsigned := 0)");
2702 : :
2703 : 40 : pp_string (buffer, " is ");
2704 : 40 : dump_ada_structure (buffer, field_type, t, true, spc);
2705 : 40 : pp_semicolon (buffer);
2706 : 40 : newline_and_indent (buffer, spc);
2707 : 40 : break;
2708 : :
2709 : : default:
2710 : : break;
2711 : : }
2712 : : }
2713 : :
2714 : : /* Hash table of overloaded names that we cannot support. It is needed even
2715 : : in Ada 2012 because we merge different types, e.g. void * and const void *
2716 : : in System.Address, so we cannot have overloading for them in Ada. */
2717 : :
2718 : : struct overloaded_name_hash {
2719 : : hashval_t hash;
2720 : : tree name;
2721 : : unsigned int n;
2722 : : };
2723 : :
2724 : : struct overloaded_name_hasher : delete_ptr_hash<overloaded_name_hash>
2725 : : {
2726 : 852 : static inline hashval_t hash (overloaded_name_hash *t)
2727 : 852 : { return t->hash; }
2728 : 952 : static inline bool equal (overloaded_name_hash *a, overloaded_name_hash *b)
2729 : 952 : { return a->name == b->name; }
2730 : : };
2731 : :
2732 : : typedef hash_table<overloaded_name_hasher> htable_t;
2733 : :
2734 : : static htable_t *overloaded_names;
2735 : :
2736 : : /* Add an overloaded NAME with N occurrences to TABLE. */
2737 : :
2738 : : static void
2739 : 1610 : add_name (const char *name, unsigned int n, htable_t *table)
2740 : : {
2741 : 1610 : struct overloaded_name_hash in, *h, **slot;
2742 : 1610 : tree id = get_identifier (name);
2743 : 1610 : hashval_t hash = htab_hash_pointer (id);
2744 : 1610 : in.hash = hash;
2745 : 1610 : in.name = id;
2746 : 1610 : slot = table->find_slot_with_hash (&in, hash, INSERT);
2747 : 1610 : h = new overloaded_name_hash;
2748 : 1610 : h->hash = hash;
2749 : 1610 : h->name = id;
2750 : 1610 : h->n = n;
2751 : 1610 : *slot = h;
2752 : 1610 : }
2753 : :
2754 : : /* Initialize the table with the problematic overloaded names. */
2755 : :
2756 : : static htable_t *
2757 : 115 : init_overloaded_names (void)
2758 : : {
2759 : 115 : static const char *names[] =
2760 : : /* The overloaded names from the /usr/include/string.h file. */
2761 : : { "memchr", "rawmemchr", "memrchr", "strchr", "strrchr", "strchrnul",
2762 : : "strpbrk", "strstr", "strcasestr", "index", "rindex", "basename" };
2763 : :
2764 : 115 : htable_t *table = new htable_t (64);
2765 : :
2766 : 1495 : for (unsigned int i = 0; i < ARRAY_SIZE (names); i++)
2767 : 1380 : add_name (names[i], 0, table);
2768 : :
2769 : : /* Consider that sigaction() is overloaded by struct sigaction for QNX. */
2770 : 115 : add_name ("sigaction", 1, table);
2771 : :
2772 : : /* Consider that stat() is overloaded by struct stat for QNX. */
2773 : 115 : add_name ("stat", 1, table);
2774 : :
2775 : 115 : return table;
2776 : : }
2777 : :
2778 : : /* Return the overloading index of NAME or 0 if NAME is not overloaded. */
2779 : :
2780 : : static unsigned int
2781 : 123 : overloading_index (tree name)
2782 : : {
2783 : 123 : struct overloaded_name_hash in, *h;
2784 : 123 : hashval_t hash = htab_hash_pointer (name);
2785 : 123 : in.hash = hash;
2786 : 123 : in.name = name;
2787 : 123 : h = overloaded_names->find_with_hash (&in, hash);
2788 : 123 : return h ? ++h->n : 0;
2789 : : }
2790 : :
2791 : : /* Dump in BUFFER constructor spec corresponding to T for TYPE. */
2792 : :
2793 : : static void
2794 : 32 : print_constructor (pretty_printer *buffer, tree t, tree type)
2795 : : {
2796 : 32 : tree decl_name = DECL_NAME (TYPE_NAME (type));
2797 : :
2798 : 32 : pp_string (buffer, "New_");
2799 : 32 : pp_ada_tree_identifier (buffer, decl_name, t, false);
2800 : 32 : }
2801 : :
2802 : : /* Dump in BUFFER destructor spec corresponding to T. */
2803 : :
2804 : : static void
2805 : 0 : print_destructor (pretty_printer *buffer, tree t, tree type)
2806 : : {
2807 : 0 : tree decl_name = DECL_NAME (TYPE_NAME (type));
2808 : :
2809 : 0 : pp_string (buffer, "Delete_");
2810 : 0 : if (startswith (IDENTIFIER_POINTER (DECL_NAME (t)), "__dt_del"))
2811 : 0 : pp_string (buffer, "And_Free_");
2812 : 0 : pp_ada_tree_identifier (buffer, decl_name, t, false);
2813 : 0 : }
2814 : :
2815 : : /* Dump in BUFFER assignment operator spec corresponding to T. */
2816 : :
2817 : : static void
2818 : 0 : print_assignment_operator (pretty_printer *buffer, tree t, tree type)
2819 : : {
2820 : 0 : tree decl_name = DECL_NAME (TYPE_NAME (type));
2821 : :
2822 : 0 : pp_string (buffer, "Assign_");
2823 : 0 : pp_ada_tree_identifier (buffer, decl_name, t, false);
2824 : 0 : }
2825 : :
2826 : : /* Return the name of type T. */
2827 : :
2828 : : static const char *
2829 : 70 : type_name (tree t)
2830 : : {
2831 : 70 : tree n = TYPE_NAME (t);
2832 : :
2833 : 70 : if (TREE_CODE (n) == IDENTIFIER_NODE)
2834 : 4 : return IDENTIFIER_POINTER (n);
2835 : : else
2836 : 66 : return IDENTIFIER_POINTER (DECL_NAME (n));
2837 : : }
2838 : :
2839 : : /* Dump in BUFFER the declaration of object T of type TYPE in Ada syntax.
2840 : : SPC is the indentation level. Return 1 if a declaration was printed,
2841 : : 0 otherwise. */
2842 : :
2843 : : static int
2844 : 699 : dump_ada_declaration (pretty_printer *buffer, tree t, tree type, int spc)
2845 : : {
2846 : 699 : bool is_var = false;
2847 : 699 : bool need_indent = false;
2848 : 699 : bool is_class = false;
2849 : 699 : tree name = TYPE_NAME (TREE_TYPE (t));
2850 : 699 : tree decl_name = DECL_NAME (t);
2851 : 699 : tree orig = NULL_TREE;
2852 : :
2853 : 699 : if (cpp_check && cpp_check (t, IS_TEMPLATE))
2854 : 12 : return dump_ada_template (buffer, t, spc);
2855 : :
2856 : : /* Skip enumeral values: will be handled as part of the type itself. */
2857 : 687 : if (TREE_CODE (t) == CONST_DECL && TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE)
2858 : : return 0;
2859 : :
2860 : 640 : if (TREE_CODE (t) == TYPE_DECL)
2861 : : {
2862 : 218 : orig = DECL_ORIGINAL_TYPE (t);
2863 : :
2864 : : /* This is a typedef. */
2865 : 218 : if (orig && TYPE_STUB_DECL (orig))
2866 : : {
2867 : 27 : tree stub = TYPE_STUB_DECL (orig);
2868 : :
2869 : : /* If this is a typedef of a named type, then output it as a subtype
2870 : : declaration. ??? Use a derived type declaration instead. */
2871 : 27 : if (TYPE_NAME (orig))
2872 : : {
2873 : : /* If the types have the same name (ignoring casing), then ignore
2874 : : the second type, but forward declare the first if need be. */
2875 : 25 : if (type_name (orig) == type_name (TREE_TYPE (t))
2876 : 25 : || !strcasecmp (type_name (orig), type_name (TREE_TYPE (t))))
2877 : : {
2878 : 5 : if (RECORD_OR_UNION_TYPE_P (orig) && !TREE_VISITED (stub))
2879 : : {
2880 : 0 : INDENT (spc);
2881 : 0 : dump_forward_type (buffer, orig, t, 0);
2882 : : }
2883 : :
2884 : 5 : TREE_VISITED (t) = 1;
2885 : 5 : return 0;
2886 : : }
2887 : :
2888 : 80 : INDENT (spc);
2889 : :
2890 : 20 : if (RECORD_OR_UNION_TYPE_P (orig) && !TREE_VISITED (stub))
2891 : 5 : dump_forward_type (buffer, orig, t, spc);
2892 : :
2893 : 20 : pp_string (buffer, "subtype ");
2894 : 20 : dump_ada_node (buffer, t, type, spc, false, true);
2895 : 20 : pp_string (buffer, " is ");
2896 : 20 : dump_ada_node (buffer, orig, type, spc, false, true);
2897 : 20 : pp_string (buffer, "; -- ");
2898 : 20 : dump_sloc (buffer, t);
2899 : :
2900 : 20 : TREE_VISITED (t) = 1;
2901 : 20 : return 1;
2902 : : }
2903 : :
2904 : : /* This is a typedef of an anonymous type. We'll output the full
2905 : : type declaration of the anonymous type with the typedef'ed name
2906 : : below. Prevent forward declarations for the anonymous type to
2907 : : be emitted from now on. */
2908 : 2 : TREE_VISITED (stub) = 1;
2909 : : }
2910 : :
2911 : : /* Skip unnamed or anonymous structs/unions/enum types. */
2912 : 193 : if (!orig
2913 : 181 : && (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t))
2914 : 23 : || TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE)
2915 : 181 : && !decl_name
2916 : 374 : && !name)
2917 : : return 0;
2918 : :
2919 : : /* Skip duplicates of structs/unions/enum types built in C++. */
2920 : 179 : if (!orig
2921 : 167 : && (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t))
2922 : 19 : || TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE)
2923 : 167 : && decl_name
2924 : 323 : && (*IDENTIFIER_POINTER (decl_name) == '.'
2925 : 128 : || *IDENTIFIER_POINTER (decl_name) == '$'))
2926 : : return 0;
2927 : :
2928 : 652 : INDENT (spc);
2929 : :
2930 : 163 : switch (TREE_CODE (TREE_TYPE (t)))
2931 : : {
2932 : 141 : case RECORD_TYPE:
2933 : 141 : case UNION_TYPE:
2934 : 141 : if (!COMPLETE_TYPE_P (TREE_TYPE (t)))
2935 : : {
2936 : 5 : pp_string (buffer, "type ");
2937 : 5 : dump_ada_node (buffer, t, type, spc, false, true);
2938 : 5 : pp_string (buffer, " is null record; -- incomplete struct");
2939 : 5 : TREE_VISITED (t) = 1;
2940 : 5 : return 1;
2941 : : }
2942 : :
2943 : : /* Packed record layout is not fully supported. */
2944 : 136 : if (TYPE_PACKED (TREE_TYPE (t)))
2945 : : {
2946 : 5 : warning_at (DECL_SOURCE_LOCATION (t), 0, "packed layout");
2947 : 5 : pp_string (buffer, "pragma Compile_Time_Warning (True, ");
2948 : 5 : pp_string (buffer, "\"packed layout may be incorrect\");");
2949 : 5 : newline_and_indent (buffer, spc);
2950 : 5 : packed_layout = true;
2951 : : }
2952 : :
2953 : 136 : if (orig && TYPE_NAME (orig))
2954 : 0 : pp_string (buffer, "subtype ");
2955 : : else
2956 : : {
2957 : 136 : if (separate_class_package (t))
2958 : : {
2959 : 24 : is_class = true;
2960 : 24 : pp_string (buffer, "package Class_");
2961 : 24 : dump_ada_node (buffer, t, type, spc, false, true);
2962 : 24 : pp_string (buffer, " is");
2963 : 24 : spc += INDENT_INCR;
2964 : 24 : newline_and_indent (buffer, spc);
2965 : : }
2966 : :
2967 : 136 : dump_nested_types (buffer, t, spc);
2968 : :
2969 : 136 : pp_string (buffer, "type ");
2970 : : }
2971 : : break;
2972 : :
2973 : 10 : case POINTER_TYPE:
2974 : 10 : case REFERENCE_TYPE:
2975 : 10 : dump_forward_type (buffer, TREE_TYPE (TREE_TYPE (t)), t, spc);
2976 : 10 : if (orig && TYPE_NAME (orig))
2977 : 0 : pp_string (buffer, "subtype ");
2978 : : else
2979 : 10 : pp_string (buffer, "type ");
2980 : : break;
2981 : :
2982 : 0 : case ARRAY_TYPE:
2983 : 0 : if ((orig && TYPE_NAME (orig)) || is_char_array (TREE_TYPE (t)))
2984 : 0 : pp_string (buffer, "subtype ");
2985 : : else
2986 : 0 : pp_string (buffer, "type ");
2987 : : break;
2988 : :
2989 : 0 : case FUNCTION_TYPE:
2990 : 0 : pp_string (buffer, "-- skipped function type ");
2991 : 0 : dump_ada_node (buffer, t, type, spc, false, true);
2992 : 0 : return 1;
2993 : :
2994 : 12 : case ENUMERAL_TYPE:
2995 : 1 : if ((orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
2996 : 13 : || !is_simple_enum (TREE_TYPE (t)))
2997 : 6 : pp_string (buffer, "subtype ");
2998 : : else
2999 : 6 : pp_string (buffer, "type ");
3000 : : break;
3001 : :
3002 : 0 : default:
3003 : 0 : pp_string (buffer, "subtype ");
3004 : : }
3005 : :
3006 : 158 : TREE_VISITED (t) = 1;
3007 : : }
3008 : : else
3009 : : {
3010 : 422 : if (VAR_P (t)
3011 : 38 : && decl_name
3012 : 460 : && *IDENTIFIER_POINTER (decl_name) == '_')
3013 : : return 0;
3014 : :
3015 : : need_indent = true;
3016 : : }
3017 : :
3018 : : /* Print the type and name. */
3019 : 560 : if (TREE_CODE (TREE_TYPE (t)) == ARRAY_TYPE)
3020 : : {
3021 : 29 : if (need_indent)
3022 : 203 : INDENT (spc);
3023 : :
3024 : : /* Print variable's name. */
3025 : 29 : dump_ada_node (buffer, t, type, spc, false, true);
3026 : :
3027 : 29 : if (TREE_CODE (t) == TYPE_DECL)
3028 : : {
3029 : 0 : pp_string (buffer, " is ");
3030 : :
3031 : 0 : if (orig && TYPE_NAME (orig))
3032 : 0 : dump_ada_node (buffer, TYPE_NAME (orig), type, spc, false, true);
3033 : : else
3034 : 0 : dump_ada_array_type (buffer, TREE_TYPE (t), spc);
3035 : : }
3036 : : else
3037 : : {
3038 : 29 : if (spc == INDENT_INCR || TREE_STATIC (t))
3039 : 0 : is_var = true;
3040 : :
3041 : 29 : pp_string (buffer, " : ");
3042 : :
3043 : 29 : if (TREE_CODE (TREE_TYPE (TREE_TYPE (t))) != POINTER_TYPE
3044 : 29 : && !packed_layout)
3045 : 24 : pp_string (buffer, "aliased ");
3046 : :
3047 : 29 : if (TYPE_NAME (TREE_TYPE (t)))
3048 : 0 : dump_ada_node (buffer, TREE_TYPE (t), type, spc, false, true);
3049 : 29 : else if (type)
3050 : 29 : dump_anonymous_type_name (buffer, TREE_TYPE (t));
3051 : : else
3052 : 0 : dump_ada_array_type (buffer, TREE_TYPE (t), spc);
3053 : : }
3054 : : }
3055 : 531 : else if (TREE_CODE (t) == FUNCTION_DECL)
3056 : : {
3057 : 228 : tree decl_name = DECL_NAME (t);
3058 : 228 : bool is_abstract_class = false;
3059 : 228 : bool is_method = TREE_CODE (TREE_TYPE (t)) == METHOD_TYPE;
3060 : 228 : bool is_abstract = false;
3061 : 228 : bool is_assignment_operator = false;
3062 : 228 : bool is_constructor = false;
3063 : 228 : bool is_destructor = false;
3064 : 228 : bool is_copy_constructor = false;
3065 : 228 : bool is_move_constructor = false;
3066 : :
3067 : 228 : if (!decl_name)
3068 : : return 0;
3069 : :
3070 : 228 : if (cpp_check)
3071 : : {
3072 : 217 : is_abstract = cpp_check (t, IS_ABSTRACT);
3073 : 217 : is_assignment_operator = cpp_check (t, IS_ASSIGNMENT_OPERATOR);
3074 : 217 : is_constructor = cpp_check (t, IS_CONSTRUCTOR);
3075 : 217 : is_destructor = cpp_check (t, IS_DESTRUCTOR);
3076 : 217 : is_copy_constructor = cpp_check (t, IS_COPY_CONSTRUCTOR);
3077 : 217 : is_move_constructor = cpp_check (t, IS_MOVE_CONSTRUCTOR);
3078 : : }
3079 : :
3080 : : /* Skip copy constructors and C++11 move constructors: some are internal
3081 : : only and those that are not cannot be called easily from Ada. */
3082 : 228 : if (is_copy_constructor || is_move_constructor)
3083 : : return 0;
3084 : :
3085 : 189 : if (is_constructor || is_destructor)
3086 : : {
3087 : : /* ??? Skip implicit constructors/destructors for now. */
3088 : 66 : if (DECL_ARTIFICIAL (t))
3089 : : return 0;
3090 : :
3091 : : /* Only consider complete constructors and deleting destructors. */
3092 : 48 : if (!startswith (IDENTIFIER_POINTER (decl_name), "__ct_comp")
3093 : 32 : && !startswith (IDENTIFIER_POINTER (decl_name), "__dt_comp")
3094 : 80 : && !startswith (IDENTIFIER_POINTER (decl_name), "__dt_del"))
3095 : : return 0;
3096 : : }
3097 : :
3098 : 123 : else if (is_assignment_operator)
3099 : : {
3100 : : /* ??? Skip implicit or non-method assignment operators for now. */
3101 : 0 : if (DECL_ARTIFICIAL (t) || !is_method)
3102 : : return 0;
3103 : : }
3104 : :
3105 : : /* If this function has an entry in the vtable, we cannot omit it. */
3106 : 218 : else if (!DECL_VINDEX (t) && *IDENTIFIER_POINTER (decl_name) == '_')
3107 : : {
3108 : 0 : INDENT (spc);
3109 : 0 : pp_string (buffer, "-- skipped func ");
3110 : 0 : pp_string (buffer, IDENTIFIER_POINTER (decl_name));
3111 : 0 : return 1;
3112 : : }
3113 : :
3114 : 736 : INDENT (spc);
3115 : :
3116 : 139 : dump_forward_type (buffer, TREE_TYPE (t), t, spc);
3117 : :
3118 : 139 : if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t))) && !is_constructor)
3119 : 24 : pp_string (buffer, "procedure ");
3120 : : else
3121 : 115 : pp_string (buffer, "function ");
3122 : :
3123 : 139 : if (is_constructor)
3124 : 16 : print_constructor (buffer, t, type);
3125 : 123 : else if (is_destructor)
3126 : 0 : print_destructor (buffer, t, type);
3127 : 123 : else if (is_assignment_operator)
3128 : 0 : print_assignment_operator (buffer, t, type);
3129 : : else
3130 : : {
3131 : 123 : const unsigned int suffix = overloading_index (decl_name);
3132 : 123 : pp_ada_tree_identifier (buffer, decl_name, t, false);
3133 : 123 : if (suffix > 1)
3134 : 0 : pp_decimal_int (buffer, suffix);
3135 : : }
3136 : :
3137 : 139 : dump_ada_function_declaration
3138 : 139 : (buffer, t, is_method, is_constructor, is_destructor, spc);
3139 : :
3140 : 139 : if (is_constructor && RECORD_OR_UNION_TYPE_P (type))
3141 : 141 : for (tree fld = TYPE_FIELDS (type); fld; fld = DECL_CHAIN (fld))
3142 : 125 : if (TREE_CODE (fld) == FUNCTION_DECL && cpp_check (fld, IS_ABSTRACT))
3143 : : {
3144 : : is_abstract_class = true;
3145 : : break;
3146 : : }
3147 : :
3148 : 139 : if (is_abstract || is_abstract_class)
3149 : 4 : pp_string (buffer, " is abstract");
3150 : :
3151 : 139 : if (is_abstract || !DECL_ASSEMBLER_NAME (t))
3152 : : {
3153 : 4 : pp_semicolon (buffer);
3154 : 4 : pp_string (buffer, " -- ");
3155 : 4 : dump_sloc (buffer, t);
3156 : : }
3157 : 135 : else if (is_constructor)
3158 : : {
3159 : 16 : pp_semicolon (buffer);
3160 : 16 : pp_string (buffer, " -- ");
3161 : 16 : dump_sloc (buffer, t);
3162 : :
3163 : 16 : newline_and_indent (buffer, spc);
3164 : 16 : pp_string (buffer, "pragma CPP_Constructor (");
3165 : 16 : print_constructor (buffer, t, type);
3166 : 16 : pp_string (buffer, ", \"");
3167 : 16 : pp_asm_name (buffer, t);
3168 : 16 : pp_string (buffer, "\");");
3169 : : }
3170 : : else
3171 : : {
3172 : 119 : pp_string (buffer, " -- ");
3173 : 119 : dump_sloc (buffer, t);
3174 : :
3175 : 119 : newline_and_indent (buffer, spc);
3176 : 119 : dump_ada_import (buffer, t, spc);
3177 : : }
3178 : :
3179 : 139 : return 1;
3180 : : }
3181 : 303 : else if (TREE_CODE (t) == TYPE_DECL && !orig)
3182 : : {
3183 : 146 : bool is_interface = false;
3184 : 146 : bool is_abstract_record = false;
3185 : :
3186 : : /* Anonymous structs/unions. */
3187 : 146 : dump_ada_node (buffer, TREE_TYPE (t), t, spc, false, true);
3188 : :
3189 : 146 : if (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE)
3190 : 0 : pp_string (buffer, " (discr : unsigned := 0)");
3191 : :
3192 : 146 : pp_string (buffer, " is ");
3193 : :
3194 : : /* Check whether we have an Ada interface compatible class.
3195 : : That is only have a vtable non-static data member and no
3196 : : non-abstract methods. */
3197 : 146 : if (cpp_check
3198 : 146 : && RECORD_OR_UNION_TYPE_P (TREE_TYPE (t)))
3199 : : {
3200 : 116 : bool has_fields = false;
3201 : :
3202 : : /* Check that there are no fields other than the virtual table. */
3203 : 116 : for (tree fld = TYPE_FIELDS (TREE_TYPE (t));
3204 : 545 : fld;
3205 : 429 : fld = TREE_CHAIN (fld))
3206 : : {
3207 : 429 : if (TREE_CODE (fld) == FIELD_DECL)
3208 : : {
3209 : 116 : if (!has_fields && DECL_VIRTUAL_P (fld))
3210 : : is_interface = true;
3211 : : else
3212 : : is_interface = false;
3213 : : has_fields = true;
3214 : : }
3215 : 313 : else if (TREE_CODE (fld) == FUNCTION_DECL
3216 : 313 : && !DECL_ARTIFICIAL (fld))
3217 : : {
3218 : 76 : if (cpp_check (fld, IS_ABSTRACT))
3219 : : is_abstract_record = true;
3220 : : else
3221 : 72 : is_interface = false;
3222 : : }
3223 : : }
3224 : : }
3225 : :
3226 : 146 : TREE_VISITED (t) = 1;
3227 : 146 : if (is_interface)
3228 : : {
3229 : 4 : pp_string (buffer, "limited interface -- ");
3230 : 4 : dump_sloc (buffer, t);
3231 : 4 : newline_and_indent (buffer, spc);
3232 : 4 : pp_string (buffer, "with Import => True,");
3233 : 4 : newline_and_indent (buffer, spc + 5);
3234 : 4 : pp_string (buffer, "Convention => CPP");
3235 : :
3236 : 4 : dump_ada_methods (buffer, TREE_TYPE (t), spc);
3237 : : }
3238 : : else
3239 : : {
3240 : 142 : if (is_abstract_record)
3241 : 0 : pp_string (buffer, "abstract ");
3242 : 142 : dump_ada_node (buffer, t, t, spc, false, false);
3243 : : }
3244 : : }
3245 : : else
3246 : : {
3247 : 157 : if (need_indent)
3248 : 1015 : INDENT (spc);
3249 : :
3250 : 157 : if ((TREE_CODE (t) == FIELD_DECL || VAR_P (t))
3251 : 157 : && DECL_NAME (t))
3252 : 145 : check_type_name_conflict (buffer, t);
3253 : :
3254 : : /* Print variable/type's name. */
3255 : 157 : dump_ada_node (buffer, t, t, spc, false, true);
3256 : :
3257 : 157 : if (TREE_CODE (t) == TYPE_DECL)
3258 : : {
3259 : 12 : const bool is_subtype = TYPE_NAME (orig);
3260 : :
3261 : 12 : if (!is_subtype && TREE_CODE (TREE_TYPE (t)) == UNION_TYPE)
3262 : 0 : pp_string (buffer, " (discr : unsigned := 0)");
3263 : :
3264 : 12 : pp_string (buffer, " is ");
3265 : :
3266 : 12 : dump_ada_node (buffer, orig, t, spc, false, is_subtype);
3267 : : }
3268 : : else
3269 : : {
3270 : 145 : if (spc == INDENT_INCR || TREE_STATIC (t))
3271 : 18 : is_var = true;
3272 : :
3273 : 145 : pp_string (buffer, " : ");
3274 : :
3275 : 145 : if (TREE_CODE (TREE_TYPE (t)) != POINTER_TYPE
3276 : 130 : && (TYPE_NAME (TREE_TYPE (t))
3277 : 8 : || (TREE_CODE (TREE_TYPE (t)) != INTEGER_TYPE
3278 : 8 : && TREE_CODE (TREE_TYPE (t)) != ENUMERAL_TYPE))
3279 : 272 : && !packed_layout)
3280 : 117 : pp_string (buffer, "aliased ");
3281 : :
3282 : 145 : if (TREE_READONLY (t) && TREE_CODE (t) != FIELD_DECL)
3283 : 0 : pp_string (buffer, "constant ");
3284 : :
3285 : 145 : if (TYPE_NAME (TREE_TYPE (t))
3286 : 145 : || (!RECORD_OR_UNION_TYPE_P (TREE_TYPE (t))
3287 : 18 : && TREE_CODE (TREE_TYPE (t)) != ENUMERAL_TYPE))
3288 : 137 : dump_ada_node (buffer, TREE_TYPE (t), t, spc, false, true);
3289 : 8 : else if (type)
3290 : 6 : dump_anonymous_type_name (buffer, TREE_TYPE (t));
3291 : : }
3292 : : }
3293 : :
3294 : 332 : if (is_class)
3295 : : {
3296 : 24 : spc -= INDENT_INCR;
3297 : 24 : newline_and_indent (buffer, spc);
3298 : 24 : pp_string (buffer, "end;");
3299 : 24 : newline_and_indent (buffer, spc);
3300 : 24 : pp_string (buffer, "use Class_");
3301 : 24 : dump_ada_node (buffer, t, type, spc, false, true);
3302 : 24 : pp_semicolon (buffer);
3303 : 24 : pp_newline (buffer);
3304 : :
3305 : : /* All needed indentation/newline performed already, so return 0. */
3306 : 24 : return 0;
3307 : : }
3308 : 308 : else if (is_var)
3309 : : {
3310 : 18 : pp_string (buffer, " -- ");
3311 : 18 : dump_sloc (buffer, t);
3312 : 18 : newline_and_indent (buffer, spc);
3313 : 18 : dump_ada_import (buffer, t, spc);
3314 : : }
3315 : :
3316 : : else
3317 : : {
3318 : 290 : pp_string (buffer, "; -- ");
3319 : 290 : dump_sloc (buffer, t);
3320 : : }
3321 : :
3322 : : return 1;
3323 : : }
3324 : :
3325 : : /* Dump in BUFFER a structure NODE of type TYPE in Ada syntax. If NESTED is
3326 : : true, it's an anonymous nested type. SPC is the indentation level. */
3327 : :
3328 : : static void
3329 : 180 : dump_ada_structure (pretty_printer *buffer, tree node, tree type, bool nested,
3330 : : int spc)
3331 : : {
3332 : 180 : const bool is_union = (TREE_CODE (node) == UNION_TYPE);
3333 : 180 : char buf[32];
3334 : 180 : int field_num = 0;
3335 : 180 : int field_spc = spc + INDENT_INCR;
3336 : 180 : int need_semicolon;
3337 : :
3338 : 180 : bitfield_used = false;
3339 : :
3340 : : /* Print the contents of the structure. */
3341 : 180 : pp_string (buffer, "record");
3342 : :
3343 : 180 : if (is_union)
3344 : : {
3345 : 5 : newline_and_indent (buffer, spc + INDENT_INCR);
3346 : 5 : pp_string (buffer, "case discr is");
3347 : 5 : field_spc = spc + INDENT_INCR * 3;
3348 : : }
3349 : :
3350 : 180 : pp_newline (buffer);
3351 : :
3352 : : /* Print the non-static fields of the structure. */
3353 : 753 : for (tree tmp = TYPE_FIELDS (node); tmp; tmp = TREE_CHAIN (tmp))
3354 : : {
3355 : : /* Add parent field if needed. */
3356 : 573 : if (!DECL_NAME (tmp))
3357 : : {
3358 : 4 : if (!is_tagged_type (TREE_TYPE (tmp)))
3359 : : {
3360 : 0 : if (!TYPE_NAME (TREE_TYPE (tmp)))
3361 : 0 : dump_ada_declaration (buffer, tmp, type, field_spc);
3362 : : else
3363 : : {
3364 : 0 : INDENT (field_spc);
3365 : :
3366 : 0 : if (field_num == 0)
3367 : 0 : pp_string (buffer, "parent : aliased ");
3368 : : else
3369 : : {
3370 : 0 : sprintf (buf, "field_%d : aliased ", field_num + 1);
3371 : 0 : pp_string (buffer, buf);
3372 : : }
3373 : 0 : dump_ada_decl_name (buffer, TYPE_NAME (TREE_TYPE (tmp)),
3374 : : false);
3375 : 0 : pp_semicolon (buffer);
3376 : : }
3377 : :
3378 : 0 : pp_newline (buffer);
3379 : 0 : field_num++;
3380 : : }
3381 : : }
3382 : 569 : else if (TREE_CODE (tmp) == FIELD_DECL)
3383 : : {
3384 : : /* Skip internal virtual table field. */
3385 : 168 : if (!DECL_VIRTUAL_P (tmp))
3386 : : {
3387 : 156 : if (is_union)
3388 : : {
3389 : 5 : if (TREE_CHAIN (tmp)
3390 : 4 : && TREE_TYPE (TREE_CHAIN (tmp)) != node
3391 : 9 : && TREE_CODE (TREE_CHAIN (tmp)) != TYPE_DECL)
3392 : 0 : sprintf (buf, "when %d =>", field_num);
3393 : : else
3394 : 5 : sprintf (buf, "when others =>");
3395 : :
3396 : 50 : INDENT (spc + INDENT_INCR * 2);
3397 : 5 : pp_string (buffer, buf);
3398 : 5 : pp_newline (buffer);
3399 : : }
3400 : :
3401 : 156 : if (dump_ada_declaration (buffer, tmp, type, field_spc))
3402 : : {
3403 : 156 : pp_newline (buffer);
3404 : 156 : field_num++;
3405 : : }
3406 : : }
3407 : : }
3408 : : }
3409 : :
3410 : 180 : if (is_union)
3411 : : {
3412 : 35 : INDENT (spc + INDENT_INCR);
3413 : 5 : pp_string (buffer, "end case;");
3414 : 5 : pp_newline (buffer);
3415 : : }
3416 : :
3417 : 180 : if (field_num == 0)
3418 : : {
3419 : 338 : INDENT (spc + INDENT_INCR);
3420 : 38 : pp_string (buffer, "null;");
3421 : 38 : pp_newline (buffer);
3422 : : }
3423 : :
3424 : 804 : INDENT (spc);
3425 : 180 : pp_string (buffer, "end record");
3426 : :
3427 : 180 : newline_and_indent (buffer, spc);
3428 : :
3429 : : /* We disregard the methods for anonymous nested types. */
3430 : 180 : if (has_nontrivial_methods (node) && !nested)
3431 : : {
3432 : 28 : pp_string (buffer, "with Import => True,");
3433 : 28 : newline_and_indent (buffer, spc + 5);
3434 : 28 : pp_string (buffer, "Convention => CPP");
3435 : : }
3436 : : else
3437 : 152 : pp_string (buffer, "with Convention => C_Pass_By_Copy");
3438 : :
3439 : 180 : if (is_union)
3440 : : {
3441 : 5 : pp_comma (buffer);
3442 : 5 : newline_and_indent (buffer, spc + 5);
3443 : 5 : pp_string (buffer, "Unchecked_Union => True");
3444 : : }
3445 : :
3446 : 180 : if (bitfield_used || packed_layout)
3447 : : {
3448 : 5 : char buf[32];
3449 : 5 : pp_comma (buffer);
3450 : 5 : newline_and_indent (buffer, spc + 5);
3451 : 5 : pp_string (buffer, "Pack => True");
3452 : 5 : pp_comma (buffer);
3453 : 5 : newline_and_indent (buffer, spc + 5);
3454 : 5 : sprintf (buf, "Alignment => %d", TYPE_ALIGN (node) / BITS_PER_UNIT);
3455 : 5 : pp_string (buffer, buf);
3456 : 5 : bitfield_used = false;
3457 : 5 : packed_layout = false;
3458 : : }
3459 : :
3460 : 180 : if (nested)
3461 : 40 : return;
3462 : :
3463 : 140 : need_semicolon = !dump_ada_methods (buffer, node, spc);
3464 : :
3465 : : /* Print the static fields of the structure, if any. */
3466 : 641 : for (tree tmp = TYPE_FIELDS (node); tmp; tmp = TREE_CHAIN (tmp))
3467 : : {
3468 : 501 : if (VAR_P (tmp) && DECL_NAME (tmp))
3469 : : {
3470 : 4 : if (need_semicolon)
3471 : : {
3472 : 0 : need_semicolon = false;
3473 : 0 : pp_semicolon (buffer);
3474 : : }
3475 : 4 : pp_newline (buffer);
3476 : 4 : pp_newline (buffer);
3477 : 4 : dump_ada_declaration (buffer, tmp, type, spc);
3478 : : }
3479 : : }
3480 : : }
3481 : :
3482 : : /* Dump all the declarations in SOURCE_FILE to an Ada spec.
3483 : : COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3484 : : nodes for SOURCE_FILE. CHECK is used to perform C++ queries on nodes. */
3485 : :
3486 : : static void
3487 : 115 : dump_ads (const char *source_file,
3488 : : void (*collect_all_refs)(const char *),
3489 : : int (*check)(tree, cpp_operation))
3490 : : {
3491 : 115 : char *ads_name;
3492 : 115 : char *pkg_name;
3493 : 115 : char *s;
3494 : 115 : FILE *f;
3495 : :
3496 : 115 : pkg_name = get_ada_package (source_file);
3497 : :
3498 : : /* Construct the .ads filename and package name. */
3499 : 115 : ads_name = xstrdup (pkg_name);
3500 : :
3501 : 2219 : for (s = ads_name; *s; s++)
3502 : 1989 : if (*s == '.')
3503 : 0 : *s = '-';
3504 : : else
3505 : 1989 : *s = TOLOWER (*s);
3506 : :
3507 : 115 : ads_name = reconcat (ads_name, ads_name, ".ads", NULL);
3508 : :
3509 : : /* Write out the .ads file. */
3510 : 115 : f = fopen (ads_name, "w");
3511 : 115 : if (f)
3512 : : {
3513 : 115 : pretty_printer pp;
3514 : :
3515 : 115 : pp_needs_newline (&pp) = true;
3516 : 115 : pp.buffer->stream = f;
3517 : :
3518 : : /* Dump all relevant macros. */
3519 : 115 : dump_ada_macros (&pp, source_file);
3520 : :
3521 : : /* Reset the table of withs for this file. */
3522 : 115 : reset_ada_withs ();
3523 : :
3524 : 115 : (*collect_all_refs) (source_file);
3525 : :
3526 : : /* Dump all references. */
3527 : 115 : cpp_check = check;
3528 : 115 : dump_ada_nodes (&pp, source_file);
3529 : :
3530 : : /* We require Ada 2012 syntax, so generate corresponding pragma. */
3531 : 115 : fputs ("pragma Ada_2012;\n\n", f);
3532 : :
3533 : : /* Disable style checks and warnings on unused entities since this file
3534 : : is auto-generated and always has a with clause for Interfaces.C. */
3535 : 115 : fputs ("pragma Style_Checks (Off);\n", f);
3536 : 115 : fputs ("pragma Warnings (Off, \"-gnatwu\");\n\n", f);
3537 : :
3538 : : /* Dump withs. */
3539 : 115 : dump_ada_withs (f);
3540 : :
3541 : 115 : fprintf (f, "\npackage %s is\n\n", pkg_name);
3542 : 115 : pp_write_text_to_stream (&pp);
3543 : : /* ??? need to free pp */
3544 : 115 : fprintf (f, "end %s;\n\n", pkg_name);
3545 : :
3546 : 115 : fputs ("pragma Style_Checks (On);\n", f);
3547 : 115 : fputs ("pragma Warnings (On, \"-gnatwu\");\n", f);
3548 : 115 : fclose (f);
3549 : 115 : }
3550 : :
3551 : 115 : free (ads_name);
3552 : 115 : free (pkg_name);
3553 : 115 : }
3554 : :
3555 : : static const char **source_refs = NULL;
3556 : : static int source_refs_used = 0;
3557 : : static int source_refs_allocd = 0;
3558 : :
3559 : : /* Add an entry for FILENAME to the table SOURCE_REFS. */
3560 : :
3561 : : void
3562 : 509 : collect_source_ref (const char *filename)
3563 : : {
3564 : 509 : int i;
3565 : :
3566 : 509 : if (!filename)
3567 : : return;
3568 : :
3569 : 509 : if (source_refs_allocd == 0)
3570 : : {
3571 : 115 : source_refs_allocd = 1024;
3572 : 115 : source_refs = XNEWVEC (const char *, source_refs_allocd);
3573 : : }
3574 : :
3575 : 509 : for (i = 0; i < source_refs_used; i++)
3576 : 394 : if (filename == source_refs[i])
3577 : : return;
3578 : :
3579 : 115 : if (source_refs_used == source_refs_allocd)
3580 : : {
3581 : 0 : source_refs_allocd *= 2;
3582 : 0 : source_refs = XRESIZEVEC (const char *, source_refs, source_refs_allocd);
3583 : : }
3584 : :
3585 : 115 : source_refs[source_refs_used++] = filename;
3586 : : }
3587 : :
3588 : : /* Main entry point: dump all Ada specs corresponding to SOURCE_REFS
3589 : : using callbacks COLLECT_ALL_REFS and CHECK.
3590 : : COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3591 : : nodes for a given source file.
3592 : : CHECK is used to perform C++ queries on nodes, or NULL for the C
3593 : : front-end. */
3594 : :
3595 : : void
3596 : 115 : dump_ada_specs (void (*collect_all_refs)(const char *),
3597 : : int (*check)(tree, cpp_operation))
3598 : : {
3599 : 115 : bitmap_obstack_initialize (NULL);
3600 : :
3601 : 115 : overloaded_names = init_overloaded_names ();
3602 : :
3603 : : /* Iterate over the list of files to dump specs for. */
3604 : 230 : for (int i = 0; i < source_refs_used; i++)
3605 : : {
3606 : 115 : dumped_anonymous_types = BITMAP_ALLOC (NULL);
3607 : 115 : dump_ads (source_refs[i], collect_all_refs, check);
3608 : 115 : BITMAP_FREE (dumped_anonymous_types);
3609 : : }
3610 : :
3611 : : /* Free various tables. */
3612 : 115 : free (source_refs);
3613 : 115 : delete overloaded_names;
3614 : :
3615 : 115 : bitmap_obstack_release (NULL);
3616 : 115 : }
|
