[testsuite]
[official-gcc.git] / gcc / c-family / c-ada-spec.c
blob914ded9efc9a89f447f0010bb0b71e979ff52af1
1 /* Print GENERIC declaration (functions, variables, types) trees coming from
2 the C and C++ front-ends as well as macros in Ada syntax.
3 Copyright (C) 2010-2018 Free Software Foundation, Inc.
4 Adapted from tree-pretty-print.c by Arnaud Charlet <charlet@adacore.com>
6 This file is part of GCC.
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.
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.
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/>. */
22 #include "config.h"
23 #include "system.h"
24 #include "coretypes.h"
25 #include "tm.h"
26 #include "tree.h"
27 #include "c-ada-spec.h"
28 #include "fold-const.h"
29 #include "c-pragma.h"
30 #include "cpp-id-data.h"
31 #include "stringpool.h"
32 #include "attribs.h"
34 /* Local functions, macros and variables. */
35 static int dump_generic_ada_node (pretty_printer *, tree, tree, int, bool,
36 bool);
37 static int dump_ada_declaration (pretty_printer *, tree, tree, int);
38 static void dump_ada_struct_decl (pretty_printer *, tree, tree, int, bool);
39 static char *to_ada_name (const char *, unsigned int, bool *);
41 #define INDENT(SPACE) \
42 do { int i; for (i = 0; i<SPACE; i++) pp_space (buffer); } while (0)
44 #define INDENT_INCR 3
46 /* Global hook used to perform C++ queries on nodes. */
47 static int (*cpp_check) (tree, cpp_operation) = NULL;
49 /* Global variables used in macro-related callbacks. */
50 static int max_ada_macros;
51 static int store_ada_macro_index;
52 static const char *macro_source_file;
54 /* Given a cpp MACRO, compute the max length BUFFER_LEN of the macro, as well
55 as max length PARAM_LEN of arguments for fun_like macros, and also set
56 SUPPORTED to 0 if the macro cannot be mapped to an Ada construct. */
58 static void
59 macro_length (const cpp_macro *macro, int *supported, int *buffer_len,
60 int *param_len)
62 int i;
63 unsigned j;
65 *supported = 1;
66 *buffer_len = 0;
67 *param_len = 0;
69 if (macro->fun_like)
71 (*param_len)++;
72 for (i = 0; i < macro->paramc; i++)
74 cpp_hashnode *param = macro->params[i];
76 *param_len += NODE_LEN (param);
78 if (i + 1 < macro->paramc)
80 *param_len += 2; /* ", " */
82 else if (macro->variadic)
84 *supported = 0;
85 return;
88 *param_len += 2; /* ")\0" */
91 for (j = 0; j < macro->count; j++)
93 cpp_token *token = &macro->exp.tokens[j];
95 if (token->flags & PREV_WHITE)
96 (*buffer_len)++;
98 if (token->flags & STRINGIFY_ARG || token->flags & PASTE_LEFT)
100 *supported = 0;
101 return;
104 if (token->type == CPP_MACRO_ARG)
105 *buffer_len +=
106 NODE_LEN (macro->params[token->val.macro_arg.arg_no - 1]);
107 else
108 /* Include enough extra space to handle e.g. special characters. */
109 *buffer_len += (cpp_token_len (token) + 1) * 8;
112 (*buffer_len)++;
115 /* Dump all digits/hex chars from NUMBER to BUFFER and return a pointer
116 to the character after the last character written. If FLOAT_P is true,
117 this is a floating-point number. */
119 static unsigned char *
120 dump_number (unsigned char *number, unsigned char *buffer, bool float_p)
122 while (*number != '\0'
123 && *number != (float_p ? 'F' : 'U')
124 && *number != (float_p ? 'f' : 'u')
125 && *number != 'l'
126 && *number != 'L')
127 *buffer++ = *number++;
129 return buffer;
132 /* Handle escape character C and convert to an Ada character into BUFFER.
133 Return a pointer to the character after the last character written, or
134 NULL if the escape character is not supported. */
136 static unsigned char *
137 handle_escape_character (unsigned char *buffer, char c)
139 switch (c)
141 case '"':
142 *buffer++ = '"';
143 *buffer++ = '"';
144 break;
146 case 'n':
147 strcpy ((char *) buffer, "\" & ASCII.LF & \"");
148 buffer += 16;
149 break;
151 case 'r':
152 strcpy ((char *) buffer, "\" & ASCII.CR & \"");
153 buffer += 16;
154 break;
156 case 't':
157 strcpy ((char *) buffer, "\" & ASCII.HT & \"");
158 buffer += 16;
159 break;
161 default:
162 return NULL;
165 return buffer;
168 /* Callback used to count the number of macros from cpp_forall_identifiers.
169 PFILE and V are not used. NODE is the current macro to consider. */
171 static int
172 count_ada_macro (cpp_reader *pfile ATTRIBUTE_UNUSED, cpp_hashnode *node,
173 void *v ATTRIBUTE_UNUSED)
175 const cpp_macro *macro = node->value.macro;
177 if (node->type == NT_MACRO && !(node->flags & NODE_BUILTIN)
178 && macro->count
179 && *NODE_NAME (node) != '_'
180 && LOCATION_FILE (macro->line) == macro_source_file)
181 max_ada_macros++;
183 return 1;
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. */
190 static int
191 store_ada_macro (cpp_reader *pfile ATTRIBUTE_UNUSED,
192 cpp_hashnode *node, void *macros)
194 const cpp_macro *macro = node->value.macro;
196 if (node->type == NT_MACRO
197 && !(node->flags & NODE_BUILTIN)
198 && macro->count
199 && *NODE_NAME (node) != '_'
200 && LOCATION_FILE (macro->line) == macro_source_file)
201 ((cpp_hashnode **) macros)[store_ada_macro_index++] = node;
203 return 1;
206 /* Callback used to compare (during qsort) macros. NODE1 and NODE2 are the
207 two macro nodes to compare. */
209 static int
210 compare_macro (const void *node1, const void *node2)
212 typedef const cpp_hashnode *const_hnode;
214 const_hnode n1 = *(const const_hnode *) node1;
215 const_hnode n2 = *(const const_hnode *) node2;
217 return n1->value.macro->line - n2->value.macro->line;
220 /* Dump in PP all relevant macros appearing in FILE. */
222 static void
223 dump_ada_macros (pretty_printer *pp, const char* file)
225 int num_macros = 0, prev_line = -1;
226 cpp_hashnode **macros;
228 /* Initialize file-scope variables. */
229 max_ada_macros = 0;
230 store_ada_macro_index = 0;
231 macro_source_file = file;
233 /* Count all potentially relevant macros, and then sort them by sloc. */
234 cpp_forall_identifiers (parse_in, count_ada_macro, NULL);
235 macros = XALLOCAVEC (cpp_hashnode *, max_ada_macros);
236 cpp_forall_identifiers (parse_in, store_ada_macro, macros);
237 qsort (macros, max_ada_macros, sizeof (cpp_hashnode *), compare_macro);
239 for (int j = 0; j < max_ada_macros; j++)
241 cpp_hashnode *node = macros[j];
242 const cpp_macro *macro = node->value.macro;
243 unsigned i;
244 int supported = 1, prev_is_one = 0, buffer_len, param_len;
245 int is_string = 0, is_char = 0;
246 char *ada_name;
247 unsigned char *s, *params, *buffer, *buf_param, *char_one = NULL, *tmp;
249 macro_length (macro, &supported, &buffer_len, &param_len);
250 s = buffer = XALLOCAVEC (unsigned char, buffer_len);
251 params = buf_param = XALLOCAVEC (unsigned char, param_len);
253 if (supported)
255 if (macro->fun_like)
257 *buf_param++ = '(';
258 for (i = 0; i < macro->paramc; i++)
260 cpp_hashnode *param = macro->params[i];
262 memcpy (buf_param, NODE_NAME (param), NODE_LEN (param));
263 buf_param += NODE_LEN (param);
265 if (i + 1 < macro->paramc)
267 *buf_param++ = ',';
268 *buf_param++ = ' ';
270 else if (macro->variadic)
272 supported = 0;
273 break;
276 *buf_param++ = ')';
277 *buf_param = '\0';
280 for (i = 0; supported && i < macro->count; i++)
282 cpp_token *token = &macro->exp.tokens[i];
283 int is_one = 0;
285 if (token->flags & PREV_WHITE)
286 *buffer++ = ' ';
288 if (token->flags & STRINGIFY_ARG || token->flags & PASTE_LEFT)
290 supported = 0;
291 break;
294 switch (token->type)
296 case CPP_MACRO_ARG:
298 cpp_hashnode *param =
299 macro->params[token->val.macro_arg.arg_no - 1];
300 memcpy (buffer, NODE_NAME (param), NODE_LEN (param));
301 buffer += NODE_LEN (param);
303 break;
305 case CPP_EQ_EQ: *buffer++ = '='; break;
306 case CPP_GREATER: *buffer++ = '>'; break;
307 case CPP_LESS: *buffer++ = '<'; break;
308 case CPP_PLUS: *buffer++ = '+'; break;
309 case CPP_MINUS: *buffer++ = '-'; break;
310 case CPP_MULT: *buffer++ = '*'; break;
311 case CPP_DIV: *buffer++ = '/'; break;
312 case CPP_COMMA: *buffer++ = ','; break;
313 case CPP_OPEN_SQUARE:
314 case CPP_OPEN_PAREN: *buffer++ = '('; break;
315 case CPP_CLOSE_SQUARE: /* fallthrough */
316 case CPP_CLOSE_PAREN: *buffer++ = ')'; break;
317 case CPP_DEREF: /* fallthrough */
318 case CPP_SCOPE: /* fallthrough */
319 case CPP_DOT: *buffer++ = '.'; break;
321 case CPP_EQ: *buffer++ = ':'; *buffer++ = '='; break;
322 case CPP_NOT_EQ: *buffer++ = '/'; *buffer++ = '='; break;
323 case CPP_GREATER_EQ: *buffer++ = '>'; *buffer++ = '='; break;
324 case CPP_LESS_EQ: *buffer++ = '<'; *buffer++ = '='; break;
326 case CPP_NOT:
327 *buffer++ = 'n'; *buffer++ = 'o'; *buffer++ = 't'; break;
328 case CPP_MOD:
329 *buffer++ = 'm'; *buffer++ = 'o'; *buffer++ = 'd'; break;
330 case CPP_AND:
331 *buffer++ = 'a'; *buffer++ = 'n'; *buffer++ = 'd'; break;
332 case CPP_OR:
333 *buffer++ = 'o'; *buffer++ = 'r'; break;
334 case CPP_XOR:
335 *buffer++ = 'x'; *buffer++ = 'o'; *buffer++ = 'r'; break;
336 case CPP_AND_AND:
337 strcpy ((char *) buffer, " and then ");
338 buffer += 10;
339 break;
340 case CPP_OR_OR:
341 strcpy ((char *) buffer, " or else ");
342 buffer += 9;
343 break;
345 case CPP_PADDING:
346 *buffer++ = ' ';
347 is_one = prev_is_one;
348 break;
350 case CPP_COMMENT:
351 break;
353 case CPP_WSTRING:
354 case CPP_STRING16:
355 case CPP_STRING32:
356 case CPP_UTF8STRING:
357 case CPP_WCHAR:
358 case CPP_CHAR16:
359 case CPP_CHAR32:
360 case CPP_UTF8CHAR:
361 case CPP_NAME:
362 if (!macro->fun_like)
363 supported = 0;
364 else
365 buffer
366 = cpp_spell_token (parse_in, token, buffer, false);
367 break;
369 case CPP_STRING:
370 if (is_string)
372 *buffer++ = '&';
373 *buffer++ = ' ';
375 else
376 is_string = 1;
378 const unsigned char *s = token->val.str.text;
380 for (; *s; s++)
381 if (*s == '\\')
383 s++;
384 buffer = handle_escape_character (buffer, *s);
385 if (buffer == NULL)
387 supported = 0;
388 break;
391 else
392 *buffer++ = *s;
394 break;
396 case CPP_CHAR:
397 is_char = 1;
399 unsigned chars_seen;
400 int ignored;
401 cppchar_t c;
403 c = cpp_interpret_charconst (parse_in, token,
404 &chars_seen, &ignored);
405 if (c >= 32 && c <= 126)
407 *buffer++ = '\'';
408 *buffer++ = (char) c;
409 *buffer++ = '\'';
411 else
413 chars_seen = sprintf
414 ((char *) buffer, "Character'Val (%d)", (int) c);
415 buffer += chars_seen;
418 break;
420 case CPP_NUMBER:
421 tmp = cpp_token_as_text (parse_in, token);
423 switch (*tmp)
425 case '0':
426 switch (tmp[1])
428 case '\0':
429 case 'l':
430 case 'L':
431 case 'u':
432 case 'U':
433 *buffer++ = '0';
434 break;
436 case 'x':
437 case 'X':
438 *buffer++ = '1';
439 *buffer++ = '6';
440 *buffer++ = '#';
441 buffer = dump_number (tmp + 2, buffer, false);
442 *buffer++ = '#';
443 break;
445 case 'b':
446 case 'B':
447 *buffer++ = '2';
448 *buffer++ = '#';
449 buffer = dump_number (tmp + 2, buffer, false);
450 *buffer++ = '#';
451 break;
453 default:
454 /* Dump floating-point constant unmodified. */
455 if (strchr ((const char *)tmp, '.'))
456 buffer = dump_number (tmp, buffer, true);
457 else
459 *buffer++ = '8';
460 *buffer++ = '#';
461 buffer
462 = dump_number (tmp + 1, buffer, false);
463 *buffer++ = '#';
465 break;
467 break;
469 case '1':
470 if (tmp[1] == '\0'
471 || tmp[1] == 'u'
472 || tmp[1] == 'U'
473 || tmp[1] == 'l'
474 || tmp[1] == 'L')
476 is_one = 1;
477 char_one = buffer;
478 *buffer++ = '1';
479 break;
481 /* fallthrough */
483 default:
484 buffer
485 = dump_number (tmp, buffer,
486 strchr ((const char *)tmp, '.'));
487 break;
489 break;
491 case CPP_LSHIFT:
492 if (prev_is_one)
494 /* Replace "1 << N" by "2 ** N" */
495 *char_one = '2';
496 *buffer++ = '*';
497 *buffer++ = '*';
498 break;
500 /* fallthrough */
502 case CPP_RSHIFT:
503 case CPP_COMPL:
504 case CPP_QUERY:
505 case CPP_EOF:
506 case CPP_PLUS_EQ:
507 case CPP_MINUS_EQ:
508 case CPP_MULT_EQ:
509 case CPP_DIV_EQ:
510 case CPP_MOD_EQ:
511 case CPP_AND_EQ:
512 case CPP_OR_EQ:
513 case CPP_XOR_EQ:
514 case CPP_RSHIFT_EQ:
515 case CPP_LSHIFT_EQ:
516 case CPP_PRAGMA:
517 case CPP_PRAGMA_EOL:
518 case CPP_HASH:
519 case CPP_PASTE:
520 case CPP_OPEN_BRACE:
521 case CPP_CLOSE_BRACE:
522 case CPP_SEMICOLON:
523 case CPP_ELLIPSIS:
524 case CPP_PLUS_PLUS:
525 case CPP_MINUS_MINUS:
526 case CPP_DEREF_STAR:
527 case CPP_DOT_STAR:
528 case CPP_ATSIGN:
529 case CPP_HEADER_NAME:
530 case CPP_AT_NAME:
531 case CPP_OTHER:
532 case CPP_OBJC_STRING:
533 default:
534 if (!macro->fun_like)
535 supported = 0;
536 else
537 buffer = cpp_spell_token (parse_in, token, buffer, false);
538 break;
541 prev_is_one = is_one;
544 if (supported)
545 *buffer = '\0';
548 if (macro->fun_like && supported)
550 char *start = (char *) s;
551 int is_function = 0;
553 pp_string (pp, " -- arg-macro: ");
555 if (*start == '(' && buffer[-1] == ')')
557 start++;
558 buffer[-1] = '\0';
559 is_function = 1;
560 pp_string (pp, "function ");
562 else
564 pp_string (pp, "procedure ");
567 pp_string (pp, (const char *) NODE_NAME (node));
568 pp_space (pp);
569 pp_string (pp, (char *) params);
570 pp_newline (pp);
571 pp_string (pp, " -- ");
573 if (is_function)
575 pp_string (pp, "return ");
576 pp_string (pp, start);
577 pp_semicolon (pp);
579 else
580 pp_string (pp, start);
582 pp_newline (pp);
584 else if (supported)
586 expanded_location sloc = expand_location (macro->line);
588 if (sloc.line != prev_line + 1 && prev_line > 0)
589 pp_newline (pp);
591 num_macros++;
592 prev_line = sloc.line;
594 pp_string (pp, " ");
595 ada_name = to_ada_name ((const char *) NODE_NAME (node), 0, NULL);
596 pp_string (pp, ada_name);
597 free (ada_name);
598 pp_string (pp, " : ");
600 if (is_string)
601 pp_string (pp, "aliased constant String");
602 else if (is_char)
603 pp_string (pp, "aliased constant Character");
604 else
605 pp_string (pp, "constant");
607 pp_string (pp, " := ");
608 pp_string (pp, (char *) s);
610 if (is_string)
611 pp_string (pp, " & ASCII.NUL");
613 pp_string (pp, "; -- ");
614 pp_string (pp, sloc.file);
615 pp_colon (pp);
616 pp_scalar (pp, "%d", sloc.line);
617 pp_newline (pp);
619 else
621 pp_string (pp, " -- unsupported macro: ");
622 pp_string (pp, (const char *) cpp_macro_definition (parse_in, node));
623 pp_newline (pp);
627 if (num_macros > 0)
628 pp_newline (pp);
631 /* Current source file being handled. */
632 static const char *current_source_file;
634 /* Return sloc of DECL, using sloc of last field if LAST is true. */
636 location_t
637 decl_sloc (const_tree decl, bool last)
639 tree field;
641 /* Compare the declaration of struct-like types based on the sloc of their
642 last field (if LAST is true), so that more nested types collate before
643 less nested ones. */
644 if (TREE_CODE (decl) == TYPE_DECL
645 && !DECL_ORIGINAL_TYPE (decl)
646 && RECORD_OR_UNION_TYPE_P (TREE_TYPE (decl))
647 && (field = TYPE_FIELDS (TREE_TYPE (decl))))
649 if (last)
650 while (DECL_CHAIN (field))
651 field = DECL_CHAIN (field);
652 return DECL_SOURCE_LOCATION (field);
655 return DECL_SOURCE_LOCATION (decl);
658 /* Compare two locations LHS and RHS. */
660 static int
661 compare_location (location_t lhs, location_t rhs)
663 expanded_location xlhs = expand_location (lhs);
664 expanded_location xrhs = expand_location (rhs);
666 if (xlhs.file != xrhs.file)
667 return filename_cmp (xlhs.file, xrhs.file);
669 if (xlhs.line != xrhs.line)
670 return xlhs.line - xrhs.line;
672 if (xlhs.column != xrhs.column)
673 return xlhs.column - xrhs.column;
675 return 0;
678 /* Compare two declarations (LP and RP) by their source location. */
680 static int
681 compare_node (const void *lp, const void *rp)
683 const_tree lhs = *((const tree *) lp);
684 const_tree rhs = *((const tree *) rp);
686 return compare_location (decl_sloc (lhs, true), decl_sloc (rhs, true));
689 /* Compare two comments (LP and RP) by their source location. */
691 static int
692 compare_comment (const void *lp, const void *rp)
694 const cpp_comment *lhs = (const cpp_comment *) lp;
695 const cpp_comment *rhs = (const cpp_comment *) rp;
697 return compare_location (lhs->sloc, rhs->sloc);
700 static tree *to_dump = NULL;
701 static int to_dump_count = 0;
703 /* Collect a list of declarations from T relevant to SOURCE_FILE to be dumped
704 by a subsequent call to dump_ada_nodes. */
706 void
707 collect_ada_nodes (tree t, const char *source_file)
709 tree n;
710 int i = to_dump_count;
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_BUILTIN (n)
717 && TREE_CODE (n) != NAMESPACE_DECL
718 && LOCATION_FILE (decl_sloc (n, false)) == source_file)
719 to_dump_count++;
721 /* Allocate sufficient storage for all nodes. */
722 to_dump = XRESIZEVEC (tree, to_dump, to_dump_count);
724 /* Store the relevant nodes. */
725 for (n = t; n; n = TREE_CHAIN (n))
726 if (!DECL_IS_BUILTIN (n)
727 && TREE_CODE (n) != NAMESPACE_DECL
728 && LOCATION_FILE (decl_sloc (n, false)) == source_file)
729 to_dump[i++] = n;
732 /* Call back for walk_tree to clear the TREE_VISITED flag of TP. */
734 static tree
735 unmark_visited_r (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED,
736 void *data ATTRIBUTE_UNUSED)
738 if (TREE_VISITED (*tp))
739 TREE_VISITED (*tp) = 0;
740 else
741 *walk_subtrees = 0;
743 return NULL_TREE;
746 /* Print a COMMENT to the output stream PP. */
748 static void
749 print_comment (pretty_printer *pp, const char *comment)
751 int len = strlen (comment);
752 char *str = XALLOCAVEC (char, len + 1);
753 char *tok;
754 bool extra_newline = false;
756 memcpy (str, comment, len + 1);
758 /* Trim C/C++ comment indicators. */
759 if (str[len - 2] == '*' && str[len - 1] == '/')
761 str[len - 2] = ' ';
762 str[len - 1] = '\0';
764 str += 2;
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");
773 /* Leave a blank line after multi-line comments. */
774 if (tok)
775 extra_newline = true;
778 if (extra_newline)
779 pp_newline (pp);
782 /* Dump nodes into PP relevant to SOURCE_FILE, as collected by previous calls
783 to collect_ada_nodes. */
785 static void
786 dump_ada_nodes (pretty_printer *pp, const char *source_file)
788 int i, j;
789 cpp_comment_table *comments;
791 /* Sort the table of declarations to dump by sloc. */
792 qsort (to_dump, to_dump_count, sizeof (tree), compare_node);
794 /* Fetch the table of comments. */
795 comments = cpp_get_comments (parse_in);
797 /* Sort the comments table by sloc. */
798 if (comments->count > 1)
799 qsort (comments->entries, comments->count, sizeof (cpp_comment),
800 compare_comment);
802 /* Interleave comments and declarations in line number order. */
803 i = j = 0;
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++;
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++;
817 /* Write decls until decl i collates after comment j. */
818 while (i != to_dump_count)
820 if (j == comments->count
821 || LOCATION_LINE (decl_sloc (to_dump[i], false))
822 < LOCATION_LINE (comments->entries[j].sloc))
824 current_source_file = source_file;
826 if (dump_ada_declaration (pp, to_dump[i++], NULL_TREE,
827 INDENT_INCR))
829 pp_newline (pp);
830 pp_newline (pp);
833 else
834 break;
837 /* Write comment j, if there is one. */
838 if (j != comments->count)
839 print_comment (pp, comments->entries[j++].comment);
841 } while (i != to_dump_count || j != comments->count);
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);
847 /* Finalize the to_dump table. */
848 if (to_dump)
850 free (to_dump);
851 to_dump = NULL;
852 to_dump_count = 0;
856 /* Dump a newline and indent BUFFER by SPC chars. */
858 static void
859 newline_and_indent (pretty_printer *buffer, int spc)
861 pp_newline (buffer);
862 INDENT (spc);
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;
870 /* Record a "with" clause on package S (a limited with if LIMITED_ACCESS is
871 true), if not already done. */
873 static void
874 append_withs (const char *s, bool limited_access)
876 int i;
878 if (withs == NULL)
879 withs = XNEWVEC (struct with, withs_max);
881 if (with_len == withs_max)
883 withs_max *= 2;
884 withs = XRESIZEVEC (struct with, withs, withs_max);
887 for (i = 0; i < with_len; i++)
888 if (!strcmp (s, withs[i].s)
889 && current_source_file == withs[i].in_file)
891 withs[i].limited &= limited_access;
892 return;
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++;
901 /* Reset "with" clauses. */
903 static void
904 reset_ada_withs (void)
906 int i;
908 if (!withs)
909 return;
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;
919 /* Dump "with" clauses in F. */
921 static void
922 dump_ada_withs (FILE *f)
924 int i;
926 fprintf (f, "with Interfaces.C; use Interfaces.C;\n");
928 for (i = 0; i < with_len; i++)
929 fprintf
930 (f, "%swith %s;\n", withs[i].limited ? "limited " : "", withs[i].s);
933 /* Return suitable Ada package name from FILE. */
935 static char *
936 get_ada_package (const char *file)
938 const char *base;
939 char *res;
940 const char *s;
941 int i;
942 size_t plen;
944 s = strstr (file, "/include/");
945 if (s)
946 base = s + 9;
947 else
948 base = lbasename (file);
950 if (ada_specs_parent == NULL)
951 plen = 0;
952 else
953 plen = strlen (ada_specs_parent) + 1;
955 res = XNEWVEC (char, plen + strlen (base) + 1);
956 if (ada_specs_parent != NULL) {
957 strcpy (res, ada_specs_parent);
958 res[plen - 1] = '.';
961 for (i = plen; *base; base++, i++)
962 switch (*base)
964 case '+':
965 res[i] = 'p';
966 break;
968 case '.':
969 case '-':
970 case '_':
971 case '/':
972 case '\\':
973 res[i] = (i == 0 || res[i - 1] == '.' || res[i - 1] == '_') ? 'u' : '_';
974 break;
976 default:
977 res[i] = *base;
978 break;
980 res[i] = '\0';
982 return res;
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};
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",
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};
1015 /* Return a declaration tree corresponding to TYPE. */
1017 static tree
1018 get_underlying_decl (tree type)
1020 if (!type)
1021 return NULL_TREE;
1023 /* type is a declaration. */
1024 if (DECL_P (type))
1025 return type;
1027 /* type is a typedef. */
1028 if (TYPE_P (type) && TYPE_NAME (type) && DECL_P (TYPE_NAME (type)))
1029 return TYPE_NAME (type);
1031 /* TYPE_STUB_DECL has been set for type. */
1032 if (TYPE_P (type) && TYPE_STUB_DECL (type))
1033 return TYPE_STUB_DECL (type);
1035 return NULL_TREE;
1038 /* Return whether TYPE has static fields. */
1040 static bool
1041 has_static_fields (const_tree type)
1043 if (!type || !RECORD_OR_UNION_TYPE_P (type))
1044 return false;
1046 for (tree fld = TYPE_FIELDS (type); fld; fld = TREE_CHAIN (fld))
1047 if (TREE_CODE (fld) == VAR_DECL && DECL_NAME (fld))
1048 return true;
1050 return false;
1053 /* Return whether TYPE corresponds to an Ada tagged type (has a dispatch
1054 table). */
1056 static bool
1057 is_tagged_type (const_tree type)
1059 if (!type || !RECORD_OR_UNION_TYPE_P (type))
1060 return false;
1062 for (tree fld = TYPE_FIELDS (type); fld; fld = TREE_CHAIN (fld))
1063 if (TREE_CODE (fld) == FUNCTION_DECL && DECL_VINDEX (fld))
1064 return true;
1066 return false;
1069 /* Return whether TYPE has non-trivial methods, i.e. methods that do something
1070 for the objects of TYPE. In C++, all classes have implicit special methods,
1071 e.g. constructors and destructors, but they can be trivial if the type is
1072 sufficiently simple. */
1074 static bool
1075 has_nontrivial_methods (tree type)
1077 if (!type || !RECORD_OR_UNION_TYPE_P (type))
1078 return false;
1080 /* Only C++ types can have methods. */
1081 if (!cpp_check)
1082 return false;
1084 /* A non-trivial type has non-trivial special methods. */
1085 if (!cpp_check (type, IS_TRIVIAL))
1086 return true;
1088 /* If there are user-defined methods, they are deemed non-trivial. */
1089 for (tree fld = TYPE_FIELDS (type); fld; fld = DECL_CHAIN (fld))
1090 if (TREE_CODE (fld) == FUNCTION_DECL && !DECL_ARTIFICIAL (fld))
1091 return true;
1093 return false;
1096 #define INDEX_LENGTH 8
1098 /* Generate a legal Ada name from a C/C++ NAME and return a malloc'ed string.
1099 INDEX, if non-zero, is used to disambiguate overloaded names. SPACE_FOUND,
1100 if not NULL, is used to indicate whether a space was found in NAME. */
1102 static char *
1103 to_ada_name (const char *name, unsigned int index, bool *space_found)
1105 const char **names;
1106 const int len = strlen (name);
1107 int j, len2 = 0;
1108 bool found = false;
1109 char *s = XNEWVEC (char, len * 2 + 5 + (index ? INDEX_LENGTH : 0));
1110 char c;
1112 if (space_found)
1113 *space_found = false;
1115 /* Add "c_" prefix if name is an Ada reserved word. */
1116 for (names = ada_reserved; *names; names++)
1117 if (!strcasecmp (name, *names))
1119 s[len2++] = 'c';
1120 s[len2++] = '_';
1121 found = true;
1122 break;
1125 if (!found)
1126 /* Add "c_" prefix if name is a potential case sensitive duplicate. */
1127 for (names = c_duplicates; *names; names++)
1128 if (!strcmp (name, *names))
1130 s[len2++] = 'c';
1131 s[len2++] = '_';
1132 found = true;
1133 break;
1136 for (j = 0; name[j] == '_'; j++)
1137 s[len2++] = 'u';
1139 if (j > 0)
1140 s[len2++] = '_';
1141 else if (*name == '.' || *name == '$')
1143 s[0] = 'a';
1144 s[1] = 'n';
1145 s[2] = 'o';
1146 s[3] = 'n';
1147 len2 = 4;
1148 j++;
1151 /* Replace unsuitable characters for Ada identifiers. */
1152 for (; j < len; j++)
1153 switch (name[j])
1155 case ' ':
1156 if (space_found)
1157 *space_found = true;
1158 s[len2++] = '_';
1159 break;
1161 /* ??? missing some C++ operators. */
1162 case '=':
1163 s[len2++] = '_';
1165 if (name[j + 1] == '=')
1167 j++;
1168 s[len2++] = 'e';
1169 s[len2++] = 'q';
1171 else
1173 s[len2++] = 'a';
1174 s[len2++] = 's';
1176 break;
1178 case '!':
1179 s[len2++] = '_';
1180 if (name[j + 1] == '=')
1182 j++;
1183 s[len2++] = 'n';
1184 s[len2++] = 'e';
1186 break;
1188 case '~':
1189 s[len2++] = '_';
1190 s[len2++] = 't';
1191 s[len2++] = 'i';
1192 break;
1194 case '&':
1195 case '|':
1196 case '^':
1197 s[len2++] = '_';
1198 s[len2++] = name[j] == '&' ? 'a' : name[j] == '|' ? 'o' : 'x';
1200 if (name[j + 1] == '=')
1202 j++;
1203 s[len2++] = 'e';
1205 break;
1207 case '+':
1208 case '-':
1209 case '*':
1210 case '/':
1211 case '(':
1212 case '[':
1213 if (s[len2 - 1] != '_')
1214 s[len2++] = '_';
1216 switch (name[j + 1]) {
1217 case '\0':
1218 j++;
1219 switch (name[j - 1]) {
1220 case '+': s[len2++] = 'p'; break; /* + */
1221 case '-': s[len2++] = 'm'; break; /* - */
1222 case '*': s[len2++] = 't'; break; /* * */
1223 case '/': s[len2++] = 'd'; break; /* / */
1225 break;
1227 case '=':
1228 j++;
1229 switch (name[j - 1]) {
1230 case '+': s[len2++] = 'p'; break; /* += */
1231 case '-': s[len2++] = 'm'; break; /* -= */
1232 case '*': s[len2++] = 't'; break; /* *= */
1233 case '/': s[len2++] = 'd'; break; /* /= */
1235 s[len2++] = 'a';
1236 break;
1238 case '-': /* -- */
1239 j++;
1240 s[len2++] = 'm';
1241 s[len2++] = 'm';
1242 break;
1244 case '+': /* ++ */
1245 j++;
1246 s[len2++] = 'p';
1247 s[len2++] = 'p';
1248 break;
1250 case ')': /* () */
1251 j++;
1252 s[len2++] = 'o';
1253 s[len2++] = 'p';
1254 break;
1256 case ']': /* [] */
1257 j++;
1258 s[len2++] = 'o';
1259 s[len2++] = 'b';
1260 break;
1263 break;
1265 case '<':
1266 case '>':
1267 c = name[j] == '<' ? 'l' : 'g';
1268 s[len2++] = '_';
1270 switch (name[j + 1]) {
1271 case '\0':
1272 s[len2++] = c;
1273 s[len2++] = 't';
1274 break;
1275 case '=':
1276 j++;
1277 s[len2++] = c;
1278 s[len2++] = 'e';
1279 break;
1280 case '>':
1281 j++;
1282 s[len2++] = 's';
1283 s[len2++] = 'r';
1284 break;
1285 case '<':
1286 j++;
1287 s[len2++] = 's';
1288 s[len2++] = 'l';
1289 break;
1290 default:
1291 break;
1293 break;
1295 case '_':
1296 if (len2 && s[len2 - 1] == '_')
1297 s[len2++] = 'u';
1298 /* fall through */
1300 default:
1301 s[len2++] = name[j];
1304 if (s[len2 - 1] == '_')
1305 s[len2++] = 'u';
1307 if (index)
1308 snprintf (&s[len2], INDEX_LENGTH, "_u_%d", index + 1);
1309 else
1310 s[len2] = '\0';
1312 return s;
1315 /* Return true if DECL refers to a C++ class type for which a
1316 separate enclosing package has been or should be generated. */
1318 static bool
1319 separate_class_package (tree decl)
1321 tree type = TREE_TYPE (decl);
1322 return has_nontrivial_methods (type) || has_static_fields (type);
1325 static bool package_prefix = true;
1327 /* Dump in BUFFER the name of an identifier NODE of type TYPE, following Ada
1328 syntax. INDEX, if non-zero, is used to disambiguate overloaded names.
1329 LIMITED_ACCESS indicates whether NODE can be accessed via a limited
1330 'with' clause rather than a regular 'with' clause. */
1332 static void
1333 pp_ada_tree_identifier (pretty_printer *buffer, tree node, tree type,
1334 unsigned int index, bool limited_access)
1336 const char *name = IDENTIFIER_POINTER (node);
1337 bool space_found = false;
1338 char *s = to_ada_name (name, index, &space_found);
1339 tree decl = get_underlying_decl (type);
1341 /* If the entity comes from another file, generate a package prefix. */
1342 if (decl)
1344 expanded_location xloc = expand_location (decl_sloc (decl, false));
1346 if (xloc.file && xloc.line)
1348 if (xloc.file != current_source_file)
1350 switch (TREE_CODE (type))
1352 case ENUMERAL_TYPE:
1353 case INTEGER_TYPE:
1354 case REAL_TYPE:
1355 case FIXED_POINT_TYPE:
1356 case BOOLEAN_TYPE:
1357 case REFERENCE_TYPE:
1358 case POINTER_TYPE:
1359 case ARRAY_TYPE:
1360 case RECORD_TYPE:
1361 case UNION_TYPE:
1362 case TYPE_DECL:
1363 if (package_prefix)
1365 char *s1 = get_ada_package (xloc.file);
1366 append_withs (s1, limited_access);
1367 pp_string (buffer, s1);
1368 pp_dot (buffer);
1369 free (s1);
1371 break;
1372 default:
1373 break;
1376 /* Generate the additional package prefix for C++ classes. */
1377 if (separate_class_package (decl))
1379 pp_string (buffer, "Class_");
1380 pp_string (buffer, s);
1381 pp_dot (buffer);
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"))
1402 if (package_prefix)
1404 append_withs ("Interfaces.C.Extensions", false);
1405 pp_string (buffer, "Extensions.unsigned_long_long");
1407 else
1408 pp_string (buffer, "unsigned_long_long");
1410 else
1411 pp_string(buffer, s);
1412 else
1413 if (!strcmp (s, "bool"))
1415 if (package_prefix)
1417 append_withs ("Interfaces.C.Extensions", false);
1418 pp_string (buffer, "Extensions.bool");
1420 else
1421 pp_string (buffer, "bool");
1423 else
1424 pp_string(buffer, s);
1426 free (s);
1429 /* Dump in BUFFER the assembly name of T. */
1431 static void
1432 pp_asm_name (pretty_printer *buffer, tree t)
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);
1438 for (s = ada_name; *ident; ident++)
1440 if (*ident == ' ')
1441 break;
1442 else if (*ident != '*')
1443 *s++ = *ident;
1446 *s = '\0';
1447 pp_string (buffer, ada_name);
1450 /* Hash table of overloaded names associating identifier nodes with DECL_UIDs.
1451 It is needed in Ada 2005 because we can have at most one import directive
1452 per subprogram name in a given scope, so we have to mangle the subprogram
1453 names on the Ada side to import overloaded subprograms from C++. */
1455 struct overloaded_name_hash {
1456 hashval_t hash;
1457 tree name;
1458 tree context;
1459 vec<unsigned int> homonyms;
1462 struct overloaded_name_hasher : delete_ptr_hash<overloaded_name_hash>
1464 static inline hashval_t hash (overloaded_name_hash *t)
1465 { return t->hash; }
1466 static inline bool equal (overloaded_name_hash *a, overloaded_name_hash *b)
1467 { return a->name == b->name && a->context == b->context; }
1470 static hash_table<overloaded_name_hasher> *overloaded_names;
1472 /* Compute the overloading index of function DECL in its context. */
1474 static unsigned int
1475 compute_overloading_index (tree decl)
1477 const hashval_t hashcode
1478 = iterative_hash_hashval_t (htab_hash_pointer (DECL_NAME (decl)),
1479 htab_hash_pointer (DECL_CONTEXT (decl)));
1480 struct overloaded_name_hash in, *h, **slot;
1481 unsigned int index, *iter;
1483 if (!overloaded_names)
1484 overloaded_names = new hash_table<overloaded_name_hasher> (512);
1486 /* Look up the list of homonyms in the table. */
1487 in.hash = hashcode;
1488 in.name = DECL_NAME (decl);
1489 in.context = DECL_CONTEXT (decl);
1490 slot = overloaded_names->find_slot_with_hash (&in, hashcode, INSERT);
1491 if (*slot)
1492 h = *slot;
1493 else
1495 h = new overloaded_name_hash;
1496 h->hash = hashcode;
1497 h->name = DECL_NAME (decl);
1498 h->context = DECL_CONTEXT (decl);
1499 h->homonyms.create (0);
1500 *slot = h;
1503 /* Look up the function in the list of homonyms. */
1504 FOR_EACH_VEC_ELT (h->homonyms, index, iter)
1505 if (*iter == DECL_UID (decl))
1506 break;
1508 /* If it is not present, push it onto the list. */
1509 if (!iter)
1510 h->homonyms.safe_push (DECL_UID (decl));
1512 return index;
1515 /* Dump in BUFFER the name of a DECL node if set, following Ada syntax.
1516 LIMITED_ACCESS indicates whether NODE can be accessed via a limited
1517 'with' clause rather than a regular 'with' clause. */
1519 static void
1520 dump_ada_decl_name (pretty_printer *buffer, tree decl, bool limited_access)
1522 if (DECL_NAME (decl))
1524 const unsigned int index
1525 = (TREE_CODE (decl) == FUNCTION_DECL && cpp_check)
1526 ? compute_overloading_index (decl) : 0;
1527 pp_ada_tree_identifier (buffer, DECL_NAME (decl), decl, index,
1528 limited_access);
1530 else
1532 tree type_name = TYPE_NAME (TREE_TYPE (decl));
1534 if (!type_name)
1536 pp_string (buffer, "anon");
1537 if (TREE_CODE (decl) == FIELD_DECL)
1538 pp_scalar (buffer, "%d", DECL_UID (decl));
1539 else
1540 pp_scalar (buffer, "%d", TYPE_UID (TREE_TYPE (decl)));
1542 else if (TREE_CODE (type_name) == IDENTIFIER_NODE)
1543 pp_ada_tree_identifier (buffer, type_name, decl, 0, limited_access);
1547 /* Dump in BUFFER a name based on both T1 and T2 followed by a suffix. */
1549 static void
1550 dump_ada_double_name (pretty_printer *buffer, tree t1, tree t2)
1552 if (DECL_NAME (t1))
1553 pp_ada_tree_identifier (buffer, DECL_NAME (t1), t1, 0, false);
1554 else
1556 pp_string (buffer, "anon");
1557 pp_scalar (buffer, "%d", TYPE_UID (TREE_TYPE (t1)));
1560 pp_underscore (buffer);
1562 if (DECL_NAME (t2))
1563 pp_ada_tree_identifier (buffer, DECL_NAME (t2), t2, 0, false);
1564 else
1566 pp_string (buffer, "anon");
1567 pp_scalar (buffer, "%d", TYPE_UID (TREE_TYPE (t2)));
1570 switch (TREE_CODE (TREE_TYPE (t2)))
1572 case ARRAY_TYPE:
1573 pp_string (buffer, "_array");
1574 break;
1575 case RECORD_TYPE:
1576 pp_string (buffer, "_struct");
1577 break;
1578 case UNION_TYPE:
1579 pp_string (buffer, "_union");
1580 break;
1581 default:
1582 pp_string (buffer, "_unknown");
1583 break;
1587 /* Dump in BUFFER pragma Import C/CPP on a given node T. */
1589 static void
1590 dump_ada_import (pretty_printer *buffer, tree t)
1592 const char *name = IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (t));
1593 int is_stdcall = TREE_CODE (t) == FUNCTION_DECL &&
1594 lookup_attribute ("stdcall", TYPE_ATTRIBUTES (TREE_TYPE (t)));
1596 if (is_stdcall)
1597 pp_string (buffer, "pragma Import (Stdcall, ");
1598 else if (name[0] == '_' && name[1] == 'Z')
1599 pp_string (buffer, "pragma Import (CPP, ");
1600 else
1601 pp_string (buffer, "pragma Import (C, ");
1603 dump_ada_decl_name (buffer, t, false);
1604 pp_string (buffer, ", \"");
1606 if (is_stdcall)
1607 pp_string (buffer, IDENTIFIER_POINTER (DECL_NAME (t)));
1608 else
1609 pp_asm_name (buffer, t);
1611 pp_string (buffer, "\");");
1614 /* Check whether T and its type have different names, and append "the_"
1615 otherwise in BUFFER. */
1617 static void
1618 check_name (pretty_printer *buffer, tree t)
1620 const char *s;
1621 tree tmp = TREE_TYPE (t);
1623 while (TREE_CODE (tmp) == POINTER_TYPE && !TYPE_NAME (tmp))
1624 tmp = TREE_TYPE (tmp);
1626 if (TREE_CODE (tmp) != FUNCTION_TYPE)
1628 if (TREE_CODE (tmp) == IDENTIFIER_NODE)
1629 s = IDENTIFIER_POINTER (tmp);
1630 else if (!TYPE_NAME (tmp))
1631 s = "";
1632 else if (TREE_CODE (TYPE_NAME (tmp)) == IDENTIFIER_NODE)
1633 s = IDENTIFIER_POINTER (TYPE_NAME (tmp));
1634 else
1635 s = IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp)));
1637 if (!strcasecmp (IDENTIFIER_POINTER (DECL_NAME (t)), s))
1638 pp_string (buffer, "the_");
1642 /* Dump in BUFFER a function declaration FUNC with Ada syntax.
1643 IS_METHOD indicates whether FUNC is a C++ method.
1644 IS_CONSTRUCTOR whether FUNC is a C++ constructor.
1645 IS_DESTRUCTOR whether FUNC is a C++ destructor.
1646 SPC is the current indentation level. */
1648 static void
1649 dump_ada_function_declaration (pretty_printer *buffer, tree func,
1650 bool is_method, bool is_constructor,
1651 bool is_destructor, int spc)
1653 tree arg;
1654 const tree node = TREE_TYPE (func);
1655 char buf[17];
1656 int num = 0, num_args = 0, have_args = true, have_ellipsis = false;
1658 /* Compute number of arguments. */
1659 arg = TYPE_ARG_TYPES (node);
1661 if (arg)
1663 while (TREE_CHAIN (arg) && arg != error_mark_node)
1665 num_args++;
1666 arg = TREE_CHAIN (arg);
1669 if (TREE_CODE (TREE_VALUE (arg)) != VOID_TYPE)
1671 num_args++;
1672 have_ellipsis = true;
1676 if (is_constructor)
1677 num_args--;
1679 if (is_destructor)
1680 num_args = 1;
1682 if (num_args > 2)
1683 newline_and_indent (buffer, spc + 1);
1685 if (num_args > 0)
1687 pp_space (buffer);
1688 pp_left_paren (buffer);
1691 if (TREE_CODE (func) == FUNCTION_DECL)
1692 arg = DECL_ARGUMENTS (func);
1693 else
1694 arg = NULL_TREE;
1696 if (arg == NULL_TREE)
1698 have_args = false;
1699 arg = TYPE_ARG_TYPES (node);
1701 if (arg && TREE_CODE (TREE_VALUE (arg)) == VOID_TYPE)
1702 arg = NULL_TREE;
1705 if (is_constructor)
1706 arg = TREE_CHAIN (arg);
1708 /* Print the argument names (if available) & types. */
1710 for (num = 1; num <= num_args; num++)
1712 if (have_args)
1714 if (DECL_NAME (arg))
1716 check_name (buffer, arg);
1717 pp_ada_tree_identifier (buffer, DECL_NAME (arg), NULL_TREE, 0,
1718 false);
1719 pp_string (buffer, " : ");
1721 else
1723 sprintf (buf, "arg%d : ", num);
1724 pp_string (buffer, buf);
1727 dump_generic_ada_node (buffer, TREE_TYPE (arg), node, spc, 0, true);
1729 else
1731 sprintf (buf, "arg%d : ", num);
1732 pp_string (buffer, buf);
1733 dump_generic_ada_node (buffer, TREE_VALUE (arg), node, spc, 0, true);
1736 /* If the type is a pointer to a tagged type, we need to differentiate
1737 virtual methods from the rest (non-virtual methods, static member
1738 or regular functions) and import only them as primitive operations,
1739 because they make up the virtual table which is mirrored on the Ada
1740 side by the dispatch table. So we add 'Class to the type of every
1741 parameter that is not the first one of a method which either has a
1742 slot in the virtual table or is a constructor. */
1743 if (TREE_TYPE (arg)
1744 && POINTER_TYPE_P (TREE_TYPE (arg))
1745 && is_tagged_type (TREE_TYPE (TREE_TYPE (arg)))
1746 && !(num == 1 && is_method && (DECL_VINDEX (func) || is_constructor)))
1747 pp_string (buffer, "'Class");
1749 arg = TREE_CHAIN (arg);
1751 if (num < num_args)
1753 pp_semicolon (buffer);
1755 if (num_args > 2)
1756 newline_and_indent (buffer, spc + INDENT_INCR);
1757 else
1758 pp_space (buffer);
1762 if (have_ellipsis)
1764 pp_string (buffer, " -- , ...");
1765 newline_and_indent (buffer, spc + INDENT_INCR);
1768 if (num_args > 0)
1769 pp_right_paren (buffer);
1771 if (is_constructor || !VOID_TYPE_P (TREE_TYPE (node)))
1773 pp_string (buffer, " return ");
1774 tree type = is_constructor ? DECL_CONTEXT (func) : TREE_TYPE (node);
1775 dump_generic_ada_node (buffer, type, type, spc, false, true);
1779 /* Dump in BUFFER all the domains associated with an array NODE,
1780 using Ada syntax. SPC is the current indentation level. */
1782 static void
1783 dump_ada_array_domains (pretty_printer *buffer, tree node, int spc)
1785 int first = 1;
1786 pp_left_paren (buffer);
1788 for (; TREE_CODE (node) == ARRAY_TYPE; node = TREE_TYPE (node))
1790 tree domain = TYPE_DOMAIN (node);
1792 if (domain)
1794 tree min = TYPE_MIN_VALUE (domain);
1795 tree max = TYPE_MAX_VALUE (domain);
1797 if (!first)
1798 pp_string (buffer, ", ");
1799 first = 0;
1801 if (min)
1802 dump_generic_ada_node (buffer, min, NULL_TREE, spc, 0, true);
1803 pp_string (buffer, " .. ");
1805 /* If the upper bound is zero, gcc may generate a NULL_TREE
1806 for TYPE_MAX_VALUE rather than an integer_cst. */
1807 if (max)
1808 dump_generic_ada_node (buffer, max, NULL_TREE, spc, 0, true);
1809 else
1810 pp_string (buffer, "0");
1812 else
1813 pp_string (buffer, "size_t");
1815 pp_right_paren (buffer);
1818 /* Dump in BUFFER file:line information related to NODE. */
1820 static void
1821 dump_sloc (pretty_printer *buffer, tree node)
1823 expanded_location xloc;
1825 xloc.file = NULL;
1827 if (DECL_P (node))
1828 xloc = expand_location (DECL_SOURCE_LOCATION (node));
1829 else if (EXPR_HAS_LOCATION (node))
1830 xloc = expand_location (EXPR_LOCATION (node));
1832 if (xloc.file)
1834 pp_string (buffer, xloc.file);
1835 pp_colon (buffer);
1836 pp_decimal_int (buffer, xloc.line);
1840 /* Return true if T designates a one dimension array of "char". */
1842 static bool
1843 is_char_array (tree t)
1845 tree tmp;
1846 int num_dim = 0;
1848 /* Retrieve array's type. */
1849 tmp = t;
1850 while (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE)
1852 num_dim++;
1853 tmp = TREE_TYPE (tmp);
1856 tmp = TREE_TYPE (tmp);
1857 return num_dim == 1 && TREE_CODE (tmp) == INTEGER_TYPE
1858 && id_equal (DECL_NAME (TYPE_NAME (tmp)), "char");
1861 /* Dump in BUFFER an array type T in Ada syntax. Assume that the "type"
1862 keyword and name have already been printed. PARENT is the parent node of T.
1863 SPC is the indentation level. */
1865 static void
1866 dump_ada_array_type (pretty_printer *buffer, tree t, tree parent, int spc)
1868 const bool char_array = is_char_array (t);
1869 tree tmp;
1871 /* Special case char arrays. */
1872 if (char_array)
1874 pp_string (buffer, "Interfaces.C.char_array ");
1876 else
1877 pp_string (buffer, "array ");
1879 /* Print the dimensions. */
1880 dump_ada_array_domains (buffer, TREE_TYPE (t), spc);
1882 /* Retrieve the element type. */
1883 tmp = TREE_TYPE (t);
1884 while (TREE_CODE (tmp) == ARRAY_TYPE)
1885 tmp = TREE_TYPE (tmp);
1887 /* Print array's type. */
1888 if (!char_array)
1890 pp_string (buffer, " of ");
1892 if (TREE_CODE (tmp) != POINTER_TYPE)
1893 pp_string (buffer, "aliased ");
1895 if (TYPE_NAME (tmp) || !RECORD_OR_UNION_TYPE_P (tmp))
1896 dump_generic_ada_node (buffer, tmp, TREE_TYPE (t), spc, false, true);
1897 else
1898 dump_ada_double_name (buffer, parent, get_underlying_decl (tmp));
1902 /* Dump in BUFFER type names associated with a template, each prepended with
1903 '_'. TYPES is the TREE_PURPOSE of a DECL_TEMPLATE_INSTANTIATIONS. SPC is
1904 the indentation level. */
1906 static void
1907 dump_template_types (pretty_printer *buffer, tree types, int spc)
1909 size_t i;
1910 size_t len = TREE_VEC_LENGTH (types);
1912 for (i = 0; i < len; i++)
1914 tree elem = TREE_VEC_ELT (types, i);
1915 pp_underscore (buffer);
1916 if (!dump_generic_ada_node (buffer, elem, 0, spc, false, true))
1918 pp_string (buffer, "unknown");
1919 pp_scalar (buffer, "%lu", (unsigned long) TREE_HASH (elem));
1924 /* Dump in BUFFER the contents of all class instantiations associated with
1925 a given template T. SPC is the indentation level. */
1927 static int
1928 dump_ada_template (pretty_printer *buffer, tree t, int spc)
1930 /* DECL_SIZE_UNIT is DECL_TEMPLATE_INSTANTIATIONS in this context. */
1931 tree inst = DECL_SIZE_UNIT (t);
1932 /* This emulates DECL_TEMPLATE_RESULT in this context. */
1933 struct tree_template_decl {
1934 struct tree_decl_common common;
1935 tree arguments;
1936 tree result;
1938 tree result = ((struct tree_template_decl *) t)->result;
1939 int num_inst = 0;
1941 /* Don't look at template declarations declaring something coming from
1942 another file. This can occur for template friend declarations. */
1943 if (LOCATION_FILE (decl_sloc (result, false))
1944 != LOCATION_FILE (decl_sloc (t, false)))
1945 return 0;
1947 for (; inst && inst != error_mark_node; inst = TREE_CHAIN (inst))
1949 tree types = TREE_PURPOSE (inst);
1950 tree instance = TREE_VALUE (inst);
1952 if (TREE_VEC_LENGTH (types) == 0)
1953 break;
1955 if (!RECORD_OR_UNION_TYPE_P (instance))
1956 break;
1958 /* We are interested in concrete template instantiations only: skip
1959 partially specialized nodes. */
1960 if (RECORD_OR_UNION_TYPE_P (instance)
1961 && cpp_check
1962 && cpp_check (instance, HAS_DEPENDENT_TEMPLATE_ARGS))
1963 continue;
1965 num_inst++;
1966 INDENT (spc);
1967 pp_string (buffer, "package ");
1968 package_prefix = false;
1969 dump_generic_ada_node (buffer, instance, t, spc, false, true);
1970 dump_template_types (buffer, types, spc);
1971 pp_string (buffer, " is");
1972 spc += INDENT_INCR;
1973 newline_and_indent (buffer, spc);
1975 TREE_VISITED (get_underlying_decl (instance)) = 1;
1976 pp_string (buffer, "type ");
1977 dump_generic_ada_node (buffer, instance, t, spc, false, true);
1978 package_prefix = true;
1980 if (is_tagged_type (instance))
1981 pp_string (buffer, " is tagged limited ");
1982 else
1983 pp_string (buffer, " is limited ");
1985 dump_generic_ada_node (buffer, instance, t, spc, false, false);
1986 pp_newline (buffer);
1987 spc -= INDENT_INCR;
1988 newline_and_indent (buffer, spc);
1990 pp_string (buffer, "end;");
1991 newline_and_indent (buffer, spc);
1992 pp_string (buffer, "use ");
1993 package_prefix = false;
1994 dump_generic_ada_node (buffer, instance, t, spc, false, true);
1995 dump_template_types (buffer, types, spc);
1996 package_prefix = true;
1997 pp_semicolon (buffer);
1998 pp_newline (buffer);
1999 pp_newline (buffer);
2002 return num_inst > 0;
2005 /* Return true if NODE is a simple enum types, that can be mapped to an
2006 Ada enum type directly. */
2008 static bool
2009 is_simple_enum (tree node)
2011 HOST_WIDE_INT count = 0;
2012 tree value;
2014 for (value = TYPE_VALUES (node); value; value = TREE_CHAIN (value))
2016 tree int_val = TREE_VALUE (value);
2018 if (TREE_CODE (int_val) != INTEGER_CST)
2019 int_val = DECL_INITIAL (int_val);
2021 if (!tree_fits_shwi_p (int_val))
2022 return false;
2023 else if (tree_to_shwi (int_val) != count)
2024 return false;
2026 count++;
2029 return true;
2032 static bool bitfield_used = false;
2034 /* Recursively dump in BUFFER Ada declarations corresponding to NODE of type
2035 TYPE. SPC is the indentation level. LIMITED_ACCESS indicates whether NODE
2036 can be referenced via a "limited with" clause. NAME_ONLY indicates whether
2037 we should only dump the name of NODE, instead of its full declaration. */
2039 static int
2040 dump_generic_ada_node (pretty_printer *buffer, tree node, tree type, int spc,
2041 bool limited_access, bool name_only)
2043 if (node == NULL_TREE)
2044 return 0;
2046 switch (TREE_CODE (node))
2048 case ERROR_MARK:
2049 pp_string (buffer, "<<< error >>>");
2050 return 0;
2052 case IDENTIFIER_NODE:
2053 pp_ada_tree_identifier (buffer, node, type, 0, limited_access);
2054 break;
2056 case TREE_LIST:
2057 pp_string (buffer, "--- unexpected node: TREE_LIST");
2058 return 0;
2060 case TREE_BINFO:
2061 dump_generic_ada_node
2062 (buffer, BINFO_TYPE (node), type, spc, limited_access, name_only);
2063 return 0;
2065 case TREE_VEC:
2066 pp_string (buffer, "--- unexpected node: TREE_VEC");
2067 return 0;
2069 case VOID_TYPE:
2070 if (package_prefix)
2072 append_withs ("System", false);
2073 pp_string (buffer, "System.Address");
2075 else
2076 pp_string (buffer, "address");
2077 break;
2079 case VECTOR_TYPE:
2080 pp_string (buffer, "<vector>");
2081 break;
2083 case COMPLEX_TYPE:
2084 pp_string (buffer, "<complex>");
2085 break;
2087 case ENUMERAL_TYPE:
2088 if (name_only)
2089 dump_generic_ada_node (buffer, TYPE_NAME (node), node, spc, 0, true);
2090 else
2092 tree value = TYPE_VALUES (node);
2094 if (is_simple_enum (node))
2096 bool first = true;
2097 spc += INDENT_INCR;
2098 newline_and_indent (buffer, spc - 1);
2099 pp_left_paren (buffer);
2100 for (; value; value = TREE_CHAIN (value))
2102 if (first)
2103 first = false;
2104 else
2106 pp_comma (buffer);
2107 newline_and_indent (buffer, spc);
2110 pp_ada_tree_identifier (buffer, TREE_PURPOSE (value), node,
2111 0, false);
2113 pp_string (buffer, ");");
2114 spc -= INDENT_INCR;
2115 newline_and_indent (buffer, spc);
2116 pp_string (buffer, "pragma Convention (C, ");
2117 dump_generic_ada_node
2118 (buffer, DECL_NAME (type) ? type : TYPE_NAME (node), type,
2119 spc, 0, true);
2120 pp_right_paren (buffer);
2122 else
2124 if (TYPE_UNSIGNED (node))
2125 pp_string (buffer, "unsigned");
2126 else
2127 pp_string (buffer, "int");
2128 for (; value; value = TREE_CHAIN (value))
2130 pp_semicolon (buffer);
2131 newline_and_indent (buffer, spc);
2133 pp_ada_tree_identifier (buffer, TREE_PURPOSE (value), node,
2134 0, false);
2135 pp_string (buffer, " : constant ");
2137 dump_generic_ada_node
2138 (buffer, DECL_NAME (type) ? type : TYPE_NAME (node), type,
2139 spc, 0, true);
2141 pp_string (buffer, " := ");
2142 dump_generic_ada_node
2143 (buffer,
2144 TREE_CODE (TREE_VALUE (value)) == INTEGER_CST ?
2145 TREE_VALUE (value) : DECL_INITIAL (TREE_VALUE (value)),
2146 node, spc, false, true);
2150 break;
2152 case INTEGER_TYPE:
2153 case REAL_TYPE:
2154 case FIXED_POINT_TYPE:
2155 case BOOLEAN_TYPE:
2157 enum tree_code_class tclass;
2159 tclass = TREE_CODE_CLASS (TREE_CODE (node));
2161 if (tclass == tcc_declaration)
2163 if (DECL_NAME (node))
2164 pp_ada_tree_identifier (buffer, DECL_NAME (node), NULL_TREE, 0,
2165 limited_access);
2166 else
2167 pp_string (buffer, "<unnamed type decl>");
2169 else if (tclass == tcc_type)
2171 if (TYPE_NAME (node))
2173 if (TREE_CODE (TYPE_NAME (node)) == IDENTIFIER_NODE)
2174 pp_ada_tree_identifier (buffer, TYPE_NAME (node), node, 0,
2175 limited_access);
2176 else if (TREE_CODE (TYPE_NAME (node)) == TYPE_DECL
2177 && DECL_NAME (TYPE_NAME (node)))
2178 dump_ada_decl_name (buffer, TYPE_NAME (node), limited_access);
2179 else
2180 pp_string (buffer, "<unnamed type>");
2182 else if (TREE_CODE (node) == INTEGER_TYPE)
2184 append_withs ("Interfaces.C.Extensions", false);
2185 bitfield_used = true;
2187 if (TYPE_PRECISION (node) == 1)
2188 pp_string (buffer, "Extensions.Unsigned_1");
2189 else
2191 pp_string (buffer, (TYPE_UNSIGNED (node)
2192 ? "Extensions.Unsigned_"
2193 : "Extensions.Signed_"));
2194 pp_decimal_int (buffer, TYPE_PRECISION (node));
2197 else
2198 pp_string (buffer, "<unnamed type>");
2200 break;
2203 case POINTER_TYPE:
2204 case REFERENCE_TYPE:
2205 if (name_only && TYPE_NAME (node))
2206 dump_generic_ada_node
2207 (buffer, TYPE_NAME (node), node, spc, limited_access, true);
2209 else if (TREE_CODE (TREE_TYPE (node)) == FUNCTION_TYPE)
2211 if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (node))))
2212 pp_string (buffer, "access procedure ");
2213 else
2214 pp_string (buffer, "access function ");
2216 dump_ada_function_declaration
2217 (buffer, node, false, false, false, spc + INDENT_INCR);
2219 /* If we are dumping the full type, it means we are part of a
2220 type definition and need also a Convention C pragma. */
2221 if (!name_only)
2223 pp_semicolon (buffer);
2224 newline_and_indent (buffer, spc);
2225 pp_string (buffer, "pragma Convention (C, ");
2226 dump_generic_ada_node (buffer, type, 0, spc, false, true);
2227 pp_right_paren (buffer);
2230 else
2232 int is_access = false;
2233 unsigned int quals = TYPE_QUALS (TREE_TYPE (node));
2235 if (VOID_TYPE_P (TREE_TYPE (node)))
2237 if (!name_only)
2238 pp_string (buffer, "new ");
2239 if (package_prefix)
2241 append_withs ("System", false);
2242 pp_string (buffer, "System.Address");
2244 else
2245 pp_string (buffer, "address");
2247 else
2249 if (TREE_CODE (node) == POINTER_TYPE
2250 && TREE_CODE (TREE_TYPE (node)) == INTEGER_TYPE
2251 && !strcmp
2252 (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME
2253 (TREE_TYPE (node)))), "char"))
2255 if (!name_only)
2256 pp_string (buffer, "new ");
2258 if (package_prefix)
2260 pp_string (buffer, "Interfaces.C.Strings.chars_ptr");
2261 append_withs ("Interfaces.C.Strings", false);
2263 else
2264 pp_string (buffer, "chars_ptr");
2266 else
2268 tree type_name = TYPE_NAME (TREE_TYPE (node));
2269 tree decl = get_underlying_decl (TREE_TYPE (node));
2270 tree enclosing_decl = get_underlying_decl (type);
2272 /* For now, handle access-to-access, access-to-empty-struct
2273 or access-to-incomplete as opaque system.address. */
2274 if (TREE_CODE (TREE_TYPE (node)) == POINTER_TYPE
2275 || (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node))
2276 && !TYPE_FIELDS (TREE_TYPE (node)))
2277 || !decl
2278 || (!enclosing_decl
2279 && !TREE_VISITED (decl)
2280 && DECL_SOURCE_FILE (decl) == current_source_file)
2281 || (enclosing_decl
2282 && !TREE_VISITED (decl)
2283 && DECL_SOURCE_FILE (decl)
2284 == DECL_SOURCE_FILE (enclosing_decl)
2285 && decl_sloc (decl, true)
2286 > decl_sloc (enclosing_decl, true)))
2288 if (package_prefix)
2290 append_withs ("System", false);
2291 if (!name_only)
2292 pp_string (buffer, "new ");
2293 pp_string (buffer, "System.Address");
2295 else
2296 pp_string (buffer, "address");
2297 return spc;
2300 if (!package_prefix)
2301 pp_string (buffer, "access");
2302 else if (AGGREGATE_TYPE_P (TREE_TYPE (node)))
2304 if (!type || TREE_CODE (type) != FUNCTION_DECL)
2306 pp_string (buffer, "access ");
2307 is_access = true;
2309 if (quals & TYPE_QUAL_CONST)
2310 pp_string (buffer, "constant ");
2311 else if (!name_only)
2312 pp_string (buffer, "all ");
2314 else if (quals & TYPE_QUAL_CONST)
2315 pp_string (buffer, "in ");
2316 else
2318 is_access = true;
2319 pp_string (buffer, "access ");
2320 /* ??? should be configurable: access or in out. */
2323 else
2325 is_access = true;
2326 pp_string (buffer, "access ");
2328 if (!name_only)
2329 pp_string (buffer, "all ");
2332 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node)) && type_name)
2333 dump_generic_ada_node (buffer, type_name, TREE_TYPE (node),
2334 spc, is_access, true);
2335 else
2336 dump_generic_ada_node (buffer, TREE_TYPE (node),
2337 TREE_TYPE (node), spc, 0, true);
2341 break;
2343 case ARRAY_TYPE:
2344 if (name_only)
2345 dump_generic_ada_node
2346 (buffer, TYPE_NAME (node), node, spc, limited_access, true);
2347 else
2348 dump_ada_array_type (buffer, node, type, spc);
2349 break;
2351 case RECORD_TYPE:
2352 case UNION_TYPE:
2353 if (name_only)
2355 if (TYPE_NAME (node))
2356 dump_generic_ada_node
2357 (buffer, TYPE_NAME (node), node, spc, limited_access, true);
2358 else
2360 pp_string (buffer, "anon_");
2361 pp_scalar (buffer, "%d", TYPE_UID (node));
2364 else
2365 dump_ada_struct_decl (buffer, node, type, spc, true);
2366 break;
2368 case INTEGER_CST:
2369 /* We treat the upper half of the sizetype range as negative. This
2370 is consistent with the internal treatment and makes it possible
2371 to generate the (0 .. -1) range for flexible array members. */
2372 if (TREE_TYPE (node) == sizetype)
2373 node = fold_convert (ssizetype, node);
2374 if (tree_fits_shwi_p (node))
2375 pp_wide_integer (buffer, tree_to_shwi (node));
2376 else if (tree_fits_uhwi_p (node))
2377 pp_unsigned_wide_integer (buffer, tree_to_uhwi (node));
2378 else
2380 wide_int val = wi::to_wide (node);
2381 int i;
2382 if (wi::neg_p (val))
2384 pp_minus (buffer);
2385 val = -val;
2387 sprintf (pp_buffer (buffer)->digit_buffer,
2388 "16#%" HOST_WIDE_INT_PRINT "x",
2389 val.elt (val.get_len () - 1));
2390 for (i = val.get_len () - 2; i >= 0; i--)
2391 sprintf (pp_buffer (buffer)->digit_buffer,
2392 HOST_WIDE_INT_PRINT_PADDED_HEX, val.elt (i));
2393 pp_string (buffer, pp_buffer (buffer)->digit_buffer);
2395 break;
2397 case REAL_CST:
2398 case FIXED_CST:
2399 case COMPLEX_CST:
2400 case STRING_CST:
2401 case VECTOR_CST:
2402 return 0;
2404 case TYPE_DECL:
2405 if (DECL_IS_BUILTIN (node))
2407 /* Don't print the declaration of built-in types. */
2409 if (name_only)
2411 /* If we're in the middle of a declaration, defaults to
2412 System.Address. */
2413 if (package_prefix)
2415 append_withs ("System", false);
2416 pp_string (buffer, "System.Address");
2418 else
2419 pp_string (buffer, "address");
2421 break;
2424 if (name_only)
2425 dump_ada_decl_name (buffer, node, limited_access);
2426 else
2428 if (is_tagged_type (TREE_TYPE (node)))
2430 int first = 1;
2432 /* Look for ancestors. */
2433 for (tree fld = TYPE_FIELDS (TREE_TYPE (node));
2434 fld;
2435 fld = TREE_CHAIN (fld))
2437 if (!DECL_NAME (fld) && is_tagged_type (TREE_TYPE (fld)))
2439 if (first)
2441 pp_string (buffer, "limited new ");
2442 first = 0;
2444 else
2445 pp_string (buffer, " and ");
2447 dump_ada_decl_name (buffer, TYPE_NAME (TREE_TYPE (fld)),
2448 false);
2452 pp_string (buffer, first ? "tagged limited " : " with ");
2454 else if (has_nontrivial_methods (TREE_TYPE (node)))
2455 pp_string (buffer, "limited ");
2457 dump_generic_ada_node
2458 (buffer, TREE_TYPE (node), type, spc, false, false);
2460 break;
2462 case FUNCTION_DECL:
2463 case CONST_DECL:
2464 case VAR_DECL:
2465 case PARM_DECL:
2466 case FIELD_DECL:
2467 case NAMESPACE_DECL:
2468 dump_ada_decl_name (buffer, node, false);
2469 break;
2471 default:
2472 /* Ignore other nodes (e.g. expressions). */
2473 return 0;
2476 return 1;
2479 /* Dump in BUFFER NODE's methods. SPC is the indentation level. Return 1 if
2480 methods were printed, 0 otherwise. */
2482 static int
2483 dump_ada_methods (pretty_printer *buffer, tree node, int spc)
2485 if (!has_nontrivial_methods (node))
2486 return 0;
2488 pp_semicolon (buffer);
2490 int res = 1;
2491 for (tree fld = TYPE_FIELDS (node); fld; fld = DECL_CHAIN (fld))
2492 if (TREE_CODE (fld) == FUNCTION_DECL)
2494 if (res)
2496 pp_newline (buffer);
2497 pp_newline (buffer);
2500 res = dump_ada_declaration (buffer, fld, node, spc);
2503 return 1;
2506 static void dump_nested_type (pretty_printer *, tree, tree, tree, int);
2508 /* Dump in BUFFER anonymous types nested inside T's definition.
2509 PARENT is the parent node of T.
2510 FORWARD indicates whether a forward declaration of T should be generated.
2511 SPC is the indentation level.
2513 In C anonymous nested tagged types have no name whereas in C++ they have
2514 one. In C their TYPE_DECL is at top level whereas in C++ it is nested.
2515 In both languages untagged types (pointers and arrays) have no name.
2516 In C++ the nested TYPE_DECLs can come after their associated FIELD_DECL.
2518 Therefore, in order to have a common processing for both languages, we
2519 disregard anonymous TYPE_DECLs at top level and here we make a first
2520 pass on the nested TYPE_DECLs and a second pass on the unnamed types. */
2522 static void
2523 dump_nested_types (pretty_printer *buffer, tree t, tree parent, bool forward,
2524 int spc)
2526 tree type, field;
2528 /* Avoid recursing over the same tree. */
2529 if (TREE_VISITED (t))
2530 return;
2532 /* Find possible anonymous pointers/arrays/structs/unions recursively. */
2533 type = TREE_TYPE (t);
2534 if (type == NULL_TREE)
2535 return;
2537 if (forward)
2539 pp_string (buffer, "type ");
2540 dump_generic_ada_node (buffer, t, t, spc, false, true);
2541 pp_semicolon (buffer);
2542 newline_and_indent (buffer, spc);
2543 TREE_VISITED (t) = 1;
2546 for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
2547 if (TREE_CODE (field) == TYPE_DECL
2548 && DECL_NAME (field) != DECL_NAME (t)
2549 && TYPE_NAME (TREE_TYPE (field)) != TYPE_NAME (type))
2550 dump_nested_type (buffer, field, t, parent, spc);
2552 for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
2553 if (TREE_CODE (field) == FIELD_DECL && !TYPE_NAME (TREE_TYPE (field)))
2554 dump_nested_type (buffer, field, t, parent, spc);
2556 TREE_VISITED (t) = 1;
2559 /* Dump in BUFFER the anonymous type of FIELD inside T.
2560 PARENT is the parent node of T.
2561 FORWARD indicates whether a forward declaration of T should be generated.
2562 SPC is the indentation level. */
2564 static void
2565 dump_nested_type (pretty_printer *buffer, tree field, tree t, tree parent,
2566 int spc)
2568 tree field_type = TREE_TYPE (field);
2569 tree decl, tmp;
2571 switch (TREE_CODE (field_type))
2573 case POINTER_TYPE:
2574 tmp = TREE_TYPE (field_type);
2576 if (TREE_CODE (tmp) == FUNCTION_TYPE)
2577 for (tmp = TREE_TYPE (tmp);
2578 tmp && TREE_CODE (tmp) == POINTER_TYPE;
2579 tmp = TREE_TYPE (tmp))
2582 decl = get_underlying_decl (tmp);
2583 if (decl
2584 && !DECL_IS_BUILTIN (decl)
2585 && (!RECORD_OR_UNION_TYPE_P (TREE_TYPE (decl))
2586 || TYPE_FIELDS (TREE_TYPE (decl)))
2587 && !TREE_VISITED (decl)
2588 && DECL_SOURCE_FILE (decl) == DECL_SOURCE_FILE (t)
2589 && decl_sloc (decl, true) > decl_sloc (t, true))
2591 /* Generate forward declaration. */
2592 pp_string (buffer, "type ");
2593 dump_generic_ada_node (buffer, decl, 0, spc, false, true);
2594 pp_semicolon (buffer);
2595 newline_and_indent (buffer, spc);
2596 TREE_VISITED (decl) = 1;
2598 break;
2600 case ARRAY_TYPE:
2601 tmp = TREE_TYPE (field_type);
2602 while (TREE_CODE (tmp) == ARRAY_TYPE)
2603 tmp = TREE_TYPE (tmp);
2604 decl = get_underlying_decl (tmp);
2605 if (decl && !DECL_NAME (decl) && !TREE_VISITED (decl))
2607 /* Generate full declaration. */
2608 dump_nested_type (buffer, decl, t, parent, spc);
2609 TREE_VISITED (decl) = 1;
2612 /* Special case char arrays. */
2613 if (is_char_array (field))
2614 pp_string (buffer, "sub");
2616 pp_string (buffer, "type ");
2617 dump_ada_double_name (buffer, parent, field);
2618 pp_string (buffer, " is ");
2619 dump_ada_array_type (buffer, field, parent, spc);
2620 pp_semicolon (buffer);
2621 newline_and_indent (buffer, spc);
2622 break;
2624 case RECORD_TYPE:
2625 case UNION_TYPE:
2626 if (TYPE_NAME (TREE_TYPE (t)) && !TREE_VISITED (t))
2628 pp_string (buffer, "type ");
2629 dump_generic_ada_node (buffer, t, parent, spc, false, true);
2630 pp_semicolon (buffer);
2631 newline_and_indent (buffer, spc);
2634 TREE_VISITED (t) = 1;
2635 dump_nested_types (buffer, field, t, false, spc);
2637 pp_string (buffer, "type ");
2639 if (TYPE_NAME (field_type))
2641 dump_generic_ada_node (buffer, field_type, 0, spc, false, true);
2642 if (TREE_CODE (field_type) == UNION_TYPE)
2643 pp_string (buffer, " (discr : unsigned := 0)");
2644 pp_string (buffer, " is ");
2645 dump_ada_struct_decl (buffer, field_type, t, spc, false);
2647 pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
2648 dump_generic_ada_node (buffer, field_type, 0, spc, false, true);
2649 pp_string (buffer, ");");
2650 newline_and_indent (buffer, spc);
2652 if (TREE_CODE (field_type) == UNION_TYPE)
2654 pp_string (buffer, "pragma Unchecked_Union (");
2655 dump_generic_ada_node (buffer, field_type, 0, spc, false, true);
2656 pp_string (buffer, ");");
2659 else
2661 dump_ada_double_name (buffer, parent, field);
2662 if (TREE_CODE (field_type) == UNION_TYPE)
2663 pp_string (buffer, " (discr : unsigned := 0)");
2664 pp_string (buffer, " is ");
2665 dump_ada_struct_decl (buffer, field_type, t, spc, false);
2667 pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
2668 dump_ada_double_name (buffer, parent, field);
2669 pp_string (buffer, ");");
2670 newline_and_indent (buffer, spc);
2672 if (TREE_CODE (field_type) == UNION_TYPE)
2674 pp_string (buffer, "pragma Unchecked_Union (");
2675 dump_ada_double_name (buffer, parent, field);
2676 pp_string (buffer, ");");
2680 default:
2681 break;
2685 /* Dump in BUFFER constructor spec corresponding to T for TYPE. */
2687 static void
2688 print_constructor (pretty_printer *buffer, tree t, tree type)
2690 tree decl_name = DECL_NAME (TYPE_NAME (type));
2692 pp_string (buffer, "New_");
2693 pp_ada_tree_identifier (buffer, decl_name, t, 0, false);
2696 /* Dump in BUFFER destructor spec corresponding to T. */
2698 static void
2699 print_destructor (pretty_printer *buffer, tree t, tree type)
2701 tree decl_name = DECL_NAME (TYPE_NAME (type));
2703 pp_string (buffer, "Delete_");
2704 pp_ada_tree_identifier (buffer, decl_name, t, 0, false);
2707 /* Return the name of type T. */
2709 static const char *
2710 type_name (tree t)
2712 tree n = TYPE_NAME (t);
2714 if (TREE_CODE (n) == IDENTIFIER_NODE)
2715 return IDENTIFIER_POINTER (n);
2716 else
2717 return IDENTIFIER_POINTER (DECL_NAME (n));
2720 /* Dump in BUFFER the declaration of a variable T of type TYPE in Ada syntax.
2721 SPC is the indentation level. Return 1 if a declaration was printed,
2722 0 otherwise. */
2724 static int
2725 dump_ada_declaration (pretty_printer *buffer, tree t, tree type, int spc)
2727 int is_var = 0, need_indent = 0;
2728 int is_class = false;
2729 tree name = TYPE_NAME (TREE_TYPE (t));
2730 tree decl_name = DECL_NAME (t);
2731 tree orig = NULL_TREE;
2733 if (cpp_check && cpp_check (t, IS_TEMPLATE))
2734 return dump_ada_template (buffer, t, spc);
2736 if (TREE_CODE (t) == CONST_DECL && TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE)
2737 /* Skip enumeral values: will be handled as part of the type itself. */
2738 return 0;
2740 if (TREE_CODE (t) == TYPE_DECL)
2742 orig = DECL_ORIGINAL_TYPE (t);
2744 if (orig && TYPE_STUB_DECL (orig))
2746 tree stub = TYPE_STUB_DECL (orig);
2747 tree typ = TREE_TYPE (stub);
2749 if (TYPE_NAME (typ))
2751 /* If types have same representation, and same name (ignoring
2752 casing), then ignore the second type. */
2753 if (type_name (typ) == type_name (TREE_TYPE (t))
2754 || !strcasecmp (type_name (typ), type_name (TREE_TYPE (t))))
2756 TREE_VISITED (t) = 1;
2757 return 0;
2760 INDENT (spc);
2762 if (RECORD_OR_UNION_TYPE_P (typ) && !TYPE_FIELDS (typ))
2764 pp_string (buffer, "-- skipped empty struct ");
2765 dump_generic_ada_node (buffer, t, type, spc, false, true);
2767 else
2769 if (RECORD_OR_UNION_TYPE_P (typ)
2770 && DECL_SOURCE_FILE (stub) == current_source_file)
2771 dump_nested_types (buffer, stub, stub, true, spc);
2773 pp_string (buffer, "subtype ");
2774 dump_generic_ada_node (buffer, t, type, spc, false, true);
2775 pp_string (buffer, " is ");
2776 dump_generic_ada_node (buffer, typ, type, spc, false, true);
2777 pp_string (buffer, "; -- ");
2778 dump_sloc (buffer, t);
2781 TREE_VISITED (t) = 1;
2782 return 1;
2786 /* Skip unnamed or anonymous structs/unions/enum types. */
2787 if (!orig && !decl_name && !name
2788 && (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t))
2789 || TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE))
2790 return 0;
2792 /* Skip anonymous enum types (duplicates of real types). */
2793 if (!orig
2794 && TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE
2795 && decl_name
2796 && (*IDENTIFIER_POINTER (decl_name) == '.'
2797 || *IDENTIFIER_POINTER (decl_name) == '$'))
2798 return 0;
2800 INDENT (spc);
2802 switch (TREE_CODE (TREE_TYPE (t)))
2804 case RECORD_TYPE:
2805 case UNION_TYPE:
2806 /* Skip empty structs (typically forward references to real
2807 structs). */
2808 if (!TYPE_FIELDS (TREE_TYPE (t)))
2810 pp_string (buffer, "-- skipped empty struct ");
2811 dump_generic_ada_node (buffer, t, type, spc, false, true);
2812 return 1;
2815 if (decl_name
2816 && (*IDENTIFIER_POINTER (decl_name) == '.'
2817 || *IDENTIFIER_POINTER (decl_name) == '$'))
2819 pp_string (buffer, "-- skipped anonymous struct ");
2820 dump_generic_ada_node (buffer, t, type, spc, false, true);
2821 TREE_VISITED (t) = 1;
2822 return 1;
2825 if (orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
2826 pp_string (buffer, "subtype ");
2827 else
2829 dump_nested_types (buffer, t, t, false, spc);
2831 if (separate_class_package (t))
2833 is_class = true;
2834 pp_string (buffer, "package Class_");
2835 dump_generic_ada_node (buffer, t, type, spc, false, true);
2836 pp_string (buffer, " is");
2837 spc += INDENT_INCR;
2838 newline_and_indent (buffer, spc);
2841 pp_string (buffer, "type ");
2843 break;
2845 case ARRAY_TYPE:
2846 case POINTER_TYPE:
2847 case REFERENCE_TYPE:
2848 if ((orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
2849 || is_char_array (t))
2850 pp_string (buffer, "subtype ");
2851 else
2852 pp_string (buffer, "type ");
2853 break;
2855 case FUNCTION_TYPE:
2856 pp_string (buffer, "-- skipped function type ");
2857 dump_generic_ada_node (buffer, t, type, spc, false, true);
2858 return 1;
2860 case ENUMERAL_TYPE:
2861 if ((orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
2862 || !is_simple_enum (TREE_TYPE (t)))
2863 pp_string (buffer, "subtype ");
2864 else
2865 pp_string (buffer, "type ");
2866 break;
2868 default:
2869 pp_string (buffer, "subtype ");
2871 TREE_VISITED (t) = 1;
2873 else
2875 if (VAR_P (t)
2876 && decl_name
2877 && *IDENTIFIER_POINTER (decl_name) == '_')
2878 return 0;
2880 need_indent = 1;
2883 /* Print the type and name. */
2884 if (TREE_CODE (TREE_TYPE (t)) == ARRAY_TYPE)
2886 if (need_indent)
2887 INDENT (spc);
2889 /* Print variable's name. */
2890 dump_generic_ada_node (buffer, t, type, spc, false, true);
2892 if (TREE_CODE (t) == TYPE_DECL)
2894 pp_string (buffer, " is ");
2896 if (orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
2897 dump_generic_ada_node
2898 (buffer, TYPE_NAME (orig), type, spc, false, true);
2899 else
2900 dump_ada_array_type (buffer, t, type, spc);
2902 else
2904 tree tmp = TYPE_NAME (TREE_TYPE (t));
2906 if (spc == INDENT_INCR || TREE_STATIC (t))
2907 is_var = 1;
2909 pp_string (buffer, " : ");
2911 if (TREE_CODE (TREE_TYPE (TREE_TYPE (t))) != POINTER_TYPE)
2912 pp_string (buffer, "aliased ");
2914 if (tmp)
2915 dump_generic_ada_node (buffer, tmp, type, spc, false, true);
2916 else if (type)
2917 dump_ada_double_name (buffer, type, t);
2918 else
2919 dump_ada_array_type (buffer, t, type, spc);
2922 else if (TREE_CODE (t) == FUNCTION_DECL)
2924 bool is_abstract_class = false;
2925 bool is_method = TREE_CODE (TREE_TYPE (t)) == METHOD_TYPE;
2926 tree decl_name = DECL_NAME (t);
2927 bool is_abstract = false;
2928 bool is_constructor = false;
2929 bool is_destructor = false;
2930 bool is_copy_constructor = false;
2931 bool is_move_constructor = false;
2933 if (!decl_name)
2934 return 0;
2936 if (cpp_check)
2938 is_abstract = cpp_check (t, IS_ABSTRACT);
2939 is_constructor = cpp_check (t, IS_CONSTRUCTOR);
2940 is_destructor = cpp_check (t, IS_DESTRUCTOR);
2941 is_copy_constructor = cpp_check (t, IS_COPY_CONSTRUCTOR);
2942 is_move_constructor = cpp_check (t, IS_MOVE_CONSTRUCTOR);
2945 /* Skip copy constructors and C++11 move constructors: some are internal
2946 only and those that are not cannot be called easily from Ada. */
2947 if (is_copy_constructor || is_move_constructor)
2948 return 0;
2950 if (is_constructor || is_destructor)
2952 /* ??? Skip implicit constructors/destructors for now. */
2953 if (DECL_ARTIFICIAL (t))
2954 return 0;
2956 /* Only consider constructors/destructors for complete objects. */
2957 if (strncmp (IDENTIFIER_POINTER (decl_name), "__ct_comp", 9) != 0
2958 && strncmp (IDENTIFIER_POINTER (decl_name), "__dt_comp", 9) != 0)
2959 return 0;
2962 /* If this function has an entry in the vtable, we cannot omit it. */
2963 else if (!DECL_VINDEX (t) && *IDENTIFIER_POINTER (decl_name) == '_')
2965 INDENT (spc);
2966 pp_string (buffer, "-- skipped func ");
2967 pp_string (buffer, IDENTIFIER_POINTER (decl_name));
2968 return 1;
2971 if (need_indent)
2972 INDENT (spc);
2974 if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t))) && !is_constructor)
2975 pp_string (buffer, "procedure ");
2976 else
2977 pp_string (buffer, "function ");
2979 if (is_constructor)
2980 print_constructor (buffer, t, type);
2981 else if (is_destructor)
2982 print_destructor (buffer, t, type);
2983 else
2984 dump_ada_decl_name (buffer, t, false);
2986 dump_ada_function_declaration
2987 (buffer, t, is_method, is_constructor, is_destructor, spc);
2989 if (is_constructor && RECORD_OR_UNION_TYPE_P (type))
2990 for (tree fld = TYPE_FIELDS (type); fld; fld = DECL_CHAIN (fld))
2991 if (TREE_CODE (fld) == FUNCTION_DECL && cpp_check (fld, IS_ABSTRACT))
2993 is_abstract_class = true;
2994 break;
2997 if (is_abstract || is_abstract_class)
2998 pp_string (buffer, " is abstract");
3000 pp_semicolon (buffer);
3001 pp_string (buffer, " -- ");
3002 dump_sloc (buffer, t);
3004 if (is_abstract || !DECL_ASSEMBLER_NAME (t))
3005 return 1;
3007 newline_and_indent (buffer, spc);
3009 if (is_constructor)
3011 pp_string (buffer, "pragma CPP_Constructor (");
3012 print_constructor (buffer, t, type);
3013 pp_string (buffer, ", \"");
3014 pp_asm_name (buffer, t);
3015 pp_string (buffer, "\");");
3017 else if (is_destructor)
3019 pp_string (buffer, "pragma Import (CPP, ");
3020 print_destructor (buffer, t, type);
3021 pp_string (buffer, ", \"");
3022 pp_asm_name (buffer, t);
3023 pp_string (buffer, "\");");
3025 else
3026 dump_ada_import (buffer, t);
3028 return 1;
3030 else if (TREE_CODE (t) == TYPE_DECL && !DECL_ORIGINAL_TYPE (t))
3032 int is_interface = 0;
3033 int is_abstract_record = 0;
3035 if (need_indent)
3036 INDENT (spc);
3038 /* Anonymous structs/unions */
3039 dump_generic_ada_node (buffer, TREE_TYPE (t), t, spc, false, true);
3041 if (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE)
3043 pp_string (buffer, " (discr : unsigned := 0)");
3046 pp_string (buffer, " is ");
3048 /* Check whether we have an Ada interface compatible class.
3049 That is only have a vtable non-static data member and no
3050 non-abstract methods. */
3051 if (cpp_check
3052 && RECORD_OR_UNION_TYPE_P (TREE_TYPE (t)))
3054 bool has_fields = false;
3056 /* Check that there are no fields other than the virtual table. */
3057 for (tree fld = TYPE_FIELDS (TREE_TYPE (t));
3058 fld;
3059 fld = TREE_CHAIN (fld))
3061 if (TREE_CODE (fld) == FIELD_DECL)
3063 if (!has_fields && DECL_VIRTUAL_P (fld))
3064 is_interface = 1;
3065 else
3066 is_interface = 0;
3067 has_fields = true;
3069 else if (TREE_CODE (fld) == FUNCTION_DECL
3070 && !DECL_ARTIFICIAL (fld))
3072 if (cpp_check (fld, IS_ABSTRACT))
3073 is_abstract_record = 1;
3074 else
3075 is_interface = 0;
3080 TREE_VISITED (t) = 1;
3081 if (is_interface)
3083 pp_string (buffer, "limited interface; -- ");
3084 dump_sloc (buffer, t);
3085 newline_and_indent (buffer, spc);
3086 pp_string (buffer, "pragma Import (CPP, ");
3087 dump_generic_ada_node
3088 (buffer, TYPE_NAME (TREE_TYPE (t)), type, spc, false, true);
3089 pp_right_paren (buffer);
3091 dump_ada_methods (buffer, TREE_TYPE (t), spc);
3093 else
3095 if (is_abstract_record)
3096 pp_string (buffer, "abstract ");
3097 dump_generic_ada_node (buffer, t, t, spc, false, false);
3100 else
3102 if (need_indent)
3103 INDENT (spc);
3105 if (TREE_CODE (t) == FIELD_DECL && DECL_NAME (t))
3106 check_name (buffer, t);
3108 /* Print variable/type's name. */
3109 dump_generic_ada_node (buffer, t, t, spc, false, true);
3111 if (TREE_CODE (t) == TYPE_DECL)
3113 tree orig = DECL_ORIGINAL_TYPE (t);
3114 int is_subtype = orig && TYPE_NAME (orig) && orig != TREE_TYPE (t);
3116 if (!is_subtype && TREE_CODE (TREE_TYPE (t)) == UNION_TYPE)
3117 pp_string (buffer, " (discr : unsigned := 0)");
3119 pp_string (buffer, " is ");
3121 dump_generic_ada_node (buffer, orig, t, spc, false, is_subtype);
3123 else
3125 if (spc == INDENT_INCR || TREE_STATIC (t))
3126 is_var = 1;
3128 pp_string (buffer, " : ");
3130 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t)))
3132 pp_string (buffer, "aliased ");
3134 if (TREE_READONLY (t))
3135 pp_string (buffer, "constant ");
3137 if (TYPE_NAME (TREE_TYPE (t)))
3138 dump_generic_ada_node
3139 (buffer, TREE_TYPE (t), t, spc, false, true);
3140 else if (type)
3141 dump_ada_double_name (buffer, type, t);
3143 else
3145 if (TREE_CODE (TREE_TYPE (t)) != POINTER_TYPE
3146 && (TYPE_NAME (TREE_TYPE (t))
3147 || TREE_CODE (TREE_TYPE (t)) != INTEGER_TYPE))
3148 pp_string (buffer, "aliased ");
3150 if (TREE_READONLY (t))
3151 pp_string (buffer, "constant ");
3153 dump_generic_ada_node
3154 (buffer, TREE_TYPE (t), TREE_TYPE (t), spc, false, true);
3159 if (is_class)
3161 spc -= INDENT_INCR;
3162 newline_and_indent (buffer, spc);
3163 pp_string (buffer, "end;");
3164 newline_and_indent (buffer, spc);
3165 pp_string (buffer, "use Class_");
3166 dump_generic_ada_node (buffer, t, type, spc, false, true);
3167 pp_semicolon (buffer);
3168 pp_newline (buffer);
3170 /* All needed indentation/newline performed already, so return 0. */
3171 return 0;
3173 else
3175 pp_string (buffer, "; -- ");
3176 dump_sloc (buffer, t);
3179 if (is_var)
3181 newline_and_indent (buffer, spc);
3182 dump_ada_import (buffer, t);
3185 return 1;
3188 /* Dump in BUFFER a structure NODE of type TYPE: name, fields, and methods
3189 with Ada syntax. SPC is the indentation level. If DISPLAY_CONVENTION is
3190 true, also print the pragma Convention for NODE. */
3192 static void
3193 dump_ada_struct_decl (pretty_printer *buffer, tree node, tree type, int spc,
3194 bool display_convention)
3196 tree tmp;
3197 const bool is_union = (TREE_CODE (node) == UNION_TYPE);
3198 char buf[32];
3199 int field_num = 0;
3200 int field_spc = spc + INDENT_INCR;
3201 int need_semicolon;
3203 bitfield_used = false;
3205 if (TYPE_FIELDS (node))
3207 /* Print the contents of the structure. */
3208 pp_string (buffer, "record");
3210 if (is_union)
3212 newline_and_indent (buffer, spc + INDENT_INCR);
3213 pp_string (buffer, "case discr is");
3214 field_spc = spc + INDENT_INCR * 3;
3217 pp_newline (buffer);
3219 /* Print the non-static fields of the structure. */
3220 for (tmp = TYPE_FIELDS (node); tmp; tmp = TREE_CHAIN (tmp))
3222 /* Add parent field if needed. */
3223 if (!DECL_NAME (tmp))
3225 if (!is_tagged_type (TREE_TYPE (tmp)))
3227 if (!TYPE_NAME (TREE_TYPE (tmp)))
3228 dump_ada_declaration (buffer, tmp, type, field_spc);
3229 else
3231 INDENT (field_spc);
3233 if (field_num == 0)
3234 pp_string (buffer, "parent : aliased ");
3235 else
3237 sprintf (buf, "field_%d : aliased ", field_num + 1);
3238 pp_string (buffer, buf);
3240 dump_ada_decl_name
3241 (buffer, TYPE_NAME (TREE_TYPE (tmp)), false);
3242 pp_semicolon (buffer);
3244 pp_newline (buffer);
3245 field_num++;
3248 else if (TREE_CODE (tmp) == FIELD_DECL)
3250 /* Skip internal virtual table field. */
3251 if (!DECL_VIRTUAL_P (tmp))
3253 if (is_union)
3255 if (TREE_CHAIN (tmp)
3256 && TREE_TYPE (TREE_CHAIN (tmp)) != node
3257 && TREE_CODE (TREE_CHAIN (tmp)) != TYPE_DECL)
3258 sprintf (buf, "when %d =>", field_num);
3259 else
3260 sprintf (buf, "when others =>");
3262 INDENT (spc + INDENT_INCR * 2);
3263 pp_string (buffer, buf);
3264 pp_newline (buffer);
3267 if (dump_ada_declaration (buffer, tmp, type, field_spc))
3269 pp_newline (buffer);
3270 field_num++;
3276 if (is_union)
3278 INDENT (spc + INDENT_INCR);
3279 pp_string (buffer, "end case;");
3280 pp_newline (buffer);
3283 if (field_num == 0)
3285 INDENT (spc + INDENT_INCR);
3286 pp_string (buffer, "null;");
3287 pp_newline (buffer);
3290 INDENT (spc);
3291 pp_string (buffer, "end record;");
3293 else
3294 pp_string (buffer, "null record;");
3296 newline_and_indent (buffer, spc);
3298 if (!display_convention)
3299 return;
3301 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (type)))
3303 if (has_nontrivial_methods (TREE_TYPE (type)))
3304 pp_string (buffer, "pragma Import (CPP, ");
3305 else
3306 pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
3308 else
3309 pp_string (buffer, "pragma Convention (C, ");
3311 package_prefix = false;
3312 dump_generic_ada_node (buffer, TREE_TYPE (type), type, spc, false, true);
3313 package_prefix = true;
3314 pp_right_paren (buffer);
3316 if (is_union)
3318 pp_semicolon (buffer);
3319 newline_and_indent (buffer, spc);
3320 pp_string (buffer, "pragma Unchecked_Union (");
3322 dump_generic_ada_node (buffer, TREE_TYPE (type), type, spc, false, true);
3323 pp_right_paren (buffer);
3326 if (bitfield_used)
3328 pp_semicolon (buffer);
3329 newline_and_indent (buffer, spc);
3330 pp_string (buffer, "pragma Pack (");
3331 dump_generic_ada_node
3332 (buffer, TREE_TYPE (type), type, spc, false, true);
3333 pp_right_paren (buffer);
3334 bitfield_used = false;
3337 need_semicolon = !dump_ada_methods (buffer, node, spc);
3339 /* Print the static fields of the structure, if any. */
3340 for (tmp = TYPE_FIELDS (node); tmp; tmp = TREE_CHAIN (tmp))
3342 if (TREE_CODE (tmp) == VAR_DECL && DECL_NAME (tmp))
3344 if (need_semicolon)
3346 need_semicolon = false;
3347 pp_semicolon (buffer);
3349 pp_newline (buffer);
3350 pp_newline (buffer);
3351 dump_ada_declaration (buffer, tmp, type, spc);
3356 /* Dump all the declarations in SOURCE_FILE to an Ada spec.
3357 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3358 nodes for SOURCE_FILE. CHECK is used to perform C++ queries on nodes. */
3360 static void
3361 dump_ads (const char *source_file,
3362 void (*collect_all_refs)(const char *),
3363 int (*check)(tree, cpp_operation))
3365 char *ads_name;
3366 char *pkg_name;
3367 char *s;
3368 FILE *f;
3370 pkg_name = get_ada_package (source_file);
3372 /* Construct the .ads filename and package name. */
3373 ads_name = xstrdup (pkg_name);
3375 for (s = ads_name; *s; s++)
3376 if (*s == '.')
3377 *s = '-';
3378 else
3379 *s = TOLOWER (*s);
3381 ads_name = reconcat (ads_name, ads_name, ".ads", NULL);
3383 /* Write out the .ads file. */
3384 f = fopen (ads_name, "w");
3385 if (f)
3387 pretty_printer pp;
3389 pp_needs_newline (&pp) = true;
3390 pp.buffer->stream = f;
3392 /* Dump all relevant macros. */
3393 dump_ada_macros (&pp, source_file);
3395 /* Reset the table of withs for this file. */
3396 reset_ada_withs ();
3398 (*collect_all_refs) (source_file);
3400 /* Dump all references. */
3401 cpp_check = check;
3402 dump_ada_nodes (&pp, source_file);
3404 /* Requires Ada 2005 syntax, so generate corresponding pragma.
3405 Also, disable style checks since this file is auto-generated. */
3406 fprintf (f, "pragma Ada_2005;\npragma Style_Checks (Off);\n\n");
3408 /* Dump withs. */
3409 dump_ada_withs (f);
3411 fprintf (f, "\npackage %s is\n\n", pkg_name);
3412 pp_write_text_to_stream (&pp);
3413 /* ??? need to free pp */
3414 fprintf (f, "end %s;\n", pkg_name);
3415 fclose (f);
3418 free (ads_name);
3419 free (pkg_name);
3422 static const char **source_refs = NULL;
3423 static int source_refs_used = 0;
3424 static int source_refs_allocd = 0;
3426 /* Add an entry for FILENAME to the table SOURCE_REFS. */
3428 void
3429 collect_source_ref (const char *filename)
3431 int i;
3433 if (!filename)
3434 return;
3436 if (source_refs_allocd == 0)
3438 source_refs_allocd = 1024;
3439 source_refs = XNEWVEC (const char *, source_refs_allocd);
3442 for (i = 0; i < source_refs_used; i++)
3443 if (filename == source_refs[i])
3444 return;
3446 if (source_refs_used == source_refs_allocd)
3448 source_refs_allocd *= 2;
3449 source_refs = XRESIZEVEC (const char *, source_refs, source_refs_allocd);
3452 source_refs[source_refs_used++] = filename;
3455 /* Main entry point: dump all Ada specs corresponding to SOURCE_REFS
3456 using callbacks COLLECT_ALL_REFS and CHECK.
3457 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3458 nodes for a given source file.
3459 CHECK is used to perform C++ queries on nodes, or NULL for the C
3460 front-end. */
3462 void
3463 dump_ada_specs (void (*collect_all_refs)(const char *),
3464 int (*check)(tree, cpp_operation))
3466 /* Iterate over the list of files to dump specs for. */
3467 for (int i = 0; i < source_refs_used; i++)
3468 dump_ads (source_refs[i], collect_all_refs, check);
3470 /* Free various tables. */
3471 free (source_refs);
3472 delete overloaded_names;