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