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