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