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