]> 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
Update copyright years.
[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
9cc54940
AC		 2017static bool bitfield_used = false;
2018
2019/* Recursively dump in BUFFER Ada declarations corresponding to NODE of type
94159ecf
EB		 2020 TYPE. SPC is the indentation level. LIMITED_ACCESS indicates whether NODE
2021 can be referenced via a "limited with" clause. NAME_ONLY indicates whether
2022 we should only dump the name of NODE, instead of its full declaration. */
9cc54940
AC		 2023
2024static int
e02f4b92
EB		 2025dump_ada_node (pretty_printer *buffer, tree node, tree type, int spc,
2026 bool limited_access, bool name_only)
9cc54940
AC		 2027{
2028 if (node == NULL_TREE)
2029 return 0;
2030
2031 switch (TREE_CODE (node))
2032 {
2033 case ERROR_MARK:
2034 pp_string (buffer, "<<< error >>>");
2035 return 0;
2036
2037 case IDENTIFIER_NODE:
e730a0ef 2038 pp_ada_tree_identifier (buffer, node, type, limited_access);
9cc54940
AC		 2039 break;
2040
2041 case TREE_LIST:
2042 pp_string (buffer, "--- unexpected node: TREE_LIST");
2043 return 0;
2044
2045 case TREE_BINFO:
e02f4b92
EB		 2046 dump_ada_node (buffer, BINFO_TYPE (node), type, spc, limited_access,
2047 name_only);
f0bc3323 2048 return 0;
9cc54940
AC		 2049
2050 case TREE_VEC:
2051 pp_string (buffer, "--- unexpected node: TREE_VEC");
2052 return 0;
2053
c6db43fa 2054 case NULLPTR_TYPE:
9cc54940
AC		 2055 case VOID_TYPE:
2056 if (package_prefix)
2057 {
2058 append_withs ("System", false);
2059 pp_string (buffer, "System.Address");
2060 }
2061 else
2062 pp_string (buffer, "address");
2063 break;
2064
2065 case VECTOR_TYPE:
2066 pp_string (buffer, "<vector>");
2067 break;
2068
2069 case COMPLEX_TYPE:
2070 pp_string (buffer, "<complex>");
2071 break;
2072
2073 case ENUMERAL_TYPE:
2074 if (name_only)
e02f4b92 2075 dump_ada_node (buffer, TYPE_NAME (node), node, spc, false, true);
9cc54940 2076 else
e730a0ef 2077 dump_ada_enum_type (buffer, node, spc);
9cc54940
AC		 2078 break;
2079
9cc54940 2080 case REAL_TYPE:
c6db43fa
EB		 2081 if (TYPE_NAME (node)
2082 && TREE_CODE (TYPE_NAME (node)) == TYPE_DECL
2083 && IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (node))) [0] == '_'
2084 && (id_equal (DECL_NAME (TYPE_NAME (node)), "_Float128")
2085 || id_equal (DECL_NAME (TYPE_NAME (node)), "__float128")))
2086 {
2087 append_withs ("Interfaces.C.Extensions", false);
2088 pp_string (buffer, "Extensions.Float_128");
2089 break;
2090 }
2091 /* fallthrough */
2092
2093 case INTEGER_TYPE:
9cc54940
AC		 2094 case FIXED_POINT_TYPE:
2095 case BOOLEAN_TYPE:
da193a27
EB		 2096 if (TYPE_NAME (node)
2097 && !(TREE_CODE (TYPE_NAME (node)) == TYPE_DECL
2098 && !strcmp (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (node))),
2099 "__int128")))
9e25c7ed
EB		 2100 {
2101 if (TREE_CODE (TYPE_NAME (node)) == IDENTIFIER_NODE)
e730a0ef 2102 pp_ada_tree_identifier (buffer, TYPE_NAME (node), node,
9e25c7ed
EB		 2103 limited_access);
2104 else if (TREE_CODE (TYPE_NAME (node)) == TYPE_DECL
2105 && DECL_NAME (TYPE_NAME (node)))
2106 dump_ada_decl_name (buffer, TYPE_NAME (node), limited_access);
2107 else
2108 pp_string (buffer, "<unnamed type>");
2109 }
2110 else if (TREE_CODE (node) == INTEGER_TYPE)
2111 {
2112 append_withs ("Interfaces.C.Extensions", false);
2113 bitfield_used = true;
9cc54940 2114
9e25c7ed
EB		 2115 if (TYPE_PRECISION (node) == 1)
2116 pp_string (buffer, "Extensions.Unsigned_1");
2117 else
2118 {
2119 pp_string (buffer, TYPE_UNSIGNED (node)
2120 ? "Extensions.Unsigned_"
2121 : "Extensions.Signed_");
2122 pp_decimal_int (buffer, TYPE_PRECISION (node));
2123 }
2124 }
2125 else
2126 pp_string (buffer, "<unnamed type>");
2127 break;
9cc54940
AC		 2128
2129 case POINTER_TYPE:
2130 case REFERENCE_TYPE:
c583af79 2131 if (name_only && TYPE_NAME (node))
e02f4b92
EB		 2132 dump_ada_node (buffer, TYPE_NAME (node), node, spc, limited_access,
2133 true);
c583af79
AC		 2134
2135 else if (TREE_CODE (TREE_TYPE (node)) == FUNCTION_TYPE)
9cc54940 2136 {
79310774 2137 if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (node))))
095d8d4b 2138 pp_string (buffer, "access procedure");
9cc54940 2139 else
095d8d4b 2140 pp_string (buffer, "access function");
9cc54940 2141
9e25c7ed
EB		 2142 dump_ada_function_declaration (buffer, node, false, false, false,
2143 spc + INDENT_INCR);
9cc54940 2144
79310774 2145 /* If we are dumping the full type, it means we are part of a
e730a0ef 2146 type definition and need also a Convention C aspect. */
79310774 2147 if (!name_only)
9cc54940 2148 {
79310774 2149 newline_and_indent (buffer, spc);
e730a0ef 2150 pp_string (buffer, "with Convention => C");
9cc54940
AC		 2151 }
2152 }
2153 else
2154 {
6cc430c1 2155 const unsigned int quals = TYPE_QUALS (TREE_TYPE (node));
095d8d4b 2156 bool is_access = false;
9cc54940 2157
c583af79 2158 if (VOID_TYPE_P (TREE_TYPE (node)))
9cc54940
AC		 2159 {
2160 if (!name_only)
2161 pp_string (buffer, "new ");
2162 if (package_prefix)
2163 {
2164 append_withs ("System", false);
2165 pp_string (buffer, "System.Address");
2166 }
2167 else
2168 pp_string (buffer, "address");
2169 }
2170 else
2171 {
2172 if (TREE_CODE (node) == POINTER_TYPE
2173 && TREE_CODE (TREE_TYPE (node)) == INTEGER_TYPE
c6db43fa
EB		 2174 && id_equal (DECL_NAME (TYPE_NAME (TREE_TYPE (node))),
2175 "char"))
9cc54940
AC		 2176 {
2177 if (!name_only)
2178 pp_string (buffer, "new ");
2179
2180 if (package_prefix)
2181 {
2182 pp_string (buffer, "Interfaces.C.Strings.chars_ptr");
2183 append_withs ("Interfaces.C.Strings", false);
2184 }
2185 else
2186 pp_string (buffer, "chars_ptr");
2187 }
2188 else
2189 {
3b0c690e 2190 tree type_name = TYPE_NAME (TREE_TYPE (node));
9cc54940 2191
09de3550
EB		 2192 /* For now, handle access-to-access as System.Address. */
2193 if (TREE_CODE (TREE_TYPE (node)) == POINTER_TYPE)
9cc54940
AC		 2194 {
2195 if (package_prefix)
2196 {
2197 append_withs ("System", false);
2198 if (!name_only)
2199 pp_string (buffer, "new ");
2200 pp_string (buffer, "System.Address");
2201 }
2202 else
2203 pp_string (buffer, "address");
2204 return spc;
2205 }
2206
2207 if (!package_prefix)
2208 pp_string (buffer, "access");
2209 else if (AGGREGATE_TYPE_P (TREE_TYPE (node)))
2210 {
2211 if (!type || TREE_CODE (type) != FUNCTION_DECL)
2212 {
2213 pp_string (buffer, "access ");
2214 is_access = true;
2215
2216 if (quals & TYPE_QUAL_CONST)
2217 pp_string (buffer, "constant ");
2218 else if (!name_only)
2219 pp_string (buffer, "all ");
2220 }
2221 else if (quals & TYPE_QUAL_CONST)
2222 pp_string (buffer, "in ");
9cc54940
AC		 2223 else
2224 {
2225 is_access = true;
2226 pp_string (buffer, "access ");
2227 /* ??? should be configurable: access or in out. */
2228 }
2229 }
2230 else
2231 {
2232 is_access = true;
2233 pp_string (buffer, "access ");
2234
2235 if (!name_only)
2236 pp_string (buffer, "all ");
2237 }
2238
f07862c7 2239 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node)) && type_name)
e02f4b92
EB		 2240 dump_ada_node (buffer, type_name, TREE_TYPE (node), spc,
2241 is_access, true);
9cc54940 2242 else
e02f4b92
EB		 2243 dump_ada_node (buffer, TREE_TYPE (node), TREE_TYPE (node),
2244 spc, false, true);
9cc54940
AC		 2245 }
2246 }
2247 }
2248 break;
2249
2250 case ARRAY_TYPE:
2251 if (name_only)
e02f4b92
EB		 2252 dump_ada_node (buffer, TYPE_NAME (node), node, spc, limited_access,
2253 true);
9cc54940 2254 else
f07862c7 2255 dump_ada_array_type (buffer, node, type, spc);
9cc54940
AC		 2256 break;
2257
2258 case RECORD_TYPE:
2259 case UNION_TYPE:
9cc54940 2260 if (name_only)
9e25c7ed
EB		 2261 dump_ada_node (buffer, TYPE_NAME (node), node, spc, limited_access,
2262 true);
9cc54940 2263 else
e730a0ef 2264 dump_ada_structure (buffer, node, type, false, spc);
9cc54940
AC		 2265 break;
2266
2267 case INTEGER_CST:
909881cb
EB		 2268 /* We treat the upper half of the sizetype range as negative. This
2269 is consistent with the internal treatment and makes it possible
2270 to generate the (0 .. -1) range for flexible array members. */
2271 if (TREE_TYPE (node) == sizetype)
2272 node = fold_convert (ssizetype, node);
9541ffee 2273 if (tree_fits_shwi_p (node))
eb1ce453 2274 pp_wide_integer (buffer, tree_to_shwi (node));
cc269bb6 2275 else if (tree_fits_uhwi_p (node))
eb1ce453 2276 pp_unsigned_wide_integer (buffer, tree_to_uhwi (node));
909881cb 2277 else
9cc54940 2278 {
8e6cdc90 2279 wide_int val = wi::to_wide (node);
807e902e
KZ		 2280 int i;
2281 if (wi::neg_p (val))
9cc54940 2282 {
07838b13 2283 pp_minus (buffer);
807e902e 2284 val = -val;
9cc54940
AC		 2285 }
2286 sprintf (pp_buffer (buffer)->digit_buffer,
807e902e
KZ		 2287 "16#%" HOST_WIDE_INT_PRINT "x",
2288 val.elt (val.get_len () - 1));
2289 for (i = val.get_len () - 2; i >= 0; i--)
2290 sprintf (pp_buffer (buffer)->digit_buffer,
2291 HOST_WIDE_INT_PRINT_PADDED_HEX, val.elt (i));
9cc54940
AC		 2292 pp_string (buffer, pp_buffer (buffer)->digit_buffer);
2293 }
9cc54940
AC		 2294 break;
2295
2296 case REAL_CST:
2297 case FIXED_CST:
2298 case COMPLEX_CST:
2299 case STRING_CST:
2300 case VECTOR_CST:
2301 return 0;
2302
9cc54940
AC		 2303 case TYPE_DECL:
2304 if (DECL_IS_BUILTIN (node))
2305 {
2306 /* Don't print the declaration of built-in types. */
9cc54940
AC		 2307 if (name_only)
2308 {
2309 /* If we're in the middle of a declaration, defaults to
2310 System.Address. */
2311 if (package_prefix)
2312 {
2313 append_withs ("System", false);
2314 pp_string (buffer, "System.Address");
2315 }
2316 else
2317 pp_string (buffer, "address");
2318 }
2319 break;
2320 }
2321
2322 if (name_only)
2323 dump_ada_decl_name (buffer, node, limited_access);
2324 else
2325 {
2326 if (is_tagged_type (TREE_TYPE (node)))
2327 {
9e25c7ed 2328 int first = true;
9cc54940
AC		 2329
2330 /* Look for ancestors. */
9f2cb25e
EB		 2331 for (tree fld = TYPE_FIELDS (TREE_TYPE (node));
2332 fld;
2333 fld = TREE_CHAIN (fld))
9cc54940 2334 {
9f2cb25e 2335 if (!DECL_NAME (fld) && is_tagged_type (TREE_TYPE (fld)))
9cc54940
AC		 2336 {
2337 if (first)
2338 {
2339 pp_string (buffer, "limited new ");
9e25c7ed 2340 first = false;
9cc54940
AC		 2341 }
2342 else
2343 pp_string (buffer, " and ");
2344
9f2cb25e
EB		 2345 dump_ada_decl_name (buffer, TYPE_NAME (TREE_TYPE (fld)),
2346 false);
9cc54940
AC		 2347 }
2348 }
2349
2350 pp_string (buffer, first ? "tagged limited " : " with ");
2351 }
94159ecf 2352 else if (has_nontrivial_methods (TREE_TYPE (node)))
9cc54940
AC		 2353 pp_string (buffer, "limited ");
2354
e02f4b92 2355 dump_ada_node (buffer, TREE_TYPE (node), type, spc, false, false);
9cc54940
AC		 2356 }
2357 break;
2358
79310774
EB		 2359 case FUNCTION_DECL:
2360 case CONST_DECL:
9cc54940
AC		 2361 case VAR_DECL:
2362 case PARM_DECL:
2363 case FIELD_DECL:
2364 case NAMESPACE_DECL:
2365 dump_ada_decl_name (buffer, node, false);
2366 break;
2367
2368 default:
2369 /* Ignore other nodes (e.g. expressions). */
2370 return 0;
2371 }
2372
2373 return 1;
2374}
2375
94159ecf 2376/* Dump in BUFFER NODE's methods. SPC is the indentation level. Return 1 if
59909673 2377 methods were printed, 0 otherwise. */
9cc54940 2378
94159ecf 2379static int
79310774 2380dump_ada_methods (pretty_printer *buffer, tree node, int spc)
9cc54940 2381{
94159ecf
EB		 2382 if (!has_nontrivial_methods (node))
2383 return 0;
9cc54940 2384
94159ecf
EB		 2385 pp_semicolon (buffer);
2386
5aaa8fb4
NS		 2387 int res = 1;
2388 for (tree fld = TYPE_FIELDS (node); fld; fld = DECL_CHAIN (fld))
db440138 2389 if (TREE_CODE (fld) == FUNCTION_DECL)
5aaa8fb4
NS		 2390 {
2391 if (res)
2392 {
2393 pp_newline (buffer);
2394 pp_newline (buffer);
2395 }
79310774
EB		 2396
2397 res = dump_ada_declaration (buffer, fld, node, spc);
5aaa8fb4 2398 }
2a877204 2399
94159ecf 2400 return 1;
9cc54940
AC		 2401}
2402
095d8d4b
EB		 2403/* Dump in BUFFER a forward declaration for TYPE present inside T.
2404 SPC is the indentation level. */
2405
2406static void
2407dump_forward_type (pretty_printer *buffer, tree type, tree t, int spc)
2408{
2409 tree decl = get_underlying_decl (type);
2410
2411 /* Anonymous pointer and function types. */
2412 if (!decl)
2413 {
2414 if (TREE_CODE (type) == POINTER_TYPE)
2415 dump_forward_type (buffer, TREE_TYPE (type), t, spc);
2416 else if (TREE_CODE (type) == FUNCTION_TYPE)
2417 {
2418 function_args_iterator args_iter;
2419 tree arg;
2420 dump_forward_type (buffer, TREE_TYPE (type), t, spc);
2421 FOREACH_FUNCTION_ARGS (type, arg, args_iter)
2422 dump_forward_type (buffer, arg, t, spc);
2423 }
2424 return;
2425 }
2426
2427 if (DECL_IS_BUILTIN (decl) || TREE_VISITED (decl))
2428 return;
2429
095d8d4b
EB		 2430 /* Forward declarations are only needed within a given file. */
2431 if (DECL_SOURCE_FILE (decl) != DECL_SOURCE_FILE (t))
2432 return;
2433
2434 /* Generate an incomplete type declaration. */
2435 pp_string (buffer, "type ");
e02f4b92 2436 dump_ada_node (buffer, decl, NULL_TREE, spc, false, true);
095d8d4b
EB		 2437 pp_semicolon (buffer);
2438 newline_and_indent (buffer, spc);
2439
2440 /* Only one incomplete declaration is legal for a given type. */
2441 TREE_VISITED (decl) = 1;
2442}
2443
f07862c7
EB		 2444static void dump_nested_type (pretty_printer *, tree, tree, tree, int);
2445
9cc54940 2446/* Dump in BUFFER anonymous types nested inside T's definition.
095d8d4b 2447 PARENT is the parent node of T. SPC is the indentation level.
f07862c7
EB		 2448
2449 In C anonymous nested tagged types have no name whereas in C++ they have
2450 one. In C their TYPE_DECL is at top level whereas in C++ it is nested.
2451 In both languages untagged types (pointers and arrays) have no name.
2452 In C++ the nested TYPE_DECLs can come after their associated FIELD_DECL.
2453
2454 Therefore, in order to have a common processing for both languages, we
2455 disregard anonymous TYPE_DECLs at top level and here we make a first
2456 pass on the nested TYPE_DECLs and a second pass on the unnamed types. */
9cc54940
AC		 2457
2458static void
095d8d4b 2459dump_nested_types (pretty_printer *buffer, tree t, tree parent, int spc)
9cc54940 2460{
f07862c7 2461 tree type, field;
9cc54940 2462
f07862c7
EB		 2463 /* Find possible anonymous pointers/arrays/structs/unions recursively. */
2464 type = TREE_TYPE (t);
2465 if (type == NULL_TREE)
9cc54940
AC		 2466 return;
2467
f07862c7
EB		 2468 for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
2469 if (TREE_CODE (field) == TYPE_DECL
2470 && DECL_NAME (field) != DECL_NAME (t)
095d8d4b 2471 && !DECL_ORIGINAL_TYPE (field)
f07862c7
EB		 2472 && TYPE_NAME (TREE_TYPE (field)) != TYPE_NAME (type))
2473 dump_nested_type (buffer, field, t, parent, spc);
9cc54940 2474
f07862c7 2475 for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
9f2cb25e 2476 if (TREE_CODE (field) == FIELD_DECL && !TYPE_NAME (TREE_TYPE (field)))
f07862c7 2477 dump_nested_type (buffer, field, t, parent, spc);
f07862c7 2478}
9cc54940 2479
f07862c7 2480/* Dump in BUFFER the anonymous type of FIELD inside T.
095d8d4b 2481 PARENT is the parent node of T. SPC is the indentation level. */
9cc54940 2482
f07862c7
EB		 2483static void
2484dump_nested_type (pretty_printer *buffer, tree field, tree t, tree parent,
2485 int spc)
2486{
2487 tree field_type = TREE_TYPE (field);
2488 tree decl, tmp;
9cc54940 2489
f07862c7
EB		 2490 switch (TREE_CODE (field_type))
2491 {
2492 case POINTER_TYPE:
2493 tmp = TREE_TYPE (field_type);
095d8d4b 2494 dump_forward_type (buffer, tmp, t, spc);
f07862c7 2495 break;
9cc54940 2496
f07862c7
EB		 2497 case ARRAY_TYPE:
2498 tmp = TREE_TYPE (field_type);
2499 while (TREE_CODE (tmp) == ARRAY_TYPE)
2500 tmp = TREE_TYPE (tmp);
2501 decl = get_underlying_decl (tmp);
23f2660f 2502 if (decl && !DECL_NAME (decl) && !TREE_VISITED (decl))
f07862c7
EB		 2503 {
2504 /* Generate full declaration. */
2505 dump_nested_type (buffer, decl, t, parent, spc);
2506 TREE_VISITED (decl) = 1;
2507 }
095d8d4b
EB		 2508 else if (!decl && TREE_CODE (tmp) == POINTER_TYPE)
2509 dump_forward_type (buffer, TREE_TYPE (tmp), t, spc);
9cc54940 2510
f07862c7 2511 /* Special case char arrays. */
9e25c7ed
EB		 2512 if (is_char_array (field_type))
2513 pp_string (buffer, "subtype ");
2514 else
2515 pp_string (buffer, "type ");
9cc54940 2516
f07862c7
EB		 2517 dump_ada_double_name (buffer, parent, field);
2518 pp_string (buffer, " is ");
9e25c7ed 2519 dump_ada_array_type (buffer, field_type, parent, spc);
f07862c7
EB		 2520 pp_semicolon (buffer);
2521 newline_and_indent (buffer, spc);
2522 break;
9cc54940 2523
9e25c7ed
EB		 2524 case ENUMERAL_TYPE:
2525 if (is_simple_enum (field_type))
2526 pp_string (buffer, "type ");
2527 else
2528 pp_string (buffer, "subtype ");
2529
2530 if (TYPE_NAME (field_type))
2531 dump_ada_node (buffer, field_type, NULL_TREE, spc, false, true);
2532 else
2533 dump_ada_double_name (buffer, parent, field);
2534 pp_string (buffer, " is ");
e730a0ef
EB		 2535 dump_ada_enum_type (buffer, field_type, spc);
2536 pp_semicolon (buffer);
2537 newline_and_indent (buffer, spc);
9e25c7ed
EB		 2538 break;
2539
f07862c7
EB		 2540 case RECORD_TYPE:
2541 case UNION_TYPE:
095d8d4b 2542 dump_nested_types (buffer, field, t, spc);
9cc54940 2543
f07862c7 2544 pp_string (buffer, "type ");
9cc54940 2545
f07862c7 2546 if (TYPE_NAME (field_type))
9e25c7ed
EB		 2547 dump_ada_node (buffer, field_type, NULL_TREE, spc, false, true);
2548 else
2549 dump_ada_double_name (buffer, parent, field);
9cc54940 2550
9e25c7ed
EB		 2551 if (TREE_CODE (field_type) == UNION_TYPE)
2552 pp_string (buffer, " (discr : unsigned := 0)");
9cc54940 2553
9e25c7ed 2554 pp_string (buffer, " is ");
e730a0ef 2555 dump_ada_structure (buffer, field_type, t, true, spc);
9e25c7ed 2556
e730a0ef 2557 pp_string (buffer, "with Convention => C_Pass_By_Copy");
9cc54940 2558
9e25c7ed
EB		 2559 if (TREE_CODE (field_type) == UNION_TYPE)
2560 {
e730a0ef
EB		 2561 pp_comma (buffer);
2562 newline_and_indent (buffer, spc + 5);
2563 pp_string (buffer, "Unchecked_Union => True");
9cc54940 2564 }
e730a0ef
EB		 2565
2566 pp_semicolon (buffer);
2567 newline_and_indent (buffer, spc);
9e25c7ed 2568 break;
3b0c690e 2569
f07862c7
EB		 2570 default:
2571 break;
2572 }
9cc54940
AC		 2573}
2574
da193a27
EB		 2575/* Hash table of overloaded names that we cannot support. It is needed even
2576 in Ada 2012 because we merge different types, e.g. void * and const void *
2577 in System.Address, so we cannot have overloading for them in Ada. */
2578
2579struct overloaded_name_hash {
2580 hashval_t hash;
2581 tree name;
2582 unsigned int n;
2583};
2584
2585struct overloaded_name_hasher : delete_ptr_hash<overloaded_name_hash>
2586{
2587 static inline hashval_t hash (overloaded_name_hash *t)
2588 { return t->hash; }
2589 static inline bool equal (overloaded_name_hash *a, overloaded_name_hash *b)
2590 { return a->name == b->name; }
2591};
2592
2593static hash_table<overloaded_name_hasher> *overloaded_names;
2594
2595/* Initialize the table with the problematic overloaded names. */
2596
2597static hash_table<overloaded_name_hasher> *
2598init_overloaded_names (void)
2599{
2600 static const char *names[] =
2601 /* The overloaded names from the /usr/include/string.h file. */
2602 { "memchr", "rawmemchr", "memrchr", "strchr", "strrchr", "strchrnul",
2603 "strpbrk", "strstr", "strcasestr", "index", "rindex", "basename" };
2604
2605 hash_table<overloaded_name_hasher> *table
2606 = new hash_table<overloaded_name_hasher> (64);
2607
2608 for (unsigned int i = 0; i < ARRAY_SIZE (names); i++)
2609 {
2610 struct overloaded_name_hash in, *h, **slot;
2611 tree id = get_identifier (names[i]);
2612 hashval_t hash = htab_hash_pointer (id);
2613 in.hash = hash;
2614 in.name = id;
2615 slot = table->find_slot_with_hash (&in, hash, INSERT);
2616 h = new overloaded_name_hash;
2617 h->hash = hash;
2618 h->name = id;
2619 h->n = 0;
2620 *slot = h;
2621 }
2622
2623 return table;
2624}
2625
2626/* Return whether NAME cannot be supported as overloaded name. */
2627
2628static bool
2629overloaded_name_p (tree name)
2630{
2631 if (!overloaded_names)
2632 overloaded_names = init_overloaded_names ();
2633
2634 struct overloaded_name_hash in, *h;
2635 hashval_t hash = htab_hash_pointer (name);
2636 in.hash = hash;
2637 in.name = name;
2638 h = overloaded_names->find_with_hash (&in, hash);
2639 return h && ++h->n > 1;
2640}
2641
b854df3c 2642/* Dump in BUFFER constructor spec corresponding to T for TYPE. */
f2aa696b
EB		 2643
2644static void
b854df3c 2645print_constructor (pretty_printer *buffer, tree t, tree type)
f2aa696b 2646{
b854df3c 2647 tree decl_name = DECL_NAME (TYPE_NAME (type));
f2aa696b
EB		 2648
2649 pp_string (buffer, "New_");
e730a0ef 2650 pp_ada_tree_identifier (buffer, decl_name, t, false);
f2aa696b
EB		 2651}
2652
9cc54940
AC		 2653/* Dump in BUFFER destructor spec corresponding to T. */
2654
2655static void
b854df3c 2656print_destructor (pretty_printer *buffer, tree t, tree type)
9cc54940 2657{
b854df3c 2658 tree decl_name = DECL_NAME (TYPE_NAME (type));
9cc54940 2659
0d2489f4 2660 pp_string (buffer, "Delete_");
e730a0ef 2661 pp_ada_tree_identifier (buffer, decl_name, t, false);
9cc54940
AC		 2662}
2663
2664/* Return the name of type T. */
2665
2666static const char *
2667type_name (tree t)
2668{
2669 tree n = TYPE_NAME (t);
2670
2671 if (TREE_CODE (n) == IDENTIFIER_NODE)
2672 return IDENTIFIER_POINTER (n);
2673 else
2674 return IDENTIFIER_POINTER (DECL_NAME (n));
2675}
2676
da193a27 2677/* Dump in BUFFER the declaration of object T of type TYPE in Ada syntax.
94159ecf
EB		 2678 SPC is the indentation level. Return 1 if a declaration was printed,
2679 0 otherwise. */
9cc54940
AC		 2680
2681static int
79310774 2682dump_ada_declaration (pretty_printer *buffer, tree t, tree type, int spc)
9cc54940 2683{
095d8d4b
EB		 2684 bool is_var = false;
2685 bool need_indent = false;
2686 bool is_class = false;
9cc54940
AC		 2687 tree name = TYPE_NAME (TREE_TYPE (t));
2688 tree decl_name = DECL_NAME (t);
9cc54940
AC		 2689 tree orig = NULL_TREE;
2690
2691 if (cpp_check && cpp_check (t, IS_TEMPLATE))
94159ecf 2692 return dump_ada_template (buffer, t, spc);
9cc54940 2693
095d8d4b 2694 /* Skip enumeral values: will be handled as part of the type itself. */
9cc54940 2695 if (TREE_CODE (t) == CONST_DECL && TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE)
9cc54940
AC		 2696 return 0;
2697
2698 if (TREE_CODE (t) == TYPE_DECL)
2699 {
2700 orig = DECL_ORIGINAL_TYPE (t);
2701
da193a27 2702 /* This is a typedef. */
9cc54940
AC		 2703 if (orig && TYPE_STUB_DECL (orig))
2704 {
3b0c690e 2705 tree stub = TYPE_STUB_DECL (orig);
9cc54940 2706
da193a27
EB		 2707 /* If this is a typedef of a named type, then output it as a subtype
2708 declaration. ??? Use a derived type declaration instead. */
2709 if (TYPE_NAME (orig))
9cc54940 2710 {
abc24d93
EB		 2711 /* If the types have the same name (ignoring casing), then ignore
2712 the second type, but forward declare the first if need be. */
da193a27
EB		 2713 if (type_name (orig) == type_name (TREE_TYPE (t))
2714 || !strcasecmp (type_name (orig), type_name (TREE_TYPE (t))))
23f2660f 2715 {
da193a27 2716 if (RECORD_OR_UNION_TYPE_P (orig) && !TREE_VISITED (stub))
abc24d93
EB		 2717 {
2718 INDENT (spc);
da193a27 2719 dump_forward_type (buffer, orig, t, 0);
abc24d93
EB		 2720 }
2721
23f2660f
EB		 2722 TREE_VISITED (t) = 1;
2723 return 0;
2724 }
9cc54940
AC		 2725
2726 INDENT (spc);
2727
da193a27
EB		 2728 if (RECORD_OR_UNION_TYPE_P (orig) && !TREE_VISITED (stub))
2729 dump_forward_type (buffer, orig, t, spc);
09de3550
EB		 2730
2731 pp_string (buffer, "subtype ");
2732 dump_ada_node (buffer, t, type, spc, false, true);
2733 pp_string (buffer, " is ");
da193a27 2734 dump_ada_node (buffer, orig, type, spc, false, true);
09de3550
EB		 2735 pp_string (buffer, "; -- ");
2736 dump_sloc (buffer, t);
23f2660f
EB		 2737
2738 TREE_VISITED (t) = 1;
9cc54940
AC		 2739 return 1;
2740 }
da193a27
EB		 2741
2742 /* This is a typedef of an anonymous type. We'll output the full
2743 type declaration of the anonymous type with the typedef'ed name
2744 below. Prevent forward declarations for the anonymous type to
2745 be emitted from now on. */
2746 TREE_VISITED (stub) = 1;
9cc54940
AC		 2747 }
2748
2749 /* Skip unnamed or anonymous structs/unions/enum types. */
f07862c7
EB		 2750 if (!orig && !decl_name && !name
2751 && (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t))
2752 || TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE))
2753 return 0;
9cc54940 2754
f07862c7 2755 /* Skip anonymous enum types (duplicates of real types). */
9cc54940
AC		 2756 if (!orig
2757 && TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE
2758 && decl_name
2759 && (*IDENTIFIER_POINTER (decl_name) == '.'
2760 || *IDENTIFIER_POINTER (decl_name) == '$'))
9cc54940
AC		 2761 return 0;
2762
2763 INDENT (spc);
2764
2765 switch (TREE_CODE (TREE_TYPE (t)))
2766 {
2767 case RECORD_TYPE:
2768 case UNION_TYPE:
095d8d4b 2769 if (!COMPLETE_TYPE_P (TREE_TYPE (t)))
9cc54940 2770 {
09de3550 2771 pp_string (buffer, "type ");
e02f4b92 2772 dump_ada_node (buffer, t, type, spc, false, true);
09de3550
EB		 2773 pp_string (buffer, " is null record; -- incomplete struct");
2774 TREE_VISITED (t) = 1;
9cc54940
AC		 2775 return 1;
2776 }
2777
2778 if (decl_name
2779 && (*IDENTIFIER_POINTER (decl_name) == '.'
2780 || *IDENTIFIER_POINTER (decl_name) == '$'))
2781 {
2782 pp_string (buffer, "-- skipped anonymous struct ");
e02f4b92 2783 dump_ada_node (buffer, t, type, spc, false, true);
3b0c690e 2784 TREE_VISITED (t) = 1;
9cc54940
AC		 2785 return 1;
2786 }
2787
518196cb
EB		 2788 /* ??? Packed record layout is not supported. */
2789 if (TYPE_PACKED (TREE_TYPE (t)))
2790 {
2791 warning_at (DECL_SOURCE_LOCATION (t), 0,
2792 "unsupported record layout");
2793 pp_string (buffer, "pragma Compile_Time_Warning (True, ");
2794 pp_string (buffer, "\"probably incorrect record layout\");");
2795 newline_and_indent (buffer, spc);
2796 }
2797
095d8d4b 2798 if (orig && TYPE_NAME (orig))
9cc54940
AC		 2799 pp_string (buffer, "subtype ");
2800 else
2801 {
095d8d4b 2802 dump_nested_types (buffer, t, t, spc);
9cc54940 2803
1e4bf85b 2804 if (separate_class_package (t))
9cc54940
AC		 2805 {
2806 is_class = true;
2807 pp_string (buffer, "package Class_");
e02f4b92 2808 dump_ada_node (buffer, t, type, spc, false, true);
9cc54940
AC		 2809 pp_string (buffer, " is");
2810 spc += INDENT_INCR;
2811 newline_and_indent (buffer, spc);
2812 }
2813
2814 pp_string (buffer, "type ");
2815 }
2816 break;
2817
9cc54940
AC		 2818 case POINTER_TYPE:
2819 case REFERENCE_TYPE:
095d8d4b
EB		 2820 dump_forward_type (buffer, TREE_TYPE (TREE_TYPE (t)), t, spc);
2821 /* fallthrough */
2822
2823 case ARRAY_TYPE:
9e25c7ed 2824 if ((orig && TYPE_NAME (orig)) || is_char_array (TREE_TYPE (t)))
9cc54940
AC		 2825 pp_string (buffer, "subtype ");
2826 else
2827 pp_string (buffer, "type ");
2828 break;
2829
2830 case FUNCTION_TYPE:
2831 pp_string (buffer, "-- skipped function type ");
e02f4b92 2832 dump_ada_node (buffer, t, type, spc, false, true);
9cc54940 2833 return 1;
9cc54940 2834
eff7e30c
AC		 2835 case ENUMERAL_TYPE:
2836 if ((orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
2837 || !is_simple_enum (TREE_TYPE (t)))
2838 pp_string (buffer, "subtype ");
2839 else
2840 pp_string (buffer, "type ");
2841 break;
2842
9cc54940
AC		 2843 default:
2844 pp_string (buffer, "subtype ");
2845 }
da193a27 2846
3b0c690e 2847 TREE_VISITED (t) = 1;
9cc54940
AC		 2848 }
2849 else
2850 {
0ae9bd27 2851 if (VAR_P (t)
9cc54940
AC		 2852 && decl_name
2853 && *IDENTIFIER_POINTER (decl_name) == '_')
2854 return 0;
2855
095d8d4b 2856 need_indent = true;
9cc54940
AC		 2857 }
2858
2859 /* Print the type and name. */
2860 if (TREE_CODE (TREE_TYPE (t)) == ARRAY_TYPE)
2861 {
2862 if (need_indent)
2863 INDENT (spc);
2864
2865 /* Print variable's name. */
e02f4b92 2866 dump_ada_node (buffer, t, type, spc, false, true);
9cc54940
AC		 2867
2868 if (TREE_CODE (t) == TYPE_DECL)
2869 {
2870 pp_string (buffer, " is ");
2871
095d8d4b 2872 if (orig && TYPE_NAME (orig))
e02f4b92 2873 dump_ada_node (buffer, TYPE_NAME (orig), type, spc, false, true);
9cc54940 2874 else
9e25c7ed 2875 dump_ada_array_type (buffer, TREE_TYPE (t), type, spc);
9cc54940
AC		 2876 }
2877 else
2878 {
2879 tree tmp = TYPE_NAME (TREE_TYPE (t));
2880
2881 if (spc == INDENT_INCR || TREE_STATIC (t))
095d8d4b 2882 is_var = true;
9cc54940
AC		 2883
2884 pp_string (buffer, " : ");
2885
f07862c7
EB		 2886 if (TREE_CODE (TREE_TYPE (TREE_TYPE (t))) != POINTER_TYPE)
2887 pp_string (buffer, "aliased ");
9cc54940 2888
f07862c7 2889 if (tmp)
e02f4b92 2890 dump_ada_node (buffer, tmp, type, spc, false, true);
f07862c7
EB		 2891 else if (type)
2892 dump_ada_double_name (buffer, type, t);
9cc54940 2893 else
9e25c7ed 2894 dump_ada_array_type (buffer, TREE_TYPE (t), type, spc);
9cc54940
AC		 2895 }
2896 }
2897 else if (TREE_CODE (t) == FUNCTION_DECL)
2898 {
79310774 2899 bool is_abstract_class = false;
94159ecf 2900 bool is_method = TREE_CODE (TREE_TYPE (t)) == METHOD_TYPE;
9cc54940 2901 tree decl_name = DECL_NAME (t);
9cc54940
AC		 2902 bool is_abstract = false;
2903 bool is_constructor = false;
2904 bool is_destructor = false;
2905 bool is_copy_constructor = false;
2a7fb83f 2906 bool is_move_constructor = false;
9cc54940 2907
da193a27 2908 if (!decl_name || overloaded_name_p (decl_name))
9cc54940
AC		 2909 return 0;
2910
2911 if (cpp_check)
2912 {
2913 is_abstract = cpp_check (t, IS_ABSTRACT);
2914 is_constructor = cpp_check (t, IS_CONSTRUCTOR);
2915 is_destructor = cpp_check (t, IS_DESTRUCTOR);
2916 is_copy_constructor = cpp_check (t, IS_COPY_CONSTRUCTOR);
2a7fb83f 2917 is_move_constructor = cpp_check (t, IS_MOVE_CONSTRUCTOR);
9cc54940
AC		 2918 }
2919
2a7fb83f
EB		 2920 /* Skip copy constructors and C++11 move constructors: some are internal
2921 only and those that are not cannot be called easily from Ada. */
2922 if (is_copy_constructor || is_move_constructor)
9cc54940
AC		 2923 return 0;
2924
f2aa696b 2925 if (is_constructor || is_destructor)
9cc54940 2926 {
bb49ee66
EB		 2927 /* ??? Skip implicit constructors/destructors for now. */
2928 if (DECL_ARTIFICIAL (t))
a9dcd529
EB		 2929 return 0;
2930
f2aa696b 2931 /* Only consider constructors/destructors for complete objects. */
b854df3c
EB		 2932 if (strncmp (IDENTIFIER_POINTER (decl_name), "__ct_comp", 9) != 0
2933 && strncmp (IDENTIFIER_POINTER (decl_name), "__dt_comp", 9) != 0)
9cc54940 2934 return 0;
f2aa696b 2935 }
9cc54940 2936
f2aa696b
EB		 2937 /* If this function has an entry in the vtable, we cannot omit it. */
2938 else if (!DECL_VINDEX (t) && *IDENTIFIER_POINTER (decl_name) == '_')
2939 {
9cc54940
AC		 2940 INDENT (spc);
2941 pp_string (buffer, "-- skipped func ");
2942 pp_string (buffer, IDENTIFIER_POINTER (decl_name));
2943 return 1;
2944 }
2945
da193a27
EB		 2946 INDENT (spc);
2947
2948 dump_forward_type (buffer, TREE_TYPE (t), t, spc);
9cc54940 2949
f2aa696b 2950 if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t))) && !is_constructor)
79310774 2951 pp_string (buffer, "procedure ");
9cc54940 2952 else
79310774 2953 pp_string (buffer, "function ");
9cc54940 2954
f2aa696b 2955 if (is_constructor)
b854df3c 2956 print_constructor (buffer, t, type);
f2aa696b 2957 else if (is_destructor)
b854df3c 2958 print_destructor (buffer, t, type);
9cc54940
AC		 2959 else
2960 dump_ada_decl_name (buffer, t, false);
2961
2962 dump_ada_function_declaration
2963 (buffer, t, is_method, is_constructor, is_destructor, spc);
9cc54940 2964
5aaa8fb4
NS		 2965 if (is_constructor && RECORD_OR_UNION_TYPE_P (type))
2966 for (tree fld = TYPE_FIELDS (type); fld; fld = DECL_CHAIN (fld))
db440138 2967 if (TREE_CODE (fld) == FUNCTION_DECL && cpp_check (fld, IS_ABSTRACT))
5aaa8fb4
NS		 2968 {
2969 is_abstract_class = true;
2970 break;
2971 }
9cc54940
AC		 2972
2973 if (is_abstract || is_abstract_class)
2974 pp_string (buffer, " is abstract");
2975
65a372f4 2976 if (is_abstract || !DECL_ASSEMBLER_NAME (t))
9cc54940 2977 {
e730a0ef
EB		 2978 pp_semicolon (buffer);
2979 pp_string (buffer, " -- ");
2980 dump_sloc (buffer, t);
2981 }
2982 else if (is_constructor)
2983 {
2984 pp_semicolon (buffer);
2985 pp_string (buffer, " -- ");
2986 dump_sloc (buffer, t);
2987
2988 newline_and_indent (buffer, spc);
f2aa696b 2989 pp_string (buffer, "pragma CPP_Constructor (");
b854df3c 2990 print_constructor (buffer, t, type);
9cc54940
AC		 2991 pp_string (buffer, ", \"");
2992 pp_asm_name (buffer, t);
2993 pp_string (buffer, "\");");
2994 }
e730a0ef 2995 else
9cc54940 2996 {
e730a0ef
EB		 2997 pp_string (buffer, " -- ");
2998 dump_sloc (buffer, t);
2999
3000 newline_and_indent (buffer, spc);
3001 dump_ada_import (buffer, t, spc);
9cc54940 3002 }
9cc54940
AC		 3003
3004 return 1;
3005 }
095d8d4b 3006 else if (TREE_CODE (t) == TYPE_DECL && !orig)
9cc54940 3007 {
095d8d4b
EB		 3008 bool is_interface = false;
3009 bool is_abstract_record = false;
9cc54940 3010
095d8d4b 3011 /* Anonymous structs/unions. */
e02f4b92 3012 dump_ada_node (buffer, TREE_TYPE (t), t, spc, false, true);
9cc54940 3013
f07862c7 3014 if (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE)
095d8d4b 3015 pp_string (buffer, " (discr : unsigned := 0)");
9cc54940
AC		 3016
3017 pp_string (buffer, " is ");
3018
5aaa8fb4
NS		 3019 /* Check whether we have an Ada interface compatible class.
3020 That is only have a vtable non-static data member and no
3021 non-abstract methods. */
94159ecf 3022 if (cpp_check
5aaa8fb4 3023 && RECORD_OR_UNION_TYPE_P (TREE_TYPE (t)))
9cc54940 3024 {
9f2cb25e 3025 bool has_fields = false;
9cc54940
AC		 3026
3027 /* Check that there are no fields other than the virtual table. */
5aaa8fb4 3028 for (tree fld = TYPE_FIELDS (TREE_TYPE (t));
9f2cb25e
EB		 3029 fld;
3030 fld = TREE_CHAIN (fld))
9cc54940 3031 {
5aaa8fb4
NS		 3032 if (TREE_CODE (fld) == FIELD_DECL)
3033 {
9f2cb25e 3034 if (!has_fields && DECL_VIRTUAL_P (fld))
095d8d4b 3035 is_interface = true;
5aaa8fb4 3036 else
095d8d4b 3037 is_interface = false;
9f2cb25e 3038 has_fields = true;
5aaa8fb4 3039 }
db440138 3040 else if (TREE_CODE (fld) == FUNCTION_DECL
5aaa8fb4
NS		 3041 && !DECL_ARTIFICIAL (fld))
3042 {
3043 if (cpp_check (fld, IS_ABSTRACT))
095d8d4b 3044 is_abstract_record = true;
5aaa8fb4 3045 else
095d8d4b 3046 is_interface = false;
5aaa8fb4 3047 }
9cc54940
AC		 3048 }
3049 }
3050
3b0c690e 3051 TREE_VISITED (t) = 1;
9cc54940
AC		 3052 if (is_interface)
3053 {
e730a0ef 3054 pp_string (buffer, "limited interface -- ");
9cc54940
AC		 3055 dump_sloc (buffer, t);
3056 newline_and_indent (buffer, spc);
e730a0ef
EB		 3057 pp_string (buffer, "with Import => True,");
3058 newline_and_indent (buffer, spc + 5);
3059 pp_string (buffer, "Convention => CPP");
9cc54940 3060
79310774 3061 dump_ada_methods (buffer, TREE_TYPE (t), spc);
9cc54940
AC		 3062 }
3063 else
3064 {
3065 if (is_abstract_record)
3066 pp_string (buffer, "abstract ");
e02f4b92 3067 dump_ada_node (buffer, t, t, spc, false, false);
9cc54940
AC		 3068 }
3069 }
3070 else
3071 {
3072 if (need_indent)
3073 INDENT (spc);
3074
3075 if (TREE_CODE (t) == FIELD_DECL && DECL_NAME (t))
3076 check_name (buffer, t);
3077
3078 /* Print variable/type's name. */
e02f4b92 3079 dump_ada_node (buffer, t, t, spc, false, true);
9cc54940
AC		 3080
3081 if (TREE_CODE (t) == TYPE_DECL)
3082 {
095d8d4b 3083 const bool is_subtype = TYPE_NAME (orig);
9cc54940 3084
f07862c7 3085 if (!is_subtype && TREE_CODE (TREE_TYPE (t)) == UNION_TYPE)
9cc54940
AC		 3086 pp_string (buffer, " (discr : unsigned := 0)");
3087
3088 pp_string (buffer, " is ");
3089
e02f4b92 3090 dump_ada_node (buffer, orig, t, spc, false, is_subtype);
9cc54940
AC		 3091 }
3092 else
3093 {
3094 if (spc == INDENT_INCR || TREE_STATIC (t))
095d8d4b 3095 is_var = true;
9cc54940
AC		 3096
3097 pp_string (buffer, " : ");
3098
9e25c7ed
EB		 3099 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t))
3100 || TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE)
9cc54940 3101 {
9e25c7ed
EB		 3102 if (TYPE_NAME (TREE_TYPE (t))
3103 || TREE_CODE (TREE_TYPE (t)) != ENUMERAL_TYPE)
3104 pp_string (buffer, "aliased ");
9cc54940 3105
8c8b7be5 3106 if (TREE_READONLY (t) && TREE_CODE (t) != FIELD_DECL)
f4bcd9eb
EB		 3107 pp_string (buffer, "constant ");
3108
f07862c7 3109 if (TYPE_NAME (TREE_TYPE (t)))
e02f4b92 3110 dump_ada_node (buffer, TREE_TYPE (t), t, spc, false, true);
942047f2 3111 else if (type)
f07862c7 3112 dump_ada_double_name (buffer, type, t);
9cc54940
AC		 3113 }
3114 else
3115 {
3116 if (TREE_CODE (TREE_TYPE (t)) != POINTER_TYPE
3117 && (TYPE_NAME (TREE_TYPE (t))
3118 || TREE_CODE (TREE_TYPE (t)) != INTEGER_TYPE))
3119 pp_string (buffer, "aliased ");
3120
8c8b7be5 3121 if (TREE_READONLY (t) && TREE_CODE (t) != FIELD_DECL)
f4bcd9eb
EB		 3122 pp_string (buffer, "constant ");
3123
9e25c7ed 3124 dump_ada_node (buffer, TREE_TYPE (t), t, spc, false, true);
9cc54940
AC		 3125 }
3126 }
3127 }
3128
3129 if (is_class)
3130 {
2a877204 3131 spc -= INDENT_INCR;
9cc54940
AC		 3132 newline_and_indent (buffer, spc);
3133 pp_string (buffer, "end;");
3134 newline_and_indent (buffer, spc);
3135 pp_string (buffer, "use Class_");
e02f4b92 3136 dump_ada_node (buffer, t, type, spc, false, true);
9cc54940
AC		 3137 pp_semicolon (buffer);
3138 pp_newline (buffer);
3139
3140 /* All needed indentation/newline performed already, so return 0. */
3141 return 0;
3142 }
e730a0ef 3143 else if (is_var)
9cc54940 3144 {
e730a0ef 3145 pp_string (buffer, " -- ");
9cc54940 3146 dump_sloc (buffer, t);
e730a0ef
EB		 3147 newline_and_indent (buffer, spc);
3148 dump_ada_import (buffer, t, spc);
9cc54940
AC		 3149 }
3150
e730a0ef 3151 else
9cc54940 3152 {
e730a0ef
EB		 3153 pp_string (buffer, "; -- ");
3154 dump_sloc (buffer, t);
9cc54940
AC		 3155 }
3156
3157 return 1;
3158}
3159
e730a0ef
EB		 3160/* Dump in BUFFER a structure NODE of type TYPE in Ada syntax. If NESTED is
3161 true, it's an anonymous nested type. SPC is the indentation level. */
9cc54940
AC		 3162
3163static void
e730a0ef
EB		 3164dump_ada_structure (pretty_printer *buffer, tree node, tree type, bool nested,
3165 int spc)
9cc54940 3166{
f07862c7 3167 const bool is_union = (TREE_CODE (node) == UNION_TYPE);
b46dbc6c 3168 char buf[32];
9cc54940
AC		 3169 int field_num = 0;
3170 int field_spc = spc + INDENT_INCR;
3171 int need_semicolon;
3172
3173 bitfield_used = false;
3174
095d8d4b
EB		 3175 /* Print the contents of the structure. */
3176 pp_string (buffer, "record");
9cc54940 3177
095d8d4b
EB		 3178 if (is_union)
3179 {
3180 newline_and_indent (buffer, spc + INDENT_INCR);
3181 pp_string (buffer, "case discr is");
3182 field_spc = spc + INDENT_INCR * 3;
3183 }
9cc54940 3184
095d8d4b 3185 pp_newline (buffer);
9cc54940 3186
095d8d4b 3187 /* Print the non-static fields of the structure. */
9e25c7ed 3188 for (tree tmp = TYPE_FIELDS (node); tmp; tmp = TREE_CHAIN (tmp))
095d8d4b
EB		 3189 {
3190 /* Add parent field if needed. */
3191 if (!DECL_NAME (tmp))
9cc54940 3192 {
095d8d4b 3193 if (!is_tagged_type (TREE_TYPE (tmp)))
9cc54940 3194 {
095d8d4b
EB		 3195 if (!TYPE_NAME (TREE_TYPE (tmp)))
3196 dump_ada_declaration (buffer, tmp, type, field_spc);
3197 else
9cc54940 3198 {
095d8d4b
EB		 3199 INDENT (field_spc);
3200
3201 if (field_num == 0)
3202 pp_string (buffer, "parent : aliased ");
9cc54940
AC		 3203 else
3204 {
095d8d4b
EB		 3205 sprintf (buf, "field_%d : aliased ", field_num + 1);
3206 pp_string (buffer, buf);
9cc54940 3207 }
9e25c7ed
EB		 3208 dump_ada_decl_name (buffer, TYPE_NAME (TREE_TYPE (tmp)),
3209 false);
095d8d4b 3210 pp_semicolon (buffer);
9cc54940 3211 }
095d8d4b
EB		 3212
3213 pp_newline (buffer);
3214 field_num++;
9cc54940 3215 }
095d8d4b
EB		 3216 }
3217 else if (TREE_CODE (tmp) == FIELD_DECL)
3218 {
3219 /* Skip internal virtual table field. */
3220 if (!DECL_VIRTUAL_P (tmp))
9cc54940 3221 {
095d8d4b 3222 if (is_union)
9cc54940 3223 {
095d8d4b
EB		 3224 if (TREE_CHAIN (tmp)
3225 && TREE_TYPE (TREE_CHAIN (tmp)) != node
3226 && TREE_CODE (TREE_CHAIN (tmp)) != TYPE_DECL)
3227 sprintf (buf, "when %d =>", field_num);
3228 else
3229 sprintf (buf, "when others =>");
9cc54940 3230
095d8d4b
EB		 3231 INDENT (spc + INDENT_INCR * 2);
3232 pp_string (buffer, buf);
3233 pp_newline (buffer);
3234 }
9cc54940 3235
095d8d4b
EB		 3236 if (dump_ada_declaration (buffer, tmp, type, field_spc))
3237 {
3238 pp_newline (buffer);
3239 field_num++;
9cc54940
AC		 3240 }
3241 }
3242 }
095d8d4b 3243 }
9cc54940 3244
095d8d4b
EB		 3245 if (is_union)
3246 {
3247 INDENT (spc + INDENT_INCR);
3248 pp_string (buffer, "end case;");
3249 pp_newline (buffer);
3250 }
9cc54940 3251
095d8d4b
EB		 3252 if (field_num == 0)
3253 {
3254 INDENT (spc + INDENT_INCR);
3255 pp_string (buffer, "null;");
3256 pp_newline (buffer);
9cc54940 3257 }
095d8d4b
EB		 3258
3259 INDENT (spc);
e730a0ef 3260 pp_string (buffer, "end record");
9cc54940
AC		 3261
3262 newline_and_indent (buffer, spc);
3263
e730a0ef
EB		 3264 /* We disregard the methods for anonymous nested types. */
3265 if (nested)
9cc54940
AC		 3266 return;
3267
e730a0ef 3268 if (has_nontrivial_methods (node))
9cc54940 3269 {
e730a0ef
EB		 3270 pp_string (buffer, "with Import => True,");
3271 newline_and_indent (buffer, spc + 5);
3272 pp_string (buffer, "Convention => CPP");
9cc54940
AC		 3273 }
3274 else
e730a0ef 3275 pp_string (buffer, "with Convention => C_Pass_By_Copy");
9cc54940
AC		 3276
3277 if (is_union)
3278 {
e730a0ef
EB		 3279 pp_comma (buffer);
3280 newline_and_indent (buffer, spc + 5);
3281 pp_string (buffer, "Unchecked_Union => True");
9cc54940
AC		 3282 }
3283
3284 if (bitfield_used)
3285 {
e730a0ef
EB		 3286 pp_comma (buffer);
3287 newline_and_indent (buffer, spc + 5);
3288 pp_string (buffer, "Pack => True");
9cc54940
AC		 3289 bitfield_used = false;
3290 }
3291
79310774 3292 need_semicolon = !dump_ada_methods (buffer, node, spc);
9cc54940
AC		 3293
3294 /* Print the static fields of the structure, if any. */
9e25c7ed 3295 for (tree tmp = TYPE_FIELDS (node); tmp; tmp = TREE_CHAIN (tmp))
9cc54940 3296 {
b854df3c 3297 if (TREE_CODE (tmp) == VAR_DECL && DECL_NAME (tmp))
9cc54940
AC		 3298 {
3299 if (need_semicolon)
3300 {
3301 need_semicolon = false;
3302 pp_semicolon (buffer);
3303 }
3304 pp_newline (buffer);
3305 pp_newline (buffer);
79310774 3306 dump_ada_declaration (buffer, tmp, type, spc);
9cc54940
AC		 3307 }
3308 }
3309}
3310
3311/* Dump all the declarations in SOURCE_FILE to an Ada spec.
3312 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
94159ecf 3313 nodes for SOURCE_FILE. CHECK is used to perform C++ queries on nodes. */
9cc54940
AC		 3314
3315static void
3316dump_ads (const char *source_file,
3317 void (*collect_all_refs)(const char *),
621955cb 3318 int (*check)(tree, cpp_operation))
9cc54940
AC		 3319{
3320 char *ads_name;
3321 char *pkg_name;
3322 char *s;
3323 FILE *f;
3324
3325 pkg_name = get_ada_package (source_file);
3326
dd5a833e 3327 /* Construct the .ads filename and package name. */
9cc54940
AC		 3328 ads_name = xstrdup (pkg_name);
3329
3330 for (s = ads_name; *s; s++)
da5182be
TQ		 3331 if (*s == '.')
3332 *s = '-';
3333 else
3334 *s = TOLOWER (*s);
9cc54940
AC		 3335
3336 ads_name = reconcat (ads_name, ads_name, ".ads", NULL);
3337
3338 /* Write out the .ads file. */
3339 f = fopen (ads_name, "w");
3340 if (f)
3341 {
3342 pretty_printer pp;
3343
9cc54940
AC		 3344 pp_needs_newline (&pp) = true;
3345 pp.buffer->stream = f;
3346
3347 /* Dump all relevant macros. */
3348 dump_ada_macros (&pp, source_file);
3349
3350 /* Reset the table of withs for this file. */
3351 reset_ada_withs ();
3352
3353 (*collect_all_refs) (source_file);
3354
3355 /* Dump all references. */
94159ecf
EB		 3356 cpp_check = check;
3357 dump_ada_nodes (&pp, source_file);
9cc54940 3358
e730a0ef 3359 /* We require Ada 2012 syntax, so generate corresponding pragma.
c583af79 3360 Also, disable style checks since this file is auto-generated. */
e730a0ef 3361 fprintf (f, "pragma Ada_2012;\npragma Style_Checks (Off);\n\n");
c583af79 3362
9cc54940
AC		 3363 /* Dump withs. */
3364 dump_ada_withs (f);
3365
3366 fprintf (f, "\npackage %s is\n\n", pkg_name);
3367 pp_write_text_to_stream (&pp);
3368 /* ??? need to free pp */
3369 fprintf (f, "end %s;\n", pkg_name);
3370 fclose (f);
3371 }
3372
3373 free (ads_name);
3374 free (pkg_name);
3375}
3376
3377static const char **source_refs = NULL;
3378static int source_refs_used = 0;
3379static int source_refs_allocd = 0;
3380
3381/* Add an entry for FILENAME to the table SOURCE_REFS. */
3382
3383void
3384collect_source_ref (const char *filename)
3385{
3386 int i;
3387
3388 if (!filename)
3389 return;
3390
3391 if (source_refs_allocd == 0)
3392 {
3393 source_refs_allocd = 1024;
3394 source_refs = XNEWVEC (const char *, source_refs_allocd);
3395 }
3396
3397 for (i = 0; i < source_refs_used; i++)
0b07a57e 3398 if (filename == source_refs[i])
9cc54940
AC		 3399 return;
3400
3401 if (source_refs_used == source_refs_allocd)
3402 {
3403 source_refs_allocd *= 2;
3404 source_refs = XRESIZEVEC (const char *, source_refs, source_refs_allocd);
3405 }
3406
0b07a57e 3407 source_refs[source_refs_used++] = filename;
9cc54940
AC		 3408}
3409
3410/* Main entry point: dump all Ada specs corresponding to SOURCE_REFS
94159ecf 3411 using callbacks COLLECT_ALL_REFS and CHECK.
9cc54940
AC		 3412 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3413 nodes for a given source file.
94159ecf 3414 CHECK is used to perform C++ queries on nodes, or NULL for the C
9cc54940
AC		 3415 front-end. */
3416
3417void
3418dump_ada_specs (void (*collect_all_refs)(const char *),
621955cb 3419 int (*check)(tree, cpp_operation))
9cc54940 3420{
79310774
EB		 3421 /* Iterate over the list of files to dump specs for. */
3422 for (int i = 0; i < source_refs_used; i++)
94159ecf 3423 dump_ads (source_refs[i], collect_all_refs, check);
9cc54940 3424
6e3e8419 3425 /* Free various tables. */
9cc54940 3426 free (source_refs);
da193a27 3427 delete overloaded_names;
9cc54940 3428}
Mirror of https://gcc.gnu.org/git/gcc.git