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