]> 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
[nvptx] Fix prevent_branch_around_nothing
[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
9e25c7ed
EB		 1514/* Dump in BUFFER the name of a DECL node if set, in Ada syntax.
1515 LIMITED_ACCESS indicates whether NODE can be accessed via a
1516 limited 'with' clause rather than a regular 'with' clause. */
9cc54940
AC		 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;
9e25c7ed
EB		 1574 case ENUMERAL_TYPE:
1575 pp_string (buffer, "_enum");
1576 break;
f07862c7
EB		 1577 case RECORD_TYPE:
1578 pp_string (buffer, "_struct");
1579 break;
1580 case UNION_TYPE:
1581 pp_string (buffer, "_union");
1582 break;
1583 default:
1584 pp_string (buffer, "_unknown");
1585 break;
1586 }
9cc54940
AC		 1587}
1588
1589/* Dump in BUFFER pragma Import C/CPP on a given node T. */
1590
1591static void
1592dump_ada_import (pretty_printer *buffer, tree t)
1593{
1594 const char *name = IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (t));
095d8d4b
EB		 1595 const bool is_stdcall
1596 = TREE_CODE (t) == FUNCTION_DECL
1597 && lookup_attribute ("stdcall", TYPE_ATTRIBUTES (TREE_TYPE (t)));
9cc54940
AC		 1598
1599 if (is_stdcall)
1600 pp_string (buffer, "pragma Import (Stdcall, ");
0b07a57e 1601 else if (name[0] == '_' && name[1] == 'Z')
9cc54940
AC		 1602 pp_string (buffer, "pragma Import (CPP, ");
1603 else
1604 pp_string (buffer, "pragma Import (C, ");
1605
1606 dump_ada_decl_name (buffer, t, false);
1607 pp_string (buffer, ", \"");
1608
1609 if (is_stdcall)
1610 pp_string (buffer, IDENTIFIER_POINTER (DECL_NAME (t)));
1611 else
1612 pp_asm_name (buffer, t);
1613
1614 pp_string (buffer, "\");");
1615}
1616
1617/* Check whether T and its type have different names, and append "the_"
1618 otherwise in BUFFER. */
1619
1620static void
1621check_name (pretty_printer *buffer, tree t)
1622{
1623 const char *s;
1624 tree tmp = TREE_TYPE (t);
1625
1626 while (TREE_CODE (tmp) == POINTER_TYPE && !TYPE_NAME (tmp))
1627 tmp = TREE_TYPE (tmp);
1628
1629 if (TREE_CODE (tmp) != FUNCTION_TYPE)
1630 {
1631 if (TREE_CODE (tmp) == IDENTIFIER_NODE)
1632 s = IDENTIFIER_POINTER (tmp);
1633 else if (!TYPE_NAME (tmp))
1634 s = "";
1635 else if (TREE_CODE (TYPE_NAME (tmp)) == IDENTIFIER_NODE)
1636 s = IDENTIFIER_POINTER (TYPE_NAME (tmp));
1637 else
1638 s = IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp)));
1639
1640 if (!strcasecmp (IDENTIFIER_POINTER (DECL_NAME (t)), s))
1641 pp_string (buffer, "the_");
1642 }
1643}
1644
9e25c7ed 1645/* Dump in BUFFER a function declaration FUNC in Ada syntax.
9cc54940
AC		 1646 IS_METHOD indicates whether FUNC is a C++ method.
1647 IS_CONSTRUCTOR whether FUNC is a C++ constructor.
1648 IS_DESTRUCTOR whether FUNC is a C++ destructor.
1649 SPC is the current indentation level. */
1650
79310774 1651static void
9cc54940 1652dump_ada_function_declaration (pretty_printer *buffer, tree func,
79310774
EB		 1653 bool is_method, bool is_constructor,
1654 bool is_destructor, int spc)
9cc54940
AC		 1655{
1656 tree arg;
1657 const tree node = TREE_TYPE (func);
3d7b83b6 1658 char buf[17];
9cc54940
AC		 1659 int num = 0, num_args = 0, have_args = true, have_ellipsis = false;
1660
1661 /* Compute number of arguments. */
1662 arg = TYPE_ARG_TYPES (node);
1663
1664 if (arg)
1665 {
1666 while (TREE_CHAIN (arg) && arg != error_mark_node)
1667 {
1668 num_args++;
1669 arg = TREE_CHAIN (arg);
1670 }
1671
1672 if (TREE_CODE (TREE_VALUE (arg)) != VOID_TYPE)
1673 {
1674 num_args++;
1675 have_ellipsis = true;
1676 }
1677 }
1678
1679 if (is_constructor)
1680 num_args--;
1681
1682 if (is_destructor)
1683 num_args = 1;
1684
1685 if (num_args > 2)
1686 newline_and_indent (buffer, spc + 1);
1687
1688 if (num_args > 0)
1689 {
1690 pp_space (buffer);
07838b13 1691 pp_left_paren (buffer);
9cc54940
AC		 1692 }
1693
1694 if (TREE_CODE (func) == FUNCTION_DECL)
1695 arg = DECL_ARGUMENTS (func);
1696 else
1697 arg = NULL_TREE;
1698
1699 if (arg == NULL_TREE)
1700 {
1701 have_args = false;
1702 arg = TYPE_ARG_TYPES (node);
1703
1704 if (arg && TREE_CODE (TREE_VALUE (arg)) == VOID_TYPE)
1705 arg = NULL_TREE;
1706 }
1707
1708 if (is_constructor)
1709 arg = TREE_CHAIN (arg);
1710
1711 /* Print the argument names (if available) & types. */
1712
1713 for (num = 1; num <= num_args; num++)
1714 {
1715 if (have_args)
1716 {
1717 if (DECL_NAME (arg))
1718 {
1719 check_name (buffer, arg);
6e3e8419 1720 pp_ada_tree_identifier (buffer, DECL_NAME (arg), NULL_TREE, 0,
f4bcd9eb 1721 false);
9cc54940
AC		 1722 pp_string (buffer, " : ");
1723 }
1724 else
1725 {
1726 sprintf (buf, "arg%d : ", num);
1727 pp_string (buffer, buf);
1728 }
1729
e02f4b92 1730 dump_ada_node (buffer, TREE_TYPE (arg), node, spc, false, true);
9cc54940
AC		 1731 }
1732 else
1733 {
1734 sprintf (buf, "arg%d : ", num);
1735 pp_string (buffer, buf);
e02f4b92 1736 dump_ada_node (buffer, TREE_VALUE (arg), node, spc, false, true);
9cc54940
AC		 1737 }
1738
59909673
EB		 1739 /* If the type is a pointer to a tagged type, we need to differentiate
1740 virtual methods from the rest (non-virtual methods, static member
1741 or regular functions) and import only them as primitive operations,
1742 because they make up the virtual table which is mirrored on the Ada
1743 side by the dispatch table. So we add 'Class to the type of every
1744 parameter that is not the first one of a method which either has a
1745 slot in the virtual table or is a constructor. */
1746 if (TREE_TYPE (arg)
1747 && POINTER_TYPE_P (TREE_TYPE (arg))
1748 && is_tagged_type (TREE_TYPE (TREE_TYPE (arg)))
1749 && !(num == 1 && is_method && (DECL_VINDEX (func) || is_constructor)))
1750 pp_string (buffer, "'Class");
9cc54940
AC		 1751
1752 arg = TREE_CHAIN (arg);
1753
1754 if (num < num_args)
1755 {
07838b13 1756 pp_semicolon (buffer);
9cc54940
AC		 1757
1758 if (num_args > 2)
1759 newline_and_indent (buffer, spc + INDENT_INCR);
1760 else
1761 pp_space (buffer);
1762 }
1763 }
1764
1765 if (have_ellipsis)
1766 {
1767 pp_string (buffer, " -- , ...");
1768 newline_and_indent (buffer, spc + INDENT_INCR);
1769 }
1770
1771 if (num_args > 0)
07838b13 1772 pp_right_paren (buffer);
79310774
EB		 1773
1774 if (is_constructor || !VOID_TYPE_P (TREE_TYPE (node)))
1775 {
1776 pp_string (buffer, " return ");
1777 tree type = is_constructor ? DECL_CONTEXT (func) : TREE_TYPE (node);
e02f4b92 1778 dump_ada_node (buffer, type, type, spc, false, true);
79310774 1779 }
9cc54940
AC		 1780}
1781
1782/* Dump in BUFFER all the domains associated with an array NODE,
9e25c7ed 1783 in Ada syntax. SPC is the current indentation level. */
9cc54940
AC		 1784
1785static void
1786dump_ada_array_domains (pretty_printer *buffer, tree node, int spc)
1787{
1788 int first = 1;
07838b13 1789 pp_left_paren (buffer);
9cc54940
AC		 1790
1791 for (; TREE_CODE (node) == ARRAY_TYPE; node = TREE_TYPE (node))
1792 {
1793 tree domain = TYPE_DOMAIN (node);
1794
1795 if (domain)
1796 {
1797 tree min = TYPE_MIN_VALUE (domain);
1798 tree max = TYPE_MAX_VALUE (domain);
1799
1800 if (!first)
1801 pp_string (buffer, ", ");
1802 first = 0;
1803
1804 if (min)
e02f4b92 1805 dump_ada_node (buffer, min, NULL_TREE, spc, false, true);
9cc54940
AC		 1806 pp_string (buffer, " .. ");
1807
1808 /* If the upper bound is zero, gcc may generate a NULL_TREE
1809 for TYPE_MAX_VALUE rather than an integer_cst. */
1810 if (max)
e02f4b92 1811 dump_ada_node (buffer, max, NULL_TREE, spc, false, true);
9cc54940
AC		 1812 else
1813 pp_string (buffer, "0");
1814 }
1815 else
1816 pp_string (buffer, "size_t");
1817 }
07838b13 1818 pp_right_paren (buffer);
9cc54940
AC		 1819}
1820
eff7e30c 1821/* Dump in BUFFER file:line information related to NODE. */
9cc54940
AC		 1822
1823static void
1824dump_sloc (pretty_printer *buffer, tree node)
1825{
1826 expanded_location xloc;
1827
1828 xloc.file = NULL;
1829
3a65ee74 1830 if (DECL_P (node))
9cc54940
AC		 1831 xloc = expand_location (DECL_SOURCE_LOCATION (node));
1832 else if (EXPR_HAS_LOCATION (node))
1833 xloc = expand_location (EXPR_LOCATION (node));
1834
1835 if (xloc.file)
1836 {
1837 pp_string (buffer, xloc.file);
137a1a27 1838 pp_colon (buffer);
9cc54940 1839 pp_decimal_int (buffer, xloc.line);
9cc54940
AC		 1840 }
1841}
1842
9e25c7ed 1843/* Return true if type T designates a 1-dimension array of "char". */
9cc54940
AC		 1844
1845static bool
1846is_char_array (tree t)
1847{
9cc54940
AC		 1848 int num_dim = 0;
1849
9e25c7ed 1850 while (TREE_CODE (t) == ARRAY_TYPE)
9cc54940
AC		 1851 {
1852 num_dim++;
9e25c7ed 1853 t = TREE_TYPE (t);
9cc54940
AC		 1854 }
1855
e02f4b92 1856 return num_dim == 1
9e25c7ed
EB		 1857 && TREE_CODE (t) == INTEGER_TYPE
1858 && id_equal (DECL_NAME (TYPE_NAME (t)), "char");
9cc54940
AC		 1859}
1860
9e25c7ed
EB		 1861/* Dump in BUFFER an array type NODE of type TYPE in Ada syntax. SPC is the
1862 indentation level. */
9cc54940
AC		 1863
1864static void
9e25c7ed 1865dump_ada_array_type (pretty_printer *buffer, tree node, tree type, int spc)
9cc54940 1866{
9e25c7ed 1867 const bool char_array = is_char_array (node);
9cc54940
AC		 1868
1869 /* Special case char arrays. */
1870 if (char_array)
9e25c7ed 1871 pp_string (buffer, "Interfaces.C.char_array ");
9cc54940
AC		 1872 else
1873 pp_string (buffer, "array ");
1874
1875 /* Print the dimensions. */
9e25c7ed 1876 dump_ada_array_domains (buffer, node, spc);
9cc54940
AC		 1877
1878 /* Print array's type. */
1879 if (!char_array)
1880 {
9e25c7ed
EB		 1881 /* Retrieve the element type. */
1882 tree tmp = node;
1883 while (TREE_CODE (tmp) == ARRAY_TYPE)
1884 tmp = TREE_TYPE (tmp);
1885
9cc54940
AC		 1886 pp_string (buffer, " of ");
1887
f07862c7 1888 if (TREE_CODE (tmp) != POINTER_TYPE)
9cc54940
AC		 1889 pp_string (buffer, "aliased ");
1890
f07862c7 1891 if (TYPE_NAME (tmp) || !RECORD_OR_UNION_TYPE_P (tmp))
9e25c7ed 1892 dump_ada_node (buffer, tmp, node, spc, false, true);
f07862c7 1893 else
9e25c7ed 1894 dump_ada_double_name (buffer, type, get_underlying_decl (tmp));
9cc54940
AC		 1895 }
1896}
1897
1898/* Dump in BUFFER type names associated with a template, each prepended with
94159ecf
EB		 1899 '_'. TYPES is the TREE_PURPOSE of a DECL_TEMPLATE_INSTANTIATIONS. SPC is
1900 the indentation level. */
9cc54940
AC		 1901
1902static void
94159ecf 1903dump_template_types (pretty_printer *buffer, tree types, int spc)
9cc54940 1904{
e02f4b92 1905 for (int i = 0; i < TREE_VEC_LENGTH (types); i++)
9cc54940
AC		 1906 {
1907 tree elem = TREE_VEC_ELT (types, i);
07838b13 1908 pp_underscore (buffer);
e02f4b92
EB		 1909
1910 if (!dump_ada_node (buffer, elem, NULL_TREE, spc, false, true))
9cc54940
AC		 1911 {
1912 pp_string (buffer, "unknown");
1913 pp_scalar (buffer, "%lu", (unsigned long) TREE_HASH (elem));
1914 }
1915 }
1916}
1917
d1d879b1 1918/* Dump in BUFFER the contents of all class instantiations associated with
94159ecf 1919 a given template T. SPC is the indentation level. */
9cc54940
AC		 1920
1921static int
94159ecf 1922dump_ada_template (pretty_printer *buffer, tree t, int spc)
9cc54940 1923{
83ed54d7
EB		 1924 /* DECL_SIZE_UNIT is DECL_TEMPLATE_INSTANTIATIONS in this context. */
1925 tree inst = DECL_SIZE_UNIT (t);
1926 /* This emulates DECL_TEMPLATE_RESULT in this context. */
1927 struct tree_template_decl {
1928 struct tree_decl_common common;
1929 tree arguments;
1930 tree result;
1931 };
1932 tree result = ((struct tree_template_decl *) t)->result;
9cc54940
AC		 1933 int num_inst = 0;
1934
f5b02f1e
EB		 1935 /* Don't look at template declarations declaring something coming from
1936 another file. This can occur for template friend declarations. */
1937 if (LOCATION_FILE (decl_sloc (result, false))
1938 != LOCATION_FILE (decl_sloc (t, false)))
1939 return 0;
1940
c6a2f2d9 1941 for (; inst && inst != error_mark_node; inst = TREE_CHAIN (inst))
9cc54940
AC		 1942 {
1943 tree types = TREE_PURPOSE (inst);
1944 tree instance = TREE_VALUE (inst);
1945
1946 if (TREE_VEC_LENGTH (types) == 0)
1947 break;
1948
5aaa8fb4 1949 if (!RECORD_OR_UNION_TYPE_P (instance))
9cc54940
AC		 1950 break;
1951
c6a2f2d9
PMR		 1952 /* We are interested in concrete template instantiations only: skip
1953 partially specialized nodes. */
a868811e 1954 if (RECORD_OR_UNION_TYPE_P (instance)
f07862c7
EB		 1955 && cpp_check
1956 && cpp_check (instance, HAS_DEPENDENT_TEMPLATE_ARGS))
c6a2f2d9
PMR		 1957 continue;
1958
9cc54940
AC		 1959 num_inst++;
1960 INDENT (spc);
1961 pp_string (buffer, "package ");
1962 package_prefix = false;
e02f4b92 1963 dump_ada_node (buffer, instance, t, spc, false, true);
94159ecf 1964 dump_template_types (buffer, types, spc);
9cc54940
AC		 1965 pp_string (buffer, " is");
1966 spc += INDENT_INCR;
1967 newline_and_indent (buffer, spc);
1968
3b0c690e 1969 TREE_VISITED (get_underlying_decl (instance)) = 1;
9cc54940 1970 pp_string (buffer, "type ");
e02f4b92 1971 dump_ada_node (buffer, instance, t, spc, false, true);
9cc54940
AC		 1972 package_prefix = true;
1973
1974 if (is_tagged_type (instance))
1975 pp_string (buffer, " is tagged limited ");
1976 else
1977 pp_string (buffer, " is limited ");
1978
e02f4b92 1979 dump_ada_node (buffer, instance, t, spc, false, false);
9cc54940
AC		 1980 pp_newline (buffer);
1981 spc -= INDENT_INCR;
1982 newline_and_indent (buffer, spc);
1983
1984 pp_string (buffer, "end;");
1985 newline_and_indent (buffer, spc);
1986 pp_string (buffer, "use ");
1987 package_prefix = false;
e02f4b92 1988 dump_ada_node (buffer, instance, t, spc, false, true);
94159ecf 1989 dump_template_types (buffer, types, spc);
9cc54940
AC		 1990 package_prefix = true;
1991 pp_semicolon (buffer);
1992 pp_newline (buffer);
1993 pp_newline (buffer);
9cc54940
AC		 1994 }
1995
1996 return num_inst > 0;
1997}
1998
eff7e30c
AC		 1999/* Return true if NODE is a simple enum types, that can be mapped to an
2000 Ada enum type directly. */
2001
2002static bool
2003is_simple_enum (tree node)
2004{
eb1ce453 2005 HOST_WIDE_INT count = 0;
eff7e30c 2006
9e25c7ed 2007 for (tree value = TYPE_VALUES (node); value; value = TREE_CHAIN (value))
eff7e30c
AC		 2008 {
2009 tree int_val = TREE_VALUE (value);
2010
2011 if (TREE_CODE (int_val) != INTEGER_CST)
2012 int_val = DECL_INITIAL (int_val);
2013
9541ffee 2014 if (!tree_fits_shwi_p (int_val))
eff7e30c 2015 return false;
eb1ce453 2016 else if (tree_to_shwi (int_val) != count)
eff7e30c
AC		 2017 return false;
2018
2019 count++;
2020 }
2021
2022 return true;
2023}
2024
9e25c7ed
EB		 2025/* Dump in BUFFER an enumeral type NODE of type TYPE in Ada syntax. SPC is
2026 the indentation level. If DISPLAY_CONVENTION is true, also print the
2027 pragma Convention for NODE. */
2028
2029static void
2030dump_ada_enum_type (pretty_printer *buffer, tree node, tree type, int spc,
2031 bool display_convention)
2032{
2033 if (is_simple_enum (node))
2034 {
2035 bool first = true;
2036 spc += INDENT_INCR;
2037 newline_and_indent (buffer, spc - 1);
2038 pp_left_paren (buffer);
2039 for (tree value = TYPE_VALUES (node); value; value = TREE_CHAIN (value))
2040 {
2041 if (first)
2042 first = false;
2043 else
2044 {
2045 pp_comma (buffer);
2046 newline_and_indent (buffer, spc);
2047 }
2048
2049 pp_ada_tree_identifier (buffer, TREE_PURPOSE (value), node, 0, false);
2050 }
2051 pp_string (buffer, ");");
2052 spc -= INDENT_INCR;
2053 newline_and_indent (buffer, spc);
2054
2055 if (display_convention)
2056 {
2057 pp_string (buffer, "pragma Convention (C, ");
2058 dump_ada_node (buffer, DECL_NAME (type) ? type : TYPE_NAME (node),
2059 type, spc, false, true);
2060 pp_right_paren (buffer);
2061 }
2062 }
2063 else
2064 {
2065 if (TYPE_UNSIGNED (node))
2066 pp_string (buffer, "unsigned");
2067 else
2068 pp_string (buffer, "int");
2069 for (tree value = TYPE_VALUES (node); value; value = TREE_CHAIN (value))
2070 {
2071 pp_semicolon (buffer);
2072 newline_and_indent (buffer, spc);
2073
2074 pp_ada_tree_identifier (buffer, TREE_PURPOSE (value), node, 0, false);
2075 pp_string (buffer, " : constant ");
2076
2077 if (TYPE_UNSIGNED (node))
2078 pp_string (buffer, "unsigned");
2079 else
2080 pp_string (buffer, "int");
2081
2082 pp_string (buffer, " := ");
2083 dump_ada_node (buffer,
2084 TREE_CODE (TREE_VALUE (value)) == INTEGER_CST
2085 ? TREE_VALUE (value)
2086 : DECL_INITIAL (TREE_VALUE (value)),
2087 node, spc, false, true);
2088 }
2089 }
2090}
2091
9cc54940
AC		 2092static bool bitfield_used = false;
2093
2094/* Recursively dump in BUFFER Ada declarations corresponding to NODE of type
94159ecf
EB		 2095 TYPE. SPC is the indentation level. LIMITED_ACCESS indicates whether NODE
2096 can be referenced via a "limited with" clause. NAME_ONLY indicates whether
2097 we should only dump the name of NODE, instead of its full declaration. */
9cc54940
AC		 2098
2099static int
e02f4b92
EB		 2100dump_ada_node (pretty_printer *buffer, tree node, tree type, int spc,
2101 bool limited_access, bool name_only)
9cc54940
AC		 2102{
2103 if (node == NULL_TREE)
2104 return 0;
2105
2106 switch (TREE_CODE (node))
2107 {
2108 case ERROR_MARK:
2109 pp_string (buffer, "<<< error >>>");
2110 return 0;
2111
2112 case IDENTIFIER_NODE:
6e3e8419 2113 pp_ada_tree_identifier (buffer, node, type, 0, limited_access);
9cc54940
AC		 2114 break;
2115
2116 case TREE_LIST:
2117 pp_string (buffer, "--- unexpected node: TREE_LIST");
2118 return 0;
2119
2120 case TREE_BINFO:
e02f4b92
EB		 2121 dump_ada_node (buffer, BINFO_TYPE (node), type, spc, limited_access,
2122 name_only);
f0bc3323 2123 return 0;
9cc54940
AC		 2124
2125 case TREE_VEC:
2126 pp_string (buffer, "--- unexpected node: TREE_VEC");
2127 return 0;
2128
c6db43fa 2129 case NULLPTR_TYPE:
9cc54940
AC		 2130 case VOID_TYPE:
2131 if (package_prefix)
2132 {
2133 append_withs ("System", false);
2134 pp_string (buffer, "System.Address");
2135 }
2136 else
2137 pp_string (buffer, "address");
2138 break;
2139
2140 case VECTOR_TYPE:
2141 pp_string (buffer, "<vector>");
2142 break;
2143
2144 case COMPLEX_TYPE:
2145 pp_string (buffer, "<complex>");
2146 break;
2147
2148 case ENUMERAL_TYPE:
2149 if (name_only)
e02f4b92 2150 dump_ada_node (buffer, TYPE_NAME (node), node, spc, false, true);
9cc54940 2151 else
9e25c7ed 2152 dump_ada_enum_type (buffer, node, type, spc, true);
9cc54940
AC		 2153 break;
2154
9cc54940 2155 case REAL_TYPE:
c6db43fa
EB		 2156 if (TYPE_NAME (node)
2157 && TREE_CODE (TYPE_NAME (node)) == TYPE_DECL
2158 && IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (node))) [0] == '_'
2159 && (id_equal (DECL_NAME (TYPE_NAME (node)), "_Float128")
2160 || id_equal (DECL_NAME (TYPE_NAME (node)), "__float128")))
2161 {
2162 append_withs ("Interfaces.C.Extensions", false);
2163 pp_string (buffer, "Extensions.Float_128");
2164 break;
2165 }
2166 /* fallthrough */
2167
2168 case INTEGER_TYPE:
9cc54940
AC		 2169 case FIXED_POINT_TYPE:
2170 case BOOLEAN_TYPE:
9e25c7ed
EB		 2171 if (TYPE_NAME (node))
2172 {
2173 if (TREE_CODE (TYPE_NAME (node)) == IDENTIFIER_NODE)
2174 pp_ada_tree_identifier (buffer, TYPE_NAME (node), node, 0,
2175 limited_access);
2176 else if (TREE_CODE (TYPE_NAME (node)) == TYPE_DECL
2177 && DECL_NAME (TYPE_NAME (node)))
2178 dump_ada_decl_name (buffer, TYPE_NAME (node), limited_access);
2179 else
2180 pp_string (buffer, "<unnamed type>");
2181 }
2182 else if (TREE_CODE (node) == INTEGER_TYPE)
2183 {
2184 append_withs ("Interfaces.C.Extensions", false);
2185 bitfield_used = true;
9cc54940 2186
9e25c7ed
EB		 2187 if (TYPE_PRECISION (node) == 1)
2188 pp_string (buffer, "Extensions.Unsigned_1");
2189 else
2190 {
2191 pp_string (buffer, TYPE_UNSIGNED (node)
2192 ? "Extensions.Unsigned_"
2193 : "Extensions.Signed_");
2194 pp_decimal_int (buffer, TYPE_PRECISION (node));
2195 }
2196 }
2197 else
2198 pp_string (buffer, "<unnamed type>");
2199 break;
9cc54940
AC		 2200
2201 case POINTER_TYPE:
2202 case REFERENCE_TYPE:
c583af79 2203 if (name_only && TYPE_NAME (node))
e02f4b92
EB		 2204 dump_ada_node (buffer, TYPE_NAME (node), node, spc, limited_access,
2205 true);
c583af79
AC		 2206
2207 else if (TREE_CODE (TREE_TYPE (node)) == FUNCTION_TYPE)
9cc54940 2208 {
79310774 2209 if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (node))))
095d8d4b 2210 pp_string (buffer, "access procedure");
9cc54940 2211 else
095d8d4b 2212 pp_string (buffer, "access function");
9cc54940 2213
9e25c7ed
EB		 2214 dump_ada_function_declaration (buffer, node, false, false, false,
2215 spc + INDENT_INCR);
9cc54940 2216
79310774
EB		 2217 /* If we are dumping the full type, it means we are part of a
2218 type definition and need also a Convention C pragma. */
2219 if (!name_only)
9cc54940 2220 {
79310774
EB		 2221 pp_semicolon (buffer);
2222 newline_and_indent (buffer, spc);
2223 pp_string (buffer, "pragma Convention (C, ");
e02f4b92 2224 dump_ada_node (buffer, type, NULL_TREE, spc, false, true);
79310774 2225 pp_right_paren (buffer);
9cc54940
AC		 2226 }
2227 }
2228 else
2229 {
095d8d4b 2230 bool is_access = false;
9cc54940
AC		 2231 unsigned int quals = TYPE_QUALS (TREE_TYPE (node));
2232
c583af79 2233 if (VOID_TYPE_P (TREE_TYPE (node)))
9cc54940
AC		 2234 {
2235 if (!name_only)
2236 pp_string (buffer, "new ");
2237 if (package_prefix)
2238 {
2239 append_withs ("System", false);
2240 pp_string (buffer, "System.Address");
2241 }
2242 else
2243 pp_string (buffer, "address");
2244 }
2245 else
2246 {
2247 if (TREE_CODE (node) == POINTER_TYPE
2248 && TREE_CODE (TREE_TYPE (node)) == INTEGER_TYPE
c6db43fa
EB		 2249 && id_equal (DECL_NAME (TYPE_NAME (TREE_TYPE (node))),
2250 "char"))
9cc54940
AC		 2251 {
2252 if (!name_only)
2253 pp_string (buffer, "new ");
2254
2255 if (package_prefix)
2256 {
2257 pp_string (buffer, "Interfaces.C.Strings.chars_ptr");
2258 append_withs ("Interfaces.C.Strings", false);
2259 }
2260 else
2261 pp_string (buffer, "chars_ptr");
2262 }
2263 else
2264 {
3b0c690e 2265 tree type_name = TYPE_NAME (TREE_TYPE (node));
9cc54940 2266
09de3550
EB		 2267 /* For now, handle access-to-access as System.Address. */
2268 if (TREE_CODE (TREE_TYPE (node)) == POINTER_TYPE)
9cc54940
AC		 2269 {
2270 if (package_prefix)
2271 {
2272 append_withs ("System", false);
2273 if (!name_only)
2274 pp_string (buffer, "new ");
2275 pp_string (buffer, "System.Address");
2276 }
2277 else
2278 pp_string (buffer, "address");
2279 return spc;
2280 }
2281
2282 if (!package_prefix)
2283 pp_string (buffer, "access");
2284 else if (AGGREGATE_TYPE_P (TREE_TYPE (node)))
2285 {
2286 if (!type || TREE_CODE (type) != FUNCTION_DECL)
2287 {
2288 pp_string (buffer, "access ");
2289 is_access = true;
2290
2291 if (quals & TYPE_QUAL_CONST)
2292 pp_string (buffer, "constant ");
2293 else if (!name_only)
2294 pp_string (buffer, "all ");
2295 }
2296 else if (quals & TYPE_QUAL_CONST)
2297 pp_string (buffer, "in ");
9cc54940
AC		 2298 else
2299 {
2300 is_access = true;
2301 pp_string (buffer, "access ");
2302 /* ??? should be configurable: access or in out. */
2303 }
2304 }
2305 else
2306 {
2307 is_access = true;
2308 pp_string (buffer, "access ");
2309
2310 if (!name_only)
2311 pp_string (buffer, "all ");
2312 }
2313
f07862c7 2314 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node)) && type_name)
e02f4b92
EB		 2315 dump_ada_node (buffer, type_name, TREE_TYPE (node), spc,
2316 is_access, true);
9cc54940 2317 else
e02f4b92
EB		 2318 dump_ada_node (buffer, TREE_TYPE (node), TREE_TYPE (node),
2319 spc, false, true);
9cc54940
AC		 2320 }
2321 }
2322 }
2323 break;
2324
2325 case ARRAY_TYPE:
2326 if (name_only)
e02f4b92
EB		 2327 dump_ada_node (buffer, TYPE_NAME (node), node, spc, limited_access,
2328 true);
9cc54940 2329 else
f07862c7 2330 dump_ada_array_type (buffer, node, type, spc);
9cc54940
AC		 2331 break;
2332
2333 case RECORD_TYPE:
2334 case UNION_TYPE:
9cc54940 2335 if (name_only)
9e25c7ed
EB		 2336 dump_ada_node (buffer, TYPE_NAME (node), node, spc, limited_access,
2337 true);
9cc54940 2338 else
e02f4b92 2339 dump_ada_structure (buffer, node, type, spc, true);
9cc54940
AC		 2340 break;
2341
2342 case INTEGER_CST:
909881cb
EB		 2343 /* We treat the upper half of the sizetype range as negative. This
2344 is consistent with the internal treatment and makes it possible
2345 to generate the (0 .. -1) range for flexible array members. */
2346 if (TREE_TYPE (node) == sizetype)
2347 node = fold_convert (ssizetype, node);
9541ffee 2348 if (tree_fits_shwi_p (node))
eb1ce453 2349 pp_wide_integer (buffer, tree_to_shwi (node));
cc269bb6 2350 else if (tree_fits_uhwi_p (node))
eb1ce453 2351 pp_unsigned_wide_integer (buffer, tree_to_uhwi (node));
909881cb 2352 else
9cc54940 2353 {
8e6cdc90 2354 wide_int val = wi::to_wide (node);
807e902e
KZ		 2355 int i;
2356 if (wi::neg_p (val))
9cc54940 2357 {
07838b13 2358 pp_minus (buffer);
807e902e 2359 val = -val;
9cc54940
AC		 2360 }
2361 sprintf (pp_buffer (buffer)->digit_buffer,
807e902e
KZ		 2362 "16#%" HOST_WIDE_INT_PRINT "x",
2363 val.elt (val.get_len () - 1));
2364 for (i = val.get_len () - 2; i >= 0; i--)
2365 sprintf (pp_buffer (buffer)->digit_buffer,
2366 HOST_WIDE_INT_PRINT_PADDED_HEX, val.elt (i));
9cc54940
AC		 2367 pp_string (buffer, pp_buffer (buffer)->digit_buffer);
2368 }
9cc54940
AC		 2369 break;
2370
2371 case REAL_CST:
2372 case FIXED_CST:
2373 case COMPLEX_CST:
2374 case STRING_CST:
2375 case VECTOR_CST:
2376 return 0;
2377
9cc54940
AC		 2378 case TYPE_DECL:
2379 if (DECL_IS_BUILTIN (node))
2380 {
2381 /* Don't print the declaration of built-in types. */
9cc54940
AC		 2382 if (name_only)
2383 {
2384 /* If we're in the middle of a declaration, defaults to
2385 System.Address. */
2386 if (package_prefix)
2387 {
2388 append_withs ("System", false);
2389 pp_string (buffer, "System.Address");
2390 }
2391 else
2392 pp_string (buffer, "address");
2393 }
2394 break;
2395 }
2396
2397 if (name_only)
2398 dump_ada_decl_name (buffer, node, limited_access);
2399 else
2400 {
2401 if (is_tagged_type (TREE_TYPE (node)))
2402 {
9e25c7ed 2403 int first = true;
9cc54940
AC		 2404
2405 /* Look for ancestors. */
9f2cb25e
EB		 2406 for (tree fld = TYPE_FIELDS (TREE_TYPE (node));
2407 fld;
2408 fld = TREE_CHAIN (fld))
9cc54940 2409 {
9f2cb25e 2410 if (!DECL_NAME (fld) && is_tagged_type (TREE_TYPE (fld)))
9cc54940
AC		 2411 {
2412 if (first)
2413 {
2414 pp_string (buffer, "limited new ");
9e25c7ed 2415 first = false;
9cc54940
AC		 2416 }
2417 else
2418 pp_string (buffer, " and ");
2419
9f2cb25e
EB		 2420 dump_ada_decl_name (buffer, TYPE_NAME (TREE_TYPE (fld)),
2421 false);
9cc54940
AC		 2422 }
2423 }
2424
2425 pp_string (buffer, first ? "tagged limited " : " with ");
2426 }
94159ecf 2427 else if (has_nontrivial_methods (TREE_TYPE (node)))
9cc54940
AC		 2428 pp_string (buffer, "limited ");
2429
e02f4b92 2430 dump_ada_node (buffer, TREE_TYPE (node), type, spc, false, false);
9cc54940
AC		 2431 }
2432 break;
2433
79310774
EB		 2434 case FUNCTION_DECL:
2435 case CONST_DECL:
9cc54940
AC		 2436 case VAR_DECL:
2437 case PARM_DECL:
2438 case FIELD_DECL:
2439 case NAMESPACE_DECL:
2440 dump_ada_decl_name (buffer, node, false);
2441 break;
2442
2443 default:
2444 /* Ignore other nodes (e.g. expressions). */
2445 return 0;
2446 }
2447
2448 return 1;
2449}
2450
94159ecf 2451/* Dump in BUFFER NODE's methods. SPC is the indentation level. Return 1 if
59909673 2452 methods were printed, 0 otherwise. */
9cc54940 2453
94159ecf 2454static int
79310774 2455dump_ada_methods (pretty_printer *buffer, tree node, int spc)
9cc54940 2456{
94159ecf
EB		 2457 if (!has_nontrivial_methods (node))
2458 return 0;
9cc54940 2459
94159ecf
EB		 2460 pp_semicolon (buffer);
2461
5aaa8fb4
NS		 2462 int res = 1;
2463 for (tree fld = TYPE_FIELDS (node); fld; fld = DECL_CHAIN (fld))
db440138 2464 if (TREE_CODE (fld) == FUNCTION_DECL)
5aaa8fb4
NS		 2465 {
2466 if (res)
2467 {
2468 pp_newline (buffer);
2469 pp_newline (buffer);
2470 }
79310774
EB		 2471
2472 res = dump_ada_declaration (buffer, fld, node, spc);
5aaa8fb4 2473 }
2a877204 2474
94159ecf 2475 return 1;
9cc54940
AC		 2476}
2477
095d8d4b
EB		 2478/* Dump in BUFFER a forward declaration for TYPE present inside T.
2479 SPC is the indentation level. */
2480
2481static void
2482dump_forward_type (pretty_printer *buffer, tree type, tree t, int spc)
2483{
2484 tree decl = get_underlying_decl (type);
2485
2486 /* Anonymous pointer and function types. */
2487 if (!decl)
2488 {
2489 if (TREE_CODE (type) == POINTER_TYPE)
2490 dump_forward_type (buffer, TREE_TYPE (type), t, spc);
2491 else if (TREE_CODE (type) == FUNCTION_TYPE)
2492 {
2493 function_args_iterator args_iter;
2494 tree arg;
2495 dump_forward_type (buffer, TREE_TYPE (type), t, spc);
2496 FOREACH_FUNCTION_ARGS (type, arg, args_iter)
2497 dump_forward_type (buffer, arg, t, spc);
2498 }
2499 return;
2500 }
2501
2502 if (DECL_IS_BUILTIN (decl) || TREE_VISITED (decl))
2503 return;
2504
095d8d4b
EB		 2505 /* Forward declarations are only needed within a given file. */
2506 if (DECL_SOURCE_FILE (decl) != DECL_SOURCE_FILE (t))
2507 return;
2508
2509 /* Generate an incomplete type declaration. */
2510 pp_string (buffer, "type ");
e02f4b92 2511 dump_ada_node (buffer, decl, NULL_TREE, spc, false, true);
095d8d4b
EB		 2512 pp_semicolon (buffer);
2513 newline_and_indent (buffer, spc);
2514
2515 /* Only one incomplete declaration is legal for a given type. */
2516 TREE_VISITED (decl) = 1;
2517}
2518
f07862c7
EB		 2519static void dump_nested_type (pretty_printer *, tree, tree, tree, int);
2520
9cc54940 2521/* Dump in BUFFER anonymous types nested inside T's definition.
095d8d4b 2522 PARENT is the parent node of T. SPC is the indentation level.
f07862c7
EB		 2523
2524 In C anonymous nested tagged types have no name whereas in C++ they have
2525 one. In C their TYPE_DECL is at top level whereas in C++ it is nested.
2526 In both languages untagged types (pointers and arrays) have no name.
2527 In C++ the nested TYPE_DECLs can come after their associated FIELD_DECL.
2528
2529 Therefore, in order to have a common processing for both languages, we
2530 disregard anonymous TYPE_DECLs at top level and here we make a first
2531 pass on the nested TYPE_DECLs and a second pass on the unnamed types. */
9cc54940
AC		 2532
2533static void
095d8d4b 2534dump_nested_types (pretty_printer *buffer, tree t, tree parent, int spc)
9cc54940 2535{
f07862c7 2536 tree type, field;
9cc54940 2537
f07862c7
EB		 2538 /* Find possible anonymous pointers/arrays/structs/unions recursively. */
2539 type = TREE_TYPE (t);
2540 if (type == NULL_TREE)
9cc54940
AC		 2541 return;
2542
f07862c7
EB		 2543 for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
2544 if (TREE_CODE (field) == TYPE_DECL
2545 && DECL_NAME (field) != DECL_NAME (t)
095d8d4b 2546 && !DECL_ORIGINAL_TYPE (field)
f07862c7
EB		 2547 && TYPE_NAME (TREE_TYPE (field)) != TYPE_NAME (type))
2548 dump_nested_type (buffer, field, t, parent, spc);
9cc54940 2549
f07862c7 2550 for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
9f2cb25e 2551 if (TREE_CODE (field) == FIELD_DECL && !TYPE_NAME (TREE_TYPE (field)))
f07862c7 2552 dump_nested_type (buffer, field, t, parent, spc);
f07862c7 2553}
9cc54940 2554
f07862c7 2555/* Dump in BUFFER the anonymous type of FIELD inside T.
095d8d4b 2556 PARENT is the parent node of T. SPC is the indentation level. */
9cc54940 2557
f07862c7
EB		 2558static void
2559dump_nested_type (pretty_printer *buffer, tree field, tree t, tree parent,
2560 int spc)
2561{
2562 tree field_type = TREE_TYPE (field);
2563 tree decl, tmp;
9cc54940 2564
f07862c7
EB		 2565 switch (TREE_CODE (field_type))
2566 {
2567 case POINTER_TYPE:
2568 tmp = TREE_TYPE (field_type);
095d8d4b 2569 dump_forward_type (buffer, tmp, t, spc);
f07862c7 2570 break;
9cc54940 2571
f07862c7
EB		 2572 case ARRAY_TYPE:
2573 tmp = TREE_TYPE (field_type);
2574 while (TREE_CODE (tmp) == ARRAY_TYPE)
2575 tmp = TREE_TYPE (tmp);
2576 decl = get_underlying_decl (tmp);
23f2660f 2577 if (decl && !DECL_NAME (decl) && !TREE_VISITED (decl))
f07862c7
EB		 2578 {
2579 /* Generate full declaration. */
2580 dump_nested_type (buffer, decl, t, parent, spc);
2581 TREE_VISITED (decl) = 1;
2582 }
095d8d4b
EB		 2583 else if (!decl && TREE_CODE (tmp) == POINTER_TYPE)
2584 dump_forward_type (buffer, TREE_TYPE (tmp), t, spc);
9cc54940 2585
f07862c7 2586 /* Special case char arrays. */
9e25c7ed
EB		 2587 if (is_char_array (field_type))
2588 pp_string (buffer, "subtype ");
2589 else
2590 pp_string (buffer, "type ");
9cc54940 2591
f07862c7
EB		 2592 dump_ada_double_name (buffer, parent, field);
2593 pp_string (buffer, " is ");
9e25c7ed 2594 dump_ada_array_type (buffer, field_type, parent, spc);
f07862c7
EB		 2595 pp_semicolon (buffer);
2596 newline_and_indent (buffer, spc);
2597 break;
9cc54940 2598
9e25c7ed
EB		 2599 case ENUMERAL_TYPE:
2600 if (is_simple_enum (field_type))
2601 pp_string (buffer, "type ");
2602 else
2603 pp_string (buffer, "subtype ");
2604
2605 if (TYPE_NAME (field_type))
2606 dump_ada_node (buffer, field_type, NULL_TREE, spc, false, true);
2607 else
2608 dump_ada_double_name (buffer, parent, field);
2609 pp_string (buffer, " is ");
2610 dump_ada_enum_type (buffer, field_type, t, spc, false);
2611
2612 if (is_simple_enum (field_type))
2613 {
2614 pp_string (buffer, "pragma Convention (C, ");
2615 if (TYPE_NAME (field_type))
2616 dump_ada_node (buffer, field_type, NULL_TREE, spc, false, true);
2617 else
2618 dump_ada_double_name (buffer, parent, field);
2619 pp_string (buffer, ");");
2620 newline_and_indent (buffer, spc);
2621 }
2622 else
2623 {
2624 pp_semicolon (buffer);
2625 newline_and_indent (buffer, spc);
2626 }
2627 break;
2628
f07862c7
EB		 2629 case RECORD_TYPE:
2630 case UNION_TYPE:
095d8d4b 2631 dump_nested_types (buffer, field, t, spc);
9cc54940 2632
f07862c7 2633 pp_string (buffer, "type ");
9cc54940 2634
f07862c7 2635 if (TYPE_NAME (field_type))
9e25c7ed
EB		 2636 dump_ada_node (buffer, field_type, NULL_TREE, spc, false, true);
2637 else
2638 dump_ada_double_name (buffer, parent, field);
9cc54940 2639
9e25c7ed
EB		 2640 if (TREE_CODE (field_type) == UNION_TYPE)
2641 pp_string (buffer, " (discr : unsigned := 0)");
9cc54940 2642
9e25c7ed
EB		 2643 pp_string (buffer, " is ");
2644 dump_ada_structure (buffer, field_type, t, spc, false);
2645
2646 pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
2647 if (TYPE_NAME (field_type))
2648 dump_ada_node (buffer, field_type, NULL_TREE, spc, false, true);
f07862c7 2649 else
9e25c7ed
EB		 2650 dump_ada_double_name (buffer, parent, field);
2651 pp_string (buffer, ");");
2652 newline_and_indent (buffer, spc);
9cc54940 2653
9e25c7ed
EB		 2654 if (TREE_CODE (field_type) == UNION_TYPE)
2655 {
2656 pp_string (buffer, "pragma Unchecked_Union (");
2657 if (TYPE_NAME (field_type))
2658 dump_ada_node (buffer, field_type, NULL_TREE, spc, false, true);
2659 else
2660 dump_ada_double_name (buffer, parent, field);
f07862c7 2661 pp_string (buffer, ");");
9cc54940 2662 }
9e25c7ed 2663 break;
3b0c690e 2664
f07862c7
EB		 2665 default:
2666 break;
2667 }
9cc54940
AC		 2668}
2669
b854df3c 2670/* Dump in BUFFER constructor spec corresponding to T for TYPE. */
f2aa696b
EB		 2671
2672static void
b854df3c 2673print_constructor (pretty_printer *buffer, tree t, tree type)
f2aa696b 2674{
b854df3c 2675 tree decl_name = DECL_NAME (TYPE_NAME (type));
f2aa696b
EB		 2676
2677 pp_string (buffer, "New_");
6e3e8419 2678 pp_ada_tree_identifier (buffer, decl_name, t, 0, false);
f2aa696b
EB		 2679}
2680
9cc54940
AC		 2681/* Dump in BUFFER destructor spec corresponding to T. */
2682
2683static void
b854df3c 2684print_destructor (pretty_printer *buffer, tree t, tree type)
9cc54940 2685{
b854df3c 2686 tree decl_name = DECL_NAME (TYPE_NAME (type));
9cc54940 2687
0d2489f4 2688 pp_string (buffer, "Delete_");
6e3e8419 2689 pp_ada_tree_identifier (buffer, decl_name, t, 0, false);
9cc54940
AC		 2690}
2691
2692/* Return the name of type T. */
2693
2694static const char *
2695type_name (tree t)
2696{
2697 tree n = TYPE_NAME (t);
2698
2699 if (TREE_CODE (n) == IDENTIFIER_NODE)
2700 return IDENTIFIER_POINTER (n);
2701 else
2702 return IDENTIFIER_POINTER (DECL_NAME (n));
2703}
2704
79310774 2705/* Dump in BUFFER the declaration of a variable T of type TYPE in Ada syntax.
94159ecf
EB		 2706 SPC is the indentation level. Return 1 if a declaration was printed,
2707 0 otherwise. */
9cc54940
AC		 2708
2709static int
79310774 2710dump_ada_declaration (pretty_printer *buffer, tree t, tree type, int spc)
9cc54940 2711{
095d8d4b
EB		 2712 bool is_var = false;
2713 bool need_indent = false;
2714 bool is_class = false;
9cc54940
AC		 2715 tree name = TYPE_NAME (TREE_TYPE (t));
2716 tree decl_name = DECL_NAME (t);
9cc54940
AC		 2717 tree orig = NULL_TREE;
2718
2719 if (cpp_check && cpp_check (t, IS_TEMPLATE))
94159ecf 2720 return dump_ada_template (buffer, t, spc);
9cc54940 2721
095d8d4b 2722 /* Skip enumeral values: will be handled as part of the type itself. */
9cc54940 2723 if (TREE_CODE (t) == CONST_DECL && TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE)
9cc54940
AC		 2724 return 0;
2725
2726 if (TREE_CODE (t) == TYPE_DECL)
2727 {
2728 orig = DECL_ORIGINAL_TYPE (t);
2729
2730 if (orig && TYPE_STUB_DECL (orig))
2731 {
3b0c690e
AC		 2732 tree stub = TYPE_STUB_DECL (orig);
2733 tree typ = TREE_TYPE (stub);
9cc54940
AC		 2734
2735 if (TYPE_NAME (typ))
2736 {
2737 /* If types have same representation, and same name (ignoring
2738 casing), then ignore the second type. */
2739 if (type_name (typ) == type_name (TREE_TYPE (t))
2740 || !strcasecmp (type_name (typ), type_name (TREE_TYPE (t))))
23f2660f
EB		 2741 {
2742 TREE_VISITED (t) = 1;
2743 return 0;
2744 }
9cc54940
AC		 2745
2746 INDENT (spc);
2747
09de3550
EB		 2748 if (RECORD_OR_UNION_TYPE_P (typ))
2749 dump_forward_type (buffer, stub, t, spc);
2750
2751 pp_string (buffer, "subtype ");
2752 dump_ada_node (buffer, t, type, spc, false, true);
2753 pp_string (buffer, " is ");
2754 dump_ada_node (buffer, typ, type, spc, false, true);
2755 pp_string (buffer, "; -- ");
2756 dump_sloc (buffer, t);
23f2660f
EB		 2757
2758 TREE_VISITED (t) = 1;
9cc54940
AC		 2759 return 1;
2760 }
2761 }
2762
2763 /* Skip unnamed or anonymous structs/unions/enum types. */
f07862c7
EB		 2764 if (!orig && !decl_name && !name
2765 && (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t))
2766 || TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE))
2767 return 0;
9cc54940 2768
f07862c7 2769 /* Skip anonymous enum types (duplicates of real types). */
9cc54940
AC		 2770 if (!orig
2771 && TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE
2772 && decl_name
2773 && (*IDENTIFIER_POINTER (decl_name) == '.'
2774 || *IDENTIFIER_POINTER (decl_name) == '$'))
9cc54940
AC		 2775 return 0;
2776
2777 INDENT (spc);
2778
2779 switch (TREE_CODE (TREE_TYPE (t)))
2780 {
2781 case RECORD_TYPE:
2782 case UNION_TYPE:
095d8d4b 2783 if (!COMPLETE_TYPE_P (TREE_TYPE (t)))
9cc54940 2784 {
09de3550 2785 pp_string (buffer, "type ");
e02f4b92 2786 dump_ada_node (buffer, t, type, spc, false, true);
09de3550
EB		 2787 pp_string (buffer, " is null record; -- incomplete struct");
2788 TREE_VISITED (t) = 1;
9cc54940
AC		 2789 return 1;
2790 }
2791
2792 if (decl_name
2793 && (*IDENTIFIER_POINTER (decl_name) == '.'
2794 || *IDENTIFIER_POINTER (decl_name) == '$'))
2795 {
2796 pp_string (buffer, "-- skipped anonymous struct ");
e02f4b92 2797 dump_ada_node (buffer, t, type, spc, false, true);
3b0c690e 2798 TREE_VISITED (t) = 1;
9cc54940
AC		 2799 return 1;
2800 }
2801
095d8d4b 2802 if (orig && TYPE_NAME (orig))
9cc54940
AC		 2803 pp_string (buffer, "subtype ");
2804 else
2805 {
095d8d4b 2806 dump_nested_types (buffer, t, t, spc);
9cc54940 2807
1e4bf85b 2808 if (separate_class_package (t))
9cc54940
AC		 2809 {
2810 is_class = true;
2811 pp_string (buffer, "package Class_");
e02f4b92 2812 dump_ada_node (buffer, t, type, spc, false, true);
9cc54940
AC		 2813 pp_string (buffer, " is");
2814 spc += INDENT_INCR;
2815 newline_and_indent (buffer, spc);
2816 }
2817
2818 pp_string (buffer, "type ");
2819 }
2820 break;
2821
9cc54940
AC		 2822 case POINTER_TYPE:
2823 case REFERENCE_TYPE:
095d8d4b
EB		 2824 dump_forward_type (buffer, TREE_TYPE (TREE_TYPE (t)), t, spc);
2825 /* fallthrough */
2826
2827 case ARRAY_TYPE:
9e25c7ed 2828 if ((orig && TYPE_NAME (orig)) || is_char_array (TREE_TYPE (t)))
9cc54940
AC		 2829 pp_string (buffer, "subtype ");
2830 else
2831 pp_string (buffer, "type ");
2832 break;
2833
2834 case FUNCTION_TYPE:
2835 pp_string (buffer, "-- skipped function type ");
e02f4b92 2836 dump_ada_node (buffer, t, type, spc, false, true);
9cc54940 2837 return 1;
9cc54940 2838
eff7e30c
AC		 2839 case ENUMERAL_TYPE:
2840 if ((orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
2841 || !is_simple_enum (TREE_TYPE (t)))
2842 pp_string (buffer, "subtype ");
2843 else
2844 pp_string (buffer, "type ");
2845 break;
2846
9cc54940
AC		 2847 default:
2848 pp_string (buffer, "subtype ");
2849 }
3b0c690e 2850 TREE_VISITED (t) = 1;
9cc54940
AC		 2851 }
2852 else
2853 {
0ae9bd27 2854 if (VAR_P (t)
9cc54940
AC		 2855 && decl_name
2856 && *IDENTIFIER_POINTER (decl_name) == '_')
2857 return 0;
2858
095d8d4b 2859 need_indent = true;
9cc54940
AC		 2860 }
2861
2862 /* Print the type and name. */
2863 if (TREE_CODE (TREE_TYPE (t)) == ARRAY_TYPE)
2864 {
2865 if (need_indent)
2866 INDENT (spc);
2867
2868 /* Print variable's name. */
e02f4b92 2869 dump_ada_node (buffer, t, type, spc, false, true);
9cc54940
AC		 2870
2871 if (TREE_CODE (t) == TYPE_DECL)
2872 {
2873 pp_string (buffer, " is ");
2874
095d8d4b 2875 if (orig && TYPE_NAME (orig))
e02f4b92 2876 dump_ada_node (buffer, TYPE_NAME (orig), type, spc, false, true);
9cc54940 2877 else
9e25c7ed 2878 dump_ada_array_type (buffer, TREE_TYPE (t), type, spc);
9cc54940
AC		 2879 }
2880 else
2881 {
2882 tree tmp = TYPE_NAME (TREE_TYPE (t));
2883
2884 if (spc == INDENT_INCR || TREE_STATIC (t))
095d8d4b 2885 is_var = true;
9cc54940
AC		 2886
2887 pp_string (buffer, " : ");
2888
f07862c7
EB		 2889 if (TREE_CODE (TREE_TYPE (TREE_TYPE (t))) != POINTER_TYPE)
2890 pp_string (buffer, "aliased ");
9cc54940 2891
f07862c7 2892 if (tmp)
e02f4b92 2893 dump_ada_node (buffer, tmp, type, spc, false, true);
f07862c7
EB		 2894 else if (type)
2895 dump_ada_double_name (buffer, type, t);
9cc54940 2896 else
9e25c7ed 2897 dump_ada_array_type (buffer, TREE_TYPE (t), type, spc);
9cc54940
AC		 2898 }
2899 }
2900 else if (TREE_CODE (t) == FUNCTION_DECL)
2901 {
79310774 2902 bool is_abstract_class = false;
94159ecf 2903 bool is_method = TREE_CODE (TREE_TYPE (t)) == METHOD_TYPE;
9cc54940 2904 tree decl_name = DECL_NAME (t);
9cc54940
AC		 2905 bool is_abstract = false;
2906 bool is_constructor = false;
2907 bool is_destructor = false;
2908 bool is_copy_constructor = false;
2a7fb83f 2909 bool is_move_constructor = false;
9cc54940
AC		 2910
2911 if (!decl_name)
2912 return 0;
2913
2914 if (cpp_check)
2915 {
2916 is_abstract = cpp_check (t, IS_ABSTRACT);
2917 is_constructor = cpp_check (t, IS_CONSTRUCTOR);
2918 is_destructor = cpp_check (t, IS_DESTRUCTOR);
2919 is_copy_constructor = cpp_check (t, IS_COPY_CONSTRUCTOR);
2a7fb83f 2920 is_move_constructor = cpp_check (t, IS_MOVE_CONSTRUCTOR);
9cc54940
AC		 2921 }
2922
2a7fb83f
EB		 2923 /* Skip copy constructors and C++11 move constructors: some are internal
2924 only and those that are not cannot be called easily from Ada. */
2925 if (is_copy_constructor || is_move_constructor)
9cc54940
AC		 2926 return 0;
2927
f2aa696b 2928 if (is_constructor || is_destructor)
9cc54940 2929 {
bb49ee66
EB		 2930 /* ??? Skip implicit constructors/destructors for now. */
2931 if (DECL_ARTIFICIAL (t))
a9dcd529
EB		 2932 return 0;
2933
f2aa696b 2934 /* Only consider constructors/destructors for complete objects. */
b854df3c
EB		 2935 if (strncmp (IDENTIFIER_POINTER (decl_name), "__ct_comp", 9) != 0
2936 && strncmp (IDENTIFIER_POINTER (decl_name), "__dt_comp", 9) != 0)
9cc54940 2937 return 0;
f2aa696b 2938 }
9cc54940 2939
f2aa696b
EB		 2940 /* If this function has an entry in the vtable, we cannot omit it. */
2941 else if (!DECL_VINDEX (t) && *IDENTIFIER_POINTER (decl_name) == '_')
2942 {
9cc54940
AC		 2943 INDENT (spc);
2944 pp_string (buffer, "-- skipped func ");
2945 pp_string (buffer, IDENTIFIER_POINTER (decl_name));
2946 return 1;
2947 }
2948
2949 if (need_indent)
2950 INDENT (spc);
2951
f2aa696b 2952 if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t))) && !is_constructor)
79310774 2953 pp_string (buffer, "procedure ");
9cc54940 2954 else
79310774 2955 pp_string (buffer, "function ");
9cc54940 2956
f2aa696b 2957 if (is_constructor)
b854df3c 2958 print_constructor (buffer, t, type);
f2aa696b 2959 else if (is_destructor)
b854df3c 2960 print_destructor (buffer, t, type);
9cc54940
AC		 2961 else
2962 dump_ada_decl_name (buffer, t, false);
2963
2964 dump_ada_function_declaration
2965 (buffer, t, is_method, is_constructor, is_destructor, spc);
9cc54940 2966
5aaa8fb4
NS		 2967 if (is_constructor && RECORD_OR_UNION_TYPE_P (type))
2968 for (tree fld = TYPE_FIELDS (type); fld; fld = DECL_CHAIN (fld))
db440138 2969 if (TREE_CODE (fld) == FUNCTION_DECL && cpp_check (fld, IS_ABSTRACT))
5aaa8fb4
NS		 2970 {
2971 is_abstract_class = true;
2972 break;
2973 }
9cc54940
AC		 2974
2975 if (is_abstract || is_abstract_class)
2976 pp_string (buffer, " is abstract");
2977
2978 pp_semicolon (buffer);
2979 pp_string (buffer, " -- ");
2980 dump_sloc (buffer, t);
2981
65a372f4 2982 if (is_abstract || !DECL_ASSEMBLER_NAME (t))
9cc54940
AC		 2983 return 1;
2984
2985 newline_and_indent (buffer, spc);
2986
2987 if (is_constructor)
2988 {
f2aa696b 2989 pp_string (buffer, "pragma CPP_Constructor (");
b854df3c 2990 print_constructor (buffer, t, type);
9cc54940
AC		 2991 pp_string (buffer, ", \"");
2992 pp_asm_name (buffer, t);
2993 pp_string (buffer, "\");");
2994 }
2995 else if (is_destructor)
2996 {
2997 pp_string (buffer, "pragma Import (CPP, ");
b854df3c 2998 print_destructor (buffer, t, type);
9cc54940
AC		 2999 pp_string (buffer, ", \"");
3000 pp_asm_name (buffer, t);
3001 pp_string (buffer, "\");");
3002 }
3003 else
79310774 3004 dump_ada_import (buffer, t);
9cc54940
AC		 3005
3006 return 1;
3007 }
095d8d4b 3008 else if (TREE_CODE (t) == TYPE_DECL && !orig)
9cc54940 3009 {
095d8d4b
EB		 3010 bool is_interface = false;
3011 bool is_abstract_record = false;
9cc54940
AC		 3012
3013 if (need_indent)
3014 INDENT (spc);
3015
095d8d4b 3016 /* Anonymous structs/unions. */
e02f4b92 3017 dump_ada_node (buffer, TREE_TYPE (t), t, spc, false, true);
9cc54940 3018
f07862c7 3019 if (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE)
095d8d4b 3020 pp_string (buffer, " (discr : unsigned := 0)");
9cc54940
AC		 3021
3022 pp_string (buffer, " is ");
3023
5aaa8fb4
NS		 3024 /* Check whether we have an Ada interface compatible class.
3025 That is only have a vtable non-static data member and no
3026 non-abstract methods. */
94159ecf 3027 if (cpp_check
5aaa8fb4 3028 && RECORD_OR_UNION_TYPE_P (TREE_TYPE (t)))
9cc54940 3029 {
9f2cb25e 3030 bool has_fields = false;
9cc54940
AC		 3031
3032 /* Check that there are no fields other than the virtual table. */
5aaa8fb4 3033 for (tree fld = TYPE_FIELDS (TREE_TYPE (t));
9f2cb25e
EB		 3034 fld;
3035 fld = TREE_CHAIN (fld))
9cc54940 3036 {
5aaa8fb4
NS		 3037 if (TREE_CODE (fld) == FIELD_DECL)
3038 {
9f2cb25e 3039 if (!has_fields && DECL_VIRTUAL_P (fld))
095d8d4b 3040 is_interface = true;
5aaa8fb4 3041 else
095d8d4b 3042 is_interface = false;
9f2cb25e 3043 has_fields = true;
5aaa8fb4 3044 }
db440138 3045 else if (TREE_CODE (fld) == FUNCTION_DECL
5aaa8fb4
NS		 3046 && !DECL_ARTIFICIAL (fld))
3047 {
3048 if (cpp_check (fld, IS_ABSTRACT))
095d8d4b 3049 is_abstract_record = true;
5aaa8fb4 3050 else
095d8d4b 3051 is_interface = false;
5aaa8fb4 3052 }
9cc54940
AC		 3053 }
3054 }
3055
3b0c690e 3056 TREE_VISITED (t) = 1;
9cc54940
AC		 3057 if (is_interface)
3058 {
3059 pp_string (buffer, "limited interface; -- ");
3060 dump_sloc (buffer, t);
3061 newline_and_indent (buffer, spc);
3062 pp_string (buffer, "pragma Import (CPP, ");
e02f4b92
EB		 3063 dump_ada_node (buffer, TYPE_NAME (TREE_TYPE (t)), type, spc, false,
3064 true);
3065 pp_right_paren (buffer);
9cc54940 3066
79310774 3067 dump_ada_methods (buffer, TREE_TYPE (t), spc);
9cc54940
AC		 3068 }
3069 else
3070 {
3071 if (is_abstract_record)
3072 pp_string (buffer, "abstract ");
e02f4b92 3073 dump_ada_node (buffer, t, t, spc, false, false);
9cc54940
AC		 3074 }
3075 }
3076 else
3077 {
3078 if (need_indent)
3079 INDENT (spc);
3080
3081 if (TREE_CODE (t) == FIELD_DECL && DECL_NAME (t))
3082 check_name (buffer, t);
3083
3084 /* Print variable/type's name. */
e02f4b92 3085 dump_ada_node (buffer, t, t, spc, false, true);
9cc54940
AC		 3086
3087 if (TREE_CODE (t) == TYPE_DECL)
3088 {
095d8d4b 3089 const bool is_subtype = TYPE_NAME (orig);
9cc54940 3090
f07862c7 3091 if (!is_subtype && TREE_CODE (TREE_TYPE (t)) == UNION_TYPE)
9cc54940
AC		 3092 pp_string (buffer, " (discr : unsigned := 0)");
3093
3094 pp_string (buffer, " is ");
3095
e02f4b92 3096 dump_ada_node (buffer, orig, t, spc, false, is_subtype);
9cc54940
AC		 3097 }
3098 else
3099 {
3100 if (spc == INDENT_INCR || TREE_STATIC (t))
095d8d4b 3101 is_var = true;
9cc54940
AC		 3102
3103 pp_string (buffer, " : ");
3104
9e25c7ed
EB		 3105 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t))
3106 || TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE)
9cc54940 3107 {
9e25c7ed
EB		 3108 if (TYPE_NAME (TREE_TYPE (t))
3109 || TREE_CODE (TREE_TYPE (t)) != ENUMERAL_TYPE)
3110 pp_string (buffer, "aliased ");
9cc54940 3111
8c8b7be5 3112 if (TREE_READONLY (t) && TREE_CODE (t) != FIELD_DECL)
f4bcd9eb
EB		 3113 pp_string (buffer, "constant ");
3114
f07862c7 3115 if (TYPE_NAME (TREE_TYPE (t)))
e02f4b92 3116 dump_ada_node (buffer, TREE_TYPE (t), t, spc, false, true);
942047f2 3117 else if (type)
f07862c7 3118 dump_ada_double_name (buffer, type, t);
9cc54940
AC		 3119 }
3120 else
3121 {
3122 if (TREE_CODE (TREE_TYPE (t)) != POINTER_TYPE
3123 && (TYPE_NAME (TREE_TYPE (t))
3124 || TREE_CODE (TREE_TYPE (t)) != INTEGER_TYPE))
3125 pp_string (buffer, "aliased ");
3126
8c8b7be5 3127 if (TREE_READONLY (t) && TREE_CODE (t) != FIELD_DECL)
f4bcd9eb
EB		 3128 pp_string (buffer, "constant ");
3129
9e25c7ed 3130 dump_ada_node (buffer, TREE_TYPE (t), t, spc, false, true);
9cc54940
AC		 3131 }
3132 }
3133 }
3134
3135 if (is_class)
3136 {
2a877204 3137 spc -= INDENT_INCR;
9cc54940
AC		 3138 newline_and_indent (buffer, spc);
3139 pp_string (buffer, "end;");
3140 newline_and_indent (buffer, spc);
3141 pp_string (buffer, "use Class_");
e02f4b92 3142 dump_ada_node (buffer, t, type, spc, false, true);
9cc54940
AC		 3143 pp_semicolon (buffer);
3144 pp_newline (buffer);
3145
3146 /* All needed indentation/newline performed already, so return 0. */
3147 return 0;
3148 }
3149 else
3150 {
3151 pp_string (buffer, "; -- ");
3152 dump_sloc (buffer, t);
3153 }
3154
3155 if (is_var)
3156 {
3157 newline_and_indent (buffer, spc);
3158 dump_ada_import (buffer, t);
3159 }
3160
3161 return 1;
3162}
3163
79310774 3164/* Dump in BUFFER a structure NODE of type TYPE: name, fields, and methods
9e25c7ed 3165 in Ada syntax. SPC is the indentation level. If DISPLAY_CONVENTION is
94159ecf 3166 true, also print the pragma Convention for NODE. */
9cc54940
AC		 3167
3168static void
e02f4b92
EB		 3169dump_ada_structure (pretty_printer *buffer, tree node, tree type, int spc,
3170 bool display_convention)
9cc54940 3171{
f07862c7 3172 const bool is_union = (TREE_CODE (node) == UNION_TYPE);
b46dbc6c 3173 char buf[32];
9cc54940
AC		 3174 int field_num = 0;
3175 int field_spc = spc + INDENT_INCR;
3176 int need_semicolon;
3177
3178 bitfield_used = false;
3179
095d8d4b
EB		 3180 /* Print the contents of the structure. */
3181 pp_string (buffer, "record");
9cc54940 3182
095d8d4b
EB		 3183 if (is_union)
3184 {
3185 newline_and_indent (buffer, spc + INDENT_INCR);
3186 pp_string (buffer, "case discr is");
3187 field_spc = spc + INDENT_INCR * 3;
3188 }
9cc54940 3189
095d8d4b 3190 pp_newline (buffer);
9cc54940 3191
095d8d4b 3192 /* Print the non-static fields of the structure. */
9e25c7ed 3193 for (tree tmp = TYPE_FIELDS (node); tmp; tmp = TREE_CHAIN (tmp))
095d8d4b
EB		 3194 {
3195 /* Add parent field if needed. */
3196 if (!DECL_NAME (tmp))
9cc54940 3197 {
095d8d4b 3198 if (!is_tagged_type (TREE_TYPE (tmp)))
9cc54940 3199 {
095d8d4b
EB		 3200 if (!TYPE_NAME (TREE_TYPE (tmp)))
3201 dump_ada_declaration (buffer, tmp, type, field_spc);
3202 else
9cc54940 3203 {
095d8d4b
EB		 3204 INDENT (field_spc);
3205
3206 if (field_num == 0)
3207 pp_string (buffer, "parent : aliased ");
9cc54940
AC		 3208 else
3209 {
095d8d4b
EB		 3210 sprintf (buf, "field_%d : aliased ", field_num + 1);
3211 pp_string (buffer, buf);
9cc54940 3212 }
9e25c7ed
EB		 3213 dump_ada_decl_name (buffer, TYPE_NAME (TREE_TYPE (tmp)),
3214 false);
095d8d4b 3215 pp_semicolon (buffer);
9cc54940 3216 }
095d8d4b
EB		 3217
3218 pp_newline (buffer);
3219 field_num++;
9cc54940 3220 }
095d8d4b
EB		 3221 }
3222 else if (TREE_CODE (tmp) == FIELD_DECL)
3223 {
3224 /* Skip internal virtual table field. */
3225 if (!DECL_VIRTUAL_P (tmp))
9cc54940 3226 {
095d8d4b 3227 if (is_union)
9cc54940 3228 {
095d8d4b
EB		 3229 if (TREE_CHAIN (tmp)
3230 && TREE_TYPE (TREE_CHAIN (tmp)) != node
3231 && TREE_CODE (TREE_CHAIN (tmp)) != TYPE_DECL)
3232 sprintf (buf, "when %d =>", field_num);
3233 else
3234 sprintf (buf, "when others =>");
9cc54940 3235
095d8d4b
EB		 3236 INDENT (spc + INDENT_INCR * 2);
3237 pp_string (buffer, buf);
3238 pp_newline (buffer);
3239 }
9cc54940 3240
095d8d4b
EB		 3241 if (dump_ada_declaration (buffer, tmp, type, field_spc))
3242 {
3243 pp_newline (buffer);
3244 field_num++;
9cc54940
AC		 3245 }
3246 }
3247 }
095d8d4b 3248 }
9cc54940 3249
095d8d4b
EB		 3250 if (is_union)
3251 {
3252 INDENT (spc + INDENT_INCR);
3253 pp_string (buffer, "end case;");
3254 pp_newline (buffer);
3255 }
9cc54940 3256
095d8d4b
EB		 3257 if (field_num == 0)
3258 {
3259 INDENT (spc + INDENT_INCR);
3260 pp_string (buffer, "null;");
3261 pp_newline (buffer);
9cc54940 3262 }
095d8d4b
EB		 3263
3264 INDENT (spc);
3265 pp_string (buffer, "end record;");
9cc54940
AC		 3266
3267 newline_and_indent (buffer, spc);
3268
3269 if (!display_convention)
3270 return;
3271
3272 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (type)))
3273 {
94159ecf 3274 if (has_nontrivial_methods (TREE_TYPE (type)))
9cc54940
AC		 3275 pp_string (buffer, "pragma Import (CPP, ");
3276 else
3277 pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
3278 }
3279 else
3280 pp_string (buffer, "pragma Convention (C, ");
3281
3282 package_prefix = false;
e02f4b92 3283 dump_ada_node (buffer, TREE_TYPE (type), type, spc, false, true);
9cc54940 3284 package_prefix = true;
07838b13 3285 pp_right_paren (buffer);
9cc54940
AC		 3286
3287 if (is_union)
3288 {
3289 pp_semicolon (buffer);
3290 newline_and_indent (buffer, spc);
3291 pp_string (buffer, "pragma Unchecked_Union (");
3292
e02f4b92 3293 dump_ada_node (buffer, TREE_TYPE (type), type, spc, false, true);
07838b13 3294 pp_right_paren (buffer);
9cc54940
AC		 3295 }
3296
3297 if (bitfield_used)
3298 {
3299 pp_semicolon (buffer);
3300 newline_and_indent (buffer, spc);
3301 pp_string (buffer, "pragma Pack (");
e02f4b92 3302 dump_ada_node (buffer, TREE_TYPE (type), type, spc, false, true);
07838b13 3303 pp_right_paren (buffer);
9cc54940
AC		 3304 bitfield_used = false;
3305 }
3306
79310774 3307 need_semicolon = !dump_ada_methods (buffer, node, spc);
9cc54940
AC		 3308
3309 /* Print the static fields of the structure, if any. */
9e25c7ed 3310 for (tree tmp = TYPE_FIELDS (node); tmp; tmp = TREE_CHAIN (tmp))
9cc54940 3311 {
b854df3c 3312 if (TREE_CODE (tmp) == VAR_DECL && DECL_NAME (tmp))
9cc54940
AC		 3313 {
3314 if (need_semicolon)
3315 {
3316 need_semicolon = false;
3317 pp_semicolon (buffer);
3318 }
3319 pp_newline (buffer);
3320 pp_newline (buffer);
79310774 3321 dump_ada_declaration (buffer, tmp, type, spc);
9cc54940
AC		 3322 }
3323 }
3324}
3325
3326/* Dump all the declarations in SOURCE_FILE to an Ada spec.
3327 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
94159ecf 3328 nodes for SOURCE_FILE. CHECK is used to perform C++ queries on nodes. */
9cc54940
AC		 3329
3330static void
3331dump_ads (const char *source_file,
3332 void (*collect_all_refs)(const char *),
621955cb 3333 int (*check)(tree, cpp_operation))
9cc54940
AC		 3334{
3335 char *ads_name;
3336 char *pkg_name;
3337 char *s;
3338 FILE *f;
3339
3340 pkg_name = get_ada_package (source_file);
3341
dd5a833e 3342 /* Construct the .ads filename and package name. */
9cc54940
AC		 3343 ads_name = xstrdup (pkg_name);
3344
3345 for (s = ads_name; *s; s++)
da5182be
TQ		 3346 if (*s == '.')
3347 *s = '-';
3348 else
3349 *s = TOLOWER (*s);
9cc54940
AC		 3350
3351 ads_name = reconcat (ads_name, ads_name, ".ads", NULL);
3352
3353 /* Write out the .ads file. */
3354 f = fopen (ads_name, "w");
3355 if (f)
3356 {
3357 pretty_printer pp;
3358
9cc54940
AC		 3359 pp_needs_newline (&pp) = true;
3360 pp.buffer->stream = f;
3361
3362 /* Dump all relevant macros. */
3363 dump_ada_macros (&pp, source_file);
3364
3365 /* Reset the table of withs for this file. */
3366 reset_ada_withs ();
3367
3368 (*collect_all_refs) (source_file);
3369
3370 /* Dump all references. */
94159ecf
EB		 3371 cpp_check = check;
3372 dump_ada_nodes (&pp, source_file);
9cc54940 3373
c583af79
AC		 3374 /* Requires Ada 2005 syntax, so generate corresponding pragma.
3375 Also, disable style checks since this file is auto-generated. */
3376 fprintf (f, "pragma Ada_2005;\npragma Style_Checks (Off);\n\n");
3377
9cc54940
AC		 3378 /* Dump withs. */
3379 dump_ada_withs (f);
3380
3381 fprintf (f, "\npackage %s is\n\n", pkg_name);
3382 pp_write_text_to_stream (&pp);
3383 /* ??? need to free pp */
3384 fprintf (f, "end %s;\n", pkg_name);
3385 fclose (f);
3386 }
3387
3388 free (ads_name);
3389 free (pkg_name);
3390}
3391
3392static const char **source_refs = NULL;
3393static int source_refs_used = 0;
3394static int source_refs_allocd = 0;
3395
3396/* Add an entry for FILENAME to the table SOURCE_REFS. */
3397
3398void
3399collect_source_ref (const char *filename)
3400{
3401 int i;
3402
3403 if (!filename)
3404 return;
3405
3406 if (source_refs_allocd == 0)
3407 {
3408 source_refs_allocd = 1024;
3409 source_refs = XNEWVEC (const char *, source_refs_allocd);
3410 }
3411
3412 for (i = 0; i < source_refs_used; i++)
0b07a57e 3413 if (filename == source_refs[i])
9cc54940
AC		 3414 return;
3415
3416 if (source_refs_used == source_refs_allocd)
3417 {
3418 source_refs_allocd *= 2;
3419 source_refs = XRESIZEVEC (const char *, source_refs, source_refs_allocd);
3420 }
3421
0b07a57e 3422 source_refs[source_refs_used++] = filename;
9cc54940
AC		 3423}
3424
3425/* Main entry point: dump all Ada specs corresponding to SOURCE_REFS
94159ecf 3426 using callbacks COLLECT_ALL_REFS and CHECK.
9cc54940
AC		 3427 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3428 nodes for a given source file.
94159ecf 3429 CHECK is used to perform C++ queries on nodes, or NULL for the C
9cc54940
AC		 3430 front-end. */
3431
3432void
3433dump_ada_specs (void (*collect_all_refs)(const char *),
621955cb 3434 int (*check)(tree, cpp_operation))
9cc54940 3435{
79310774
EB		 3436 /* Iterate over the list of files to dump specs for. */
3437 for (int i = 0; i < source_refs_used; i++)
94159ecf 3438 dump_ads (source_refs[i], collect_all_refs, check);
9cc54940 3439
6e3e8419 3440 /* Free various tables. */
9cc54940 3441 free (source_refs);
6e3e8419 3442 delete overloaded_names;
9cc54940 3443}
Mirror of https://gcc.gnu.org/git/gcc.git