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