Mercurial > hg > CbC > CbC_gcc
diff gcc/c-family/c-ada-spec.c @ 111:04ced10e8804
gcc 7
| author | kono |
|---|---|
| date | Fri, 27 Oct 2017 22:46:09 +0900 |
| parents | 561a7518be6b |
| children | 84e7813d76e9 |
line wrap: on
line diff
--- a/gcc/c-family/c-ada-spec.c Sun Aug 21 07:07:55 2011 +0900 +++ b/gcc/c-family/c-ada-spec.c Fri Oct 27 22:46:09 2017 +0900 @@ -1,6 +1,6 @@ /* Print GENERIC declaration (functions, variables, types) trees coming from the C and C++ front-ends as well as macros in Ada syntax. - Copyright (C) 2010 Free Software Foundation, Inc. + Copyright (C) 2010-2017 Free Software Foundation, Inc. Adapted from tree-pretty-print.c by Arnaud Charlet <charlet@adacore.com> This file is part of GCC. @@ -24,42 +24,33 @@ #include "coretypes.h" #include "tm.h" #include "tree.h" -#include "tree-pass.h" /* For TDI_ada and friends. */ -#include "output.h" #include "c-ada-spec.h" -#include "cpplib.h" +#include "fold-const.h" #include "c-pragma.h" #include "cpp-id-data.h" +#include "stringpool.h" +#include "attribs.h" /* Local functions, macros and variables. */ -static int dump_generic_ada_node (pretty_printer *, tree, tree, - int (*)(tree, cpp_operation), int, int, bool); -static int print_ada_declaration (pretty_printer *, tree, tree, - int (*cpp_check)(tree, cpp_operation), int); -static void print_ada_struct_decl (pretty_printer *, tree, tree, - int (*cpp_check)(tree, cpp_operation), int, +static int dump_generic_ada_node (pretty_printer *, tree, tree, int, bool, bool); -static void dump_sloc (pretty_printer *buffer, tree node); -static void print_comment (pretty_printer *, const char *); -static void print_generic_ada_decl (pretty_printer *, tree, - int (*)(tree, cpp_operation), const char *); -static char *get_ada_package (const char *); -static void dump_ada_nodes (pretty_printer *, const char *, - int (*)(tree, cpp_operation)); -static void reset_ada_withs (void); -static void dump_ada_withs (FILE *); -static void dump_ads (const char *, void (*)(const char *), - int (*)(tree, cpp_operation)); -static char *to_ada_name (const char *, int *); -static bool separate_class_package (tree); - -#define LOCATION_COL(LOC) ((expand_location (LOC)).column) - -#define INDENT(SPACE) do { \ - int i; for (i = 0; i<SPACE; i++) pp_space (buffer); } while (0) +static int dump_ada_declaration (pretty_printer *, tree, tree, int); +static void dump_ada_struct_decl (pretty_printer *, tree, tree, int, bool); +static char *to_ada_name (const char *, unsigned int, bool *); + +#define INDENT(SPACE) \ + do { int i; for (i = 0; i<SPACE; i++) pp_space (buffer); } while (0) #define INDENT_INCR 3 +/* Global hook used to perform C++ queries on nodes. */ +static int (*cpp_check) (tree, cpp_operation) = NULL; + +/* Global variables used in macro-related callbacks. */ +static int max_ada_macros; +static int store_ada_macro_index; +static const char *macro_source_file; + /* Given a cpp MACRO, compute the max length BUFFER_LEN of the macro, as well as max length PARAM_LEN of arguments for fun_like macros, and also set SUPPORTED to 0 if the macro cannot be mapped to an Ada construct. */ @@ -77,7 +68,7 @@ if (macro->fun_like) { - param_len++; + (*param_len)++; for (i = 0; i < macro->paramc; i++) { cpp_hashnode *param = macro->params[i]; @@ -121,23 +112,137 @@ (*buffer_len)++; } -/* Dump into PP a set of MAX_ADA_MACROS MACROS (C/C++) as Ada constants when - possible. */ +/* Dump all digits/hex chars from NUMBER to BUFFER and return a pointer + to the character after the last character written. */ + +static unsigned char * +dump_number (unsigned char *number, unsigned char *buffer) +{ + while (*number != '\0' + && *number != 'U' + && *number != 'u' + && *number != 'l' + && *number != 'L') + *buffer++ = *number++; + + return buffer; +} + +/* Handle escape character C and convert to an Ada character into BUFFER. + Return a pointer to the character after the last character written, or + NULL if the escape character is not supported. */ + +static unsigned char * +handle_escape_character (unsigned char *buffer, char c) +{ + switch (c) + { + case '"': + *buffer++ = '"'; + *buffer++ = '"'; + break; + + case 'n': + strcpy ((char *) buffer, "\" & ASCII.LF & \""); + buffer += 16; + break; + + case 'r': + strcpy ((char *) buffer, "\" & ASCII.CR & \""); + buffer += 16; + break; + + case 't': + strcpy ((char *) buffer, "\" & ASCII.HT & \""); + buffer += 16; + break; + + default: + return NULL; + } + + return buffer; +} + +/* Callback used to count the number of macros from cpp_forall_identifiers. + PFILE and V are not used. NODE is the current macro to consider. */ + +static int +count_ada_macro (cpp_reader *pfile ATTRIBUTE_UNUSED, cpp_hashnode *node, + void *v ATTRIBUTE_UNUSED) +{ + const cpp_macro *macro = node->value.macro; + + if (node->type == NT_MACRO && !(node->flags & NODE_BUILTIN) + && macro->count + && *NODE_NAME (node) != '_' + && LOCATION_FILE (macro->line) == macro_source_file) + max_ada_macros++; + + return 1; +} + +/* Callback used to store relevant macros from cpp_forall_identifiers. + PFILE is not used. NODE is the current macro to store if relevant. + MACROS is an array of cpp_hashnode* used to store NODE. */ + +static int +store_ada_macro (cpp_reader *pfile ATTRIBUTE_UNUSED, + cpp_hashnode *node, void *macros) +{ + const cpp_macro *macro = node->value.macro; + + if (node->type == NT_MACRO && !(node->flags & NODE_BUILTIN) + && macro->count + && *NODE_NAME (node) != '_' + && LOCATION_FILE (macro->line) == macro_source_file) + ((cpp_hashnode **) macros)[store_ada_macro_index++] = node; + + return 1; +} + +/* Callback used to compare (during qsort) macros. NODE1 and NODE2 are the + two macro nodes to compare. */ + +static int +compare_macro (const void *node1, const void *node2) +{ + typedef const cpp_hashnode *const_hnode; + + const_hnode n1 = *(const const_hnode *) node1; + const_hnode n2 = *(const const_hnode *) node2; + + return n1->value.macro->line - n2->value.macro->line; +} + +/* Dump in PP all relevant macros appearing in FILE. */ static void -print_ada_macros (pretty_printer *pp, cpp_hashnode **macros, int max_ada_macros) +dump_ada_macros (pretty_printer *pp, const char* file) { - int j, num_macros = 0, prev_line = -1; - - for (j = 0; j < max_ada_macros; j++) + int num_macros = 0, prev_line = -1; + cpp_hashnode **macros; + + /* Initialize file-scope variables. */ + max_ada_macros = 0; + store_ada_macro_index = 0; + macro_source_file = file; + + /* Count all potentially relevant macros, and then sort them by sloc. */ + cpp_forall_identifiers (parse_in, count_ada_macro, NULL); + macros = XALLOCAVEC (cpp_hashnode *, max_ada_macros); + cpp_forall_identifiers (parse_in, store_ada_macro, macros); + qsort (macros, max_ada_macros, sizeof (cpp_hashnode *), compare_macro); + + for (int j = 0; j < max_ada_macros; j++) { - cpp_hashnode *node = macros [j]; + cpp_hashnode *node = macros[j]; const cpp_macro *macro = node->value.macro; unsigned i; int supported = 1, prev_is_one = 0, buffer_len, param_len; int is_string = 0, is_char = 0; char *ada_name; - unsigned char *s, *params, *buffer, *buf_param, *char_one = NULL; + unsigned char *s, *params, *buffer, *buf_param, *char_one = NULL, *tmp; macro_length (macro, &supported, &buffer_len, ¶m_len); s = buffer = XALLOCAVEC (unsigned char, buffer_len); @@ -249,15 +354,35 @@ case CPP_WCHAR: case CPP_CHAR16: case CPP_CHAR32: + case CPP_UTF8CHAR: case CPP_NAME: - case CPP_STRING: - case CPP_NUMBER: if (!macro->fun_like) supported = 0; else buffer = cpp_spell_token (parse_in, token, buffer, false); break; + case CPP_STRING: + is_string = 1; + { + const unsigned char *s = token->val.str.text; + + for (; *s; s++) + if (*s == '\\') + { + s++; + buffer = handle_escape_character (buffer, *s); + if (buffer == NULL) + { + supported = 0; + break; + } + } + else + *buffer++ = *s; + } + break; + case CPP_CHAR: is_char = 1; { @@ -282,6 +407,72 @@ } break; + case CPP_NUMBER: + tmp = cpp_token_as_text (parse_in, token); + + switch (*tmp) + { + case '0': + switch (tmp[1]) + { + case '\0': + case 'l': + case 'L': + case 'u': + case 'U': + *buffer++ = '0'; + break; + + case 'x': + case 'X': + *buffer++ = '1'; + *buffer++ = '6'; + *buffer++ = '#'; + buffer = dump_number (tmp + 2, buffer); + *buffer++ = '#'; + break; + + case 'b': + case 'B': + *buffer++ = '2'; + *buffer++ = '#'; + buffer = dump_number (tmp + 2, buffer); + *buffer++ = '#'; + break; + + default: + /* Dump floating constants unmodified. */ + if (strchr ((const char *)tmp, '.')) + buffer = dump_number (tmp, buffer); + else + { + *buffer++ = '8'; + *buffer++ = '#'; + buffer = dump_number (tmp + 1, buffer); + *buffer++ = '#'; + } + break; + } + break; + + case '1': + if (tmp[1] == '\0' || tmp[1] == 'l' || tmp[1] == 'u' + || tmp[1] == 'L' || tmp[1] == 'U') + { + is_one = 1; + char_one = buffer; + *buffer++ = '1'; + } + else + buffer = dump_number (tmp, buffer); + break; + + default: + buffer = dump_number (tmp, buffer); + break; + } + break; + case CPP_LSHIFT: if (prev_is_one) { @@ -346,10 +537,10 @@ pp_string (pp, " -- arg-macro: "); - if (*start == '(' && buffer [-1] == ')') + if (*start == '(' && buffer[-1] == ')') { start++; - buffer [-1] = '\0'; + buffer[-1] = '\0'; is_function = 1; pp_string (pp, "function "); } @@ -379,14 +570,14 @@ { expanded_location sloc = expand_location (macro->line); - if (sloc.line != prev_line + 1) + if (sloc.line != prev_line + 1 && prev_line > 0) pp_newline (pp); num_macros++; prev_line = sloc.line; pp_string (pp, " "); - ada_name = to_ada_name ((const char *) NODE_NAME (node), NULL); + ada_name = to_ada_name ((const char *) NODE_NAME (node), 0, NULL); pp_string (pp, ada_name); free (ada_name); pp_string (pp, " : "); @@ -406,7 +597,7 @@ pp_string (pp, "; -- "); pp_string (pp, sloc.file); - pp_character (pp, ':'); + pp_colon (pp); pp_scalar (pp, "%d", sloc.line); pp_newline (pp); } @@ -422,121 +613,51 @@ pp_newline (pp); } -static const char *source_file; -static int max_ada_macros; - -/* Callback used to count the number of relevant macros from - cpp_forall_identifiers. PFILE and V are not used. NODE is the current macro - to consider. */ - -static int -count_ada_macro (cpp_reader *pfile ATTRIBUTE_UNUSED, cpp_hashnode *node, - void *v ATTRIBUTE_UNUSED) -{ - const cpp_macro *macro = node->value.macro; - - if (node->type == NT_MACRO && !(node->flags & NODE_BUILTIN) - && macro->count - && *NODE_NAME (node) != '_' - && LOCATION_FILE (macro->line) == source_file) - max_ada_macros++; - - return 1; -} - -static int store_ada_macro_index; - -/* Callback used to store relevant macros from cpp_forall_identifiers. - PFILE is not used. NODE is the current macro to store if relevant. - MACROS is an array of cpp_hashnode* used to store NODE. */ - -static int -store_ada_macro (cpp_reader *pfile ATTRIBUTE_UNUSED, - cpp_hashnode *node, void *macros) -{ - const cpp_macro *macro = node->value.macro; - - if (node->type == NT_MACRO && !(node->flags & NODE_BUILTIN) - && macro->count - && *NODE_NAME (node) != '_' - && LOCATION_FILE (macro->line) == source_file) - ((cpp_hashnode **) macros)[store_ada_macro_index++] = node; - - return 1; -} - -/* Callback used to compare (during qsort) macros. NODE1 and NODE2 are the - two macro nodes to compare. */ - -static int -compare_macro (const void *node1, const void *node2) -{ - typedef const cpp_hashnode *const_hnode; - - const_hnode n1 = *(const const_hnode *) node1; - const_hnode n2 = *(const const_hnode *) node2; - - return n1->value.macro->line - n2->value.macro->line; -} - -/* Dump in PP all relevant macros appearing in FILE. */ - -static void -dump_ada_macros (pretty_printer *pp, const char* file) -{ - cpp_hashnode **macros; - - /* Initialize file-scope variables. */ - max_ada_macros = 0; - store_ada_macro_index = 0; - source_file = file; - - /* Count all potentially relevant macros, and then sort them by sloc. */ - cpp_forall_identifiers (parse_in, count_ada_macro, NULL); - macros = XALLOCAVEC (cpp_hashnode *, max_ada_macros); - cpp_forall_identifiers (parse_in, store_ada_macro, macros); - qsort (macros, max_ada_macros, sizeof (cpp_hashnode *), compare_macro); - - print_ada_macros (pp, macros, max_ada_macros); -} - /* Current source file being handled. */ - -static const char *source_file_base; - -/* Compare the declaration (DECL) of struct-like types based on the sloc of - their last field (if LAST is true), so that more nested types collate before - less nested ones. - If ORIG_TYPE is true, also consider struct with a DECL_ORIGINAL_TYPE. */ - -static location_t -decl_sloc_common (const_tree decl, bool last, bool orig_type) -{ - tree type = TREE_TYPE (decl); - - if (TREE_CODE (decl) == TYPE_DECL - && (orig_type || !DECL_ORIGINAL_TYPE (decl)) - && RECORD_OR_UNION_TYPE_P (type) - && TYPE_FIELDS (type)) - { - tree f = TYPE_FIELDS (type); - - if (last) - while (TREE_CHAIN (f)) - f = TREE_CHAIN (f); - - return DECL_SOURCE_LOCATION (f); - } - else - return DECL_SOURCE_LOCATION (decl); -} +static const char *current_source_file; /* Return sloc of DECL, using sloc of last field if LAST is true. */ location_t decl_sloc (const_tree decl, bool last) { - return decl_sloc_common (decl, last, false); + tree field; + + /* Compare the declaration of struct-like types based on the sloc of their + last field (if LAST is true), so that more nested types collate before + less nested ones. */ + if (TREE_CODE (decl) == TYPE_DECL + && !DECL_ORIGINAL_TYPE (decl) + && RECORD_OR_UNION_TYPE_P (TREE_TYPE (decl)) + && (field = TYPE_FIELDS (TREE_TYPE (decl)))) + { + if (last) + while (DECL_CHAIN (field)) + field = DECL_CHAIN (field); + return DECL_SOURCE_LOCATION (field); + } + + return DECL_SOURCE_LOCATION (decl); +} + +/* Compare two locations LHS and RHS. */ + +static int +compare_location (location_t lhs, location_t rhs) +{ + expanded_location xlhs = expand_location (lhs); + expanded_location xrhs = expand_location (rhs); + + if (xlhs.file != xrhs.file) + return filename_cmp (xlhs.file, xrhs.file); + + if (xlhs.line != xrhs.line) + return xlhs.line - xrhs.line; + + if (xlhs.column != xrhs.column) + return xlhs.column - xrhs.column; + + return 0; } /* Compare two declarations (LP and RP) by their source location. */ @@ -547,7 +668,7 @@ const_tree lhs = *((const tree *) lp); const_tree rhs = *((const tree *) rp); - return decl_sloc (lhs, true) - decl_sloc (rhs, true); + return compare_location (decl_sloc (lhs, true), decl_sloc (rhs, true)); } /* Compare two comments (LP and RP) by their source location. */ @@ -558,16 +679,7 @@ const cpp_comment *lhs = (const cpp_comment *) lp; const cpp_comment *rhs = (const cpp_comment *) rp; - if (LOCATION_FILE (lhs->sloc) != LOCATION_FILE (rhs->sloc)) - return strcmp (LOCATION_FILE (lhs->sloc), LOCATION_FILE (rhs->sloc)); - - if (LOCATION_LINE (lhs->sloc) != LOCATION_LINE (rhs->sloc)) - return LOCATION_LINE (lhs->sloc) - LOCATION_LINE (rhs->sloc); - - if (LOCATION_COL (lhs->sloc) != LOCATION_COL (rhs->sloc)) - return LOCATION_COL (lhs->sloc) - LOCATION_COL (rhs->sloc); - - return 0; + return compare_location (lhs->sloc, rhs->sloc); } static tree *to_dump = NULL; @@ -582,9 +694,12 @@ tree n; int i = to_dump_count; - /* Count the likely relevant nodes. */ + /* Count the likely relevant nodes: do not dump builtins (they are irrelevant + in the context of bindings) and namespaces (we do not handle them properly + yet). */ for (n = t; n; n = TREE_CHAIN (n)) if (!DECL_IS_BUILTIN (n) + && TREE_CODE (n) != NAMESPACE_DECL && LOCATION_FILE (decl_sloc (n, false)) == source_file) to_dump_count++; @@ -594,8 +709,9 @@ /* Store the relevant nodes. */ for (n = t; n; n = TREE_CHAIN (n)) if (!DECL_IS_BUILTIN (n) + && TREE_CODE (n) != NAMESPACE_DECL && LOCATION_FILE (decl_sloc (n, false)) == source_file) - to_dump [i++] = n; + to_dump[i++] = n; } /* Call back for walk_tree to clear the TREE_VISITED flag of TP. */ @@ -612,71 +728,6 @@ return NULL_TREE; } -/* Dump nodes into PP relevant to SOURCE_FILE, as collected by previous calls - to collect_ada_nodes. CPP_CHECK is used to perform C++ queries on nodes. */ - -static void -dump_ada_nodes (pretty_printer *pp, const char *source_file, - int (*cpp_check)(tree, cpp_operation)) -{ - int i, j; - cpp_comment_table *comments; - - /* Sort the table of declarations to dump by sloc. */ - qsort (to_dump, to_dump_count, sizeof (tree), compare_node); - - /* Fetch the table of comments. */ - comments = cpp_get_comments (parse_in); - - /* Sort the comments table by sloc. */ - qsort (comments->entries, comments->count, sizeof (cpp_comment), - compare_comment); - - /* Interleave comments and declarations in line number order. */ - i = j = 0; - do - { - /* Advance j until comment j is in this file. */ - while (j != comments->count - && LOCATION_FILE (comments->entries[j].sloc) != source_file) - j++; - - /* Advance j until comment j is not a duplicate. */ - while (j < comments->count - 1 - && !compare_comment (&comments->entries[j], - &comments->entries[j + 1])) - j++; - - /* Write decls until decl i collates after comment j. */ - while (i != to_dump_count) - { - if (j == comments->count - || LOCATION_LINE (decl_sloc (to_dump[i], false)) - < LOCATION_LINE (comments->entries[j].sloc)) - print_generic_ada_decl (pp, to_dump[i++], cpp_check, source_file); - else - break; - } - - /* Write comment j, if there is one. */ - if (j != comments->count) - print_comment (pp, comments->entries[j++].comment); - - } while (i != to_dump_count || j != comments->count); - - /* Clear the TREE_VISITED flag over each subtree we've dumped. */ - for (i = 0; i < to_dump_count; i++) - walk_tree (&to_dump[i], unmark_visited_r, NULL, NULL); - - /* Finalize the to_dump table. */ - if (to_dump) - { - free (to_dump); - to_dump = NULL; - to_dump_count = 0; - } -} - /* Print a COMMENT to the output stream PP. */ static void @@ -713,21 +764,77 @@ pp_newline (pp); } -/* Prints declaration DECL to PP in Ada syntax. The current source file being - handled is SOURCE_FILE, and CPP_CHECK is used to perform C++ queries on - nodes. */ +/* Dump nodes into PP relevant to SOURCE_FILE, as collected by previous calls + to collect_ada_nodes. */ static void -print_generic_ada_decl (pretty_printer *pp, tree decl, - int (*cpp_check)(tree, cpp_operation), - const char* source_file) +dump_ada_nodes (pretty_printer *pp, const char *source_file) { - source_file_base = source_file; - - if (print_ada_declaration (pp, decl, 0, cpp_check, INDENT_INCR)) + int i, j; + cpp_comment_table *comments; + + /* Sort the table of declarations to dump by sloc. */ + qsort (to_dump, to_dump_count, sizeof (tree), compare_node); + + /* Fetch the table of comments. */ + comments = cpp_get_comments (parse_in); + + /* Sort the comments table by sloc. */ + if (comments->count > 1) + qsort (comments->entries, comments->count, sizeof (cpp_comment), + compare_comment); + + /* Interleave comments and declarations in line number order. */ + i = j = 0; + do { - pp_newline (pp); - pp_newline (pp); + /* Advance j until comment j is in this file. */ + while (j != comments->count + && LOCATION_FILE (comments->entries[j].sloc) != source_file) + j++; + + /* Advance j until comment j is not a duplicate. */ + while (j < comments->count - 1 + && !compare_comment (&comments->entries[j], + &comments->entries[j + 1])) + j++; + + /* Write decls until decl i collates after comment j. */ + while (i != to_dump_count) + { + if (j == comments->count + || LOCATION_LINE (decl_sloc (to_dump[i], false)) + < LOCATION_LINE (comments->entries[j].sloc)) + { + current_source_file = source_file; + + if (dump_ada_declaration (pp, to_dump[i++], NULL_TREE, + INDENT_INCR)) + { + pp_newline (pp); + pp_newline (pp); + } + } + else + break; + } + + /* Write comment j, if there is one. */ + if (j != comments->count) + print_comment (pp, comments->entries[j++].comment); + + } while (i != to_dump_count || j != comments->count); + + /* Clear the TREE_VISITED flag over each subtree we've dumped. */ + for (i = 0; i < to_dump_count; i++) + walk_tree (&to_dump[i], unmark_visited_r, NULL, NULL); + + /* Finalize the to_dump table. */ + if (to_dump) + { + free (to_dump); + to_dump = NULL; + to_dump_count = 0; } } @@ -740,7 +847,7 @@ INDENT (spc); } -struct with { char *s; const char *in_file; int limited; }; +struct with { char *s; const char *in_file; bool limited; }; static struct with *withs = NULL; static int withs_max = 4096; static int with_len = 0; @@ -749,7 +856,7 @@ true), if not already done. */ static void -append_withs (const char *s, int limited_access) +append_withs (const char *s, bool limited_access) { int i; @@ -763,16 +870,16 @@ } for (i = 0; i < with_len; i++) - if (!strcmp (s, withs [i].s) - && source_file_base == withs [i].in_file) + if (!strcmp (s, withs[i].s) + && current_source_file == withs[i].in_file) { - withs [i].limited &= limited_access; + withs[i].limited &= limited_access; return; } - withs [with_len].s = xstrdup (s); - withs [with_len].in_file = source_file_base; - withs [with_len].limited = limited_access; + withs[with_len].s = xstrdup (s); + withs[with_len].in_file = current_source_file; + withs[with_len].limited = limited_access; with_len++; } @@ -787,7 +894,7 @@ return; for (i = 0; i < with_len; i++) - free (withs [i].s); + free (withs[i].s); free (withs); withs = NULL; withs_max = 4096; @@ -805,7 +912,7 @@ for (i = 0; i < with_len; i++) fprintf - (f, "%swith %s;\n", withs [i].limited ? "limited " : "", withs [i].s); + (f, "%swith %s;\n", withs[i].limited ? "limited " : "", withs[i].s); } /* Return suitable Ada package name from FILE. */ @@ -817,19 +924,30 @@ char *res; const char *s; int i; + size_t plen; s = strstr (file, "/include/"); if (s) base = s + 9; else base = lbasename (file); - res = XNEWVEC (char, strlen (base) + 1); - - for (i = 0; *base; base++, i++) + + if (ada_specs_parent == NULL) + plen = 0; + else + plen = strlen (ada_specs_parent) + 1; + + res = XNEWVEC (char, plen + strlen (base) + 1); + if (ada_specs_parent != NULL) { + strcpy (res, ada_specs_parent); + res[plen - 1] = '.'; + } + + for (i = plen; *base; base++, i++) switch (*base) { case '+': - res [i] = 'p'; + res[i] = 'p'; break; case '.': @@ -837,14 +955,14 @@ case '_': case '/': case '\\': - res [i] = (i == 0 || res [i - 1] == '_') ? 'u' : '_'; + res[i] = (i == 0 || res[i - 1] == '.' || res[i - 1] == '_') ? 'u' : '_'; break; default: - res [i] = *base; + res[i] = *base; break; } - res [i] = '\0'; + res[i] = '\0'; return res; } @@ -884,167 +1002,190 @@ static tree get_underlying_decl (tree type) { - tree decl = NULL_TREE; - - if (type == NULL_TREE) + if (!type) return NULL_TREE; /* type is a declaration. */ if (DECL_P (type)) - decl = type; + return type; /* type is a typedef. */ if (TYPE_P (type) && TYPE_NAME (type) && DECL_P (TYPE_NAME (type))) - decl = TYPE_NAME (type); + return TYPE_NAME (type); /* TYPE_STUB_DECL has been set for type. */ - if (TYPE_P (type) && TYPE_STUB_DECL (type) && - DECL_P (TYPE_STUB_DECL (type))) - decl = TYPE_STUB_DECL (type); - - return decl; + if (TYPE_P (type) && TYPE_STUB_DECL (type)) + return TYPE_STUB_DECL (type); + + return NULL_TREE; } /* Return whether TYPE has static fields. */ -static int +static bool has_static_fields (const_tree type) { - tree tmp; - - for (tmp = TYPE_FIELDS (type); tmp; tmp = TREE_CHAIN (tmp)) - { - if (DECL_NAME (tmp) && TREE_STATIC (tmp)) - return true; - } + if (!type || !RECORD_OR_UNION_TYPE_P (type)) + return false; + + for (tree fld = TYPE_FIELDS (type); fld; fld = TREE_CHAIN (fld)) + if (TREE_CODE (fld) == VAR_DECL && DECL_NAME (fld)) + return true; + return false; } /* Return whether TYPE corresponds to an Ada tagged type (has a dispatch table). */ -static int +static bool is_tagged_type (const_tree type) { - tree tmp; - if (!type || !RECORD_OR_UNION_TYPE_P (type)) return false; - for (tmp = TYPE_METHODS (type); tmp; tmp = TREE_CHAIN (tmp)) - if (DECL_VINDEX (tmp)) + for (tree fld = TYPE_FIELDS (type); fld; fld = TREE_CHAIN (fld)) + if (TREE_CODE (fld) == FUNCTION_DECL && DECL_VINDEX (fld)) return true; return false; } -/* Generate a legal Ada name from a C NAME, returning a malloc'd string. - SPACE_FOUND, if not NULL, is used to indicate whether a space was found in - NAME. */ +/* Return whether TYPE has non-trivial methods, i.e. methods that do something + for the objects of TYPE. In C++, all classes have implicit special methods, + e.g. constructors and destructors, but they can be trivial if the type is + sufficiently simple. */ + +static bool +has_nontrivial_methods (tree type) +{ + if (!type || !RECORD_OR_UNION_TYPE_P (type)) + return false; + + /* Only C++ types can have methods. */ + if (!cpp_check) + return false; + + /* A non-trivial type has non-trivial special methods. */ + if (!cpp_check (type, IS_TRIVIAL)) + return true; + + /* If there are user-defined methods, they are deemed non-trivial. */ + for (tree fld = TYPE_FIELDS (type); fld; fld = DECL_CHAIN (fld)) + if (TREE_CODE (fld) == FUNCTION_DECL && !DECL_ARTIFICIAL (fld)) + return true; + + return false; +} + +#define INDEX_LENGTH 8 + +/* Generate a legal Ada name from a C/C++ NAME and return a malloc'ed string. + INDEX, if non-zero, is used to disambiguate overloaded names. SPACE_FOUND, + if not NULL, is used to indicate whether a space was found in NAME. */ static char * -to_ada_name (const char *name, int *space_found) +to_ada_name (const char *name, unsigned int index, bool *space_found) { const char **names; - int len = strlen (name); + const int len = strlen (name); int j, len2 = 0; - int found = false; - char *s = XNEWVEC (char, len * 2 + 5); + bool found = false; + char *s = XNEWVEC (char, len * 2 + 5 + (index ? INDEX_LENGTH : 0)); char c; if (space_found) *space_found = false; - /* Add trailing "c_" if name is an Ada reserved word. */ + /* Add "c_" prefix if name is an Ada reserved word. */ for (names = ada_reserved; *names; names++) if (!strcasecmp (name, *names)) { - s [len2++] = 'c'; - s [len2++] = '_'; + s[len2++] = 'c'; + s[len2++] = '_'; found = true; break; } if (!found) - /* Add trailing "c_" if name is an potential case sensitive duplicate. */ + /* Add "c_" prefix if name is a potential case sensitive duplicate. */ for (names = c_duplicates; *names; names++) if (!strcmp (name, *names)) { - s [len2++] = 'c'; - s [len2++] = '_'; + s[len2++] = 'c'; + s[len2++] = '_'; found = true; break; } - for (j = 0; name [j] == '_'; j++) - s [len2++] = 'u'; + for (j = 0; name[j] == '_'; j++) + s[len2++] = 'u'; if (j > 0) - s [len2++] = '_'; + s[len2++] = '_'; else if (*name == '.' || *name == '$') { - s [0] = 'a'; - s [1] = 'n'; - s [2] = 'o'; - s [3] = 'n'; + s[0] = 'a'; + s[1] = 'n'; + s[2] = 'o'; + s[3] = 'n'; len2 = 4; j++; } /* Replace unsuitable characters for Ada identifiers. */ - for (; j < len; j++) - switch (name [j]) + switch (name[j]) { case ' ': if (space_found) *space_found = true; - s [len2++] = '_'; + s[len2++] = '_'; break; /* ??? missing some C++ operators. */ case '=': - s [len2++] = '_'; - - if (name [j + 1] == '=') + s[len2++] = '_'; + + if (name[j + 1] == '=') { j++; - s [len2++] = 'e'; - s [len2++] = 'q'; + s[len2++] = 'e'; + s[len2++] = 'q'; } else { - s [len2++] = 'a'; - s [len2++] = 's'; + s[len2++] = 'a'; + s[len2++] = 's'; } break; case '!': - s [len2++] = '_'; - if (name [j + 1] == '=') + s[len2++] = '_'; + if (name[j + 1] == '=') { j++; - s [len2++] = 'n'; - s [len2++] = 'e'; + s[len2++] = 'n'; + s[len2++] = 'e'; } break; case '~': - s [len2++] = '_'; - s [len2++] = 't'; - s [len2++] = 'i'; + s[len2++] = '_'; + s[len2++] = 't'; + s[len2++] = 'i'; break; case '&': case '|': case '^': - s [len2++] = '_'; - s [len2++] = name [j] == '&' ? 'a' : name [j] == '|' ? 'o' : 'x'; - - if (name [j + 1] == '=') + s[len2++] = '_'; + s[len2++] = name[j] == '&' ? 'a' : name[j] == '|' ? 'o' : 'x'; + + if (name[j + 1] == '=') { j++; - s [len2++] = 'e'; + s[len2++] = 'e'; } break; @@ -1054,53 +1195,53 @@ case '/': case '(': case '[': - if (s [len2 - 1] != '_') - s [len2++] = '_'; - - switch (name [j + 1]) { + if (s[len2 - 1] != '_') + s[len2++] = '_'; + + switch (name[j + 1]) { case '\0': j++; - switch (name [j - 1]) { - case '+': s [len2++] = 'p'; break; /* + */ - case '-': s [len2++] = 'm'; break; /* - */ - case '*': s [len2++] = 't'; break; /* * */ - case '/': s [len2++] = 'd'; break; /* / */ + switch (name[j - 1]) { + case '+': s[len2++] = 'p'; break; /* + */ + case '-': s[len2++] = 'm'; break; /* - */ + case '*': s[len2++] = 't'; break; /* * */ + case '/': s[len2++] = 'd'; break; /* / */ } break; case '=': j++; - switch (name [j - 1]) { - case '+': s [len2++] = 'p'; break; /* += */ - case '-': s [len2++] = 'm'; break; /* -= */ - case '*': s [len2++] = 't'; break; /* *= */ - case '/': s [len2++] = 'd'; break; /* /= */ + switch (name[j - 1]) { + case '+': s[len2++] = 'p'; break; /* += */ + case '-': s[len2++] = 'm'; break; /* -= */ + case '*': s[len2++] = 't'; break; /* *= */ + case '/': s[len2++] = 'd'; break; /* /= */ } - s [len2++] = 'a'; + s[len2++] = 'a'; break; case '-': /* -- */ j++; - s [len2++] = 'm'; - s [len2++] = 'm'; + s[len2++] = 'm'; + s[len2++] = 'm'; break; case '+': /* ++ */ j++; - s [len2++] = 'p'; - s [len2++] = 'p'; + s[len2++] = 'p'; + s[len2++] = 'p'; break; case ')': /* () */ j++; - s [len2++] = 'o'; - s [len2++] = 'p'; + s[len2++] = 'o'; + s[len2++] = 'p'; break; case ']': /* [] */ j++; - s [len2++] = 'o'; - s [len2++] = 'b'; + s[len2++] = 'o'; + s[len2++] = 'b'; break; } @@ -1108,28 +1249,28 @@ case '<': case '>': - c = name [j] == '<' ? 'l' : 'g'; - s [len2++] = '_'; - - switch (name [j + 1]) { + c = name[j] == '<' ? 'l' : 'g'; + s[len2++] = '_'; + + switch (name[j + 1]) { case '\0': - s [len2++] = c; - s [len2++] = 't'; + s[len2++] = c; + s[len2++] = 't'; break; case '=': j++; - s [len2++] = c; - s [len2++] = 'e'; + s[len2++] = c; + s[len2++] = 'e'; break; case '>': j++; - s [len2++] = 's'; - s [len2++] = 'r'; + s[len2++] = 's'; + s[len2++] = 'r'; break; case '<': j++; - s [len2++] = 's'; - s [len2++] = 'l'; + s[len2++] = 's'; + s[len2++] = 'l'; break; default: break; @@ -1137,18 +1278,21 @@ break; case '_': - if (len2 && s [len2 - 1] == '_') - s [len2++] = 'u'; + if (len2 && s[len2 - 1] == '_') + s[len2++] = 'u'; /* fall through */ default: - s [len2++] = name [j]; + s[len2++] = name[j]; } - if (s [len2 - 1] == '_') - s [len2++] = 'u'; - - s [len2] = '\0'; + if (s[len2 - 1] == '_') + s[len2++] = 'u'; + + if (index) + snprintf (&s[len2], INDEX_LENGTH, "_u_%d", index + 1); + else + s[len2] = '\0'; return s; } @@ -1159,44 +1303,34 @@ static bool separate_class_package (tree decl) { - if (decl) - { - tree type = TREE_TYPE (decl); - return type - && TREE_CODE (type) == RECORD_TYPE - && (TYPE_METHODS (type) || has_static_fields (type)); - } - else - return false; + tree type = TREE_TYPE (decl); + return has_nontrivial_methods (type) || has_static_fields (type); } static bool package_prefix = true; /* Dump in BUFFER the name of an identifier NODE of type TYPE, following Ada - syntax. LIMITED_ACCESS indicates whether NODE can be accessed via a limited + syntax. INDEX, if non-zero, is used to disambiguate overloaded names. + LIMITED_ACCESS indicates whether NODE can be accessed via a limited 'with' clause rather than a regular 'with' clause. */ static void pp_ada_tree_identifier (pretty_printer *buffer, tree node, tree type, - int limited_access) + unsigned int index, bool limited_access) { const char *name = IDENTIFIER_POINTER (node); - int space_found = false; - char *s = to_ada_name (name, &space_found); - tree decl; - - /* If the entity is a type and comes from another file, generate "package" - prefix. */ - - decl = get_underlying_decl (type); - + bool space_found = false; + char *s = to_ada_name (name, index, &space_found); + tree decl = get_underlying_decl (type); + + /* If the entity comes from another file, generate a package prefix. */ if (decl) { expanded_location xloc = expand_location (decl_sloc (decl, false)); if (xloc.file && xloc.line) { - if (xloc.file != source_file_base) + if (xloc.file != current_source_file) { switch (TREE_CODE (type)) { @@ -1210,32 +1344,28 @@ case ARRAY_TYPE: case RECORD_TYPE: case UNION_TYPE: - case QUAL_UNION_TYPE: case TYPE_DECL: - { - char *s1 = get_ada_package (xloc.file); - - if (package_prefix) - { - append_withs (s1, limited_access); - pp_string (buffer, s1); - pp_character (buffer, '.'); - } - free (s1); - } + if (package_prefix) + { + char *s1 = get_ada_package (xloc.file); + append_withs (s1, limited_access); + pp_string (buffer, s1); + pp_dot (buffer); + free (s1); + } break; default: break; } - - if (separate_class_package (decl)) - { - pp_string (buffer, "Class_"); - pp_string (buffer, s); - pp_string (buffer, "."); - } - - } + + /* Generate the additional package prefix for C++ classes. */ + if (separate_class_package (decl)) + { + pp_string (buffer, "Class_"); + pp_string (buffer, s); + pp_dot (buffer); + } + } } } @@ -1302,15 +1432,86 @@ pp_string (buffer, ada_name); } +/* Hash table of overloaded names associating identifier nodes with DECL_UIDs. + It is needed in Ada 2005 because we can have at most one import directive + per subprogram name in a given scope, so we have to mangle the subprogram + names on the Ada side to import overloaded subprograms from C++. */ + +struct overloaded_name_hash { + hashval_t hash; + tree name; + tree context; + vec<unsigned int> homonyms; +}; + +struct overloaded_name_hasher : delete_ptr_hash<overloaded_name_hash> +{ + static inline hashval_t hash (overloaded_name_hash *t) + { return t->hash; } + static inline bool equal (overloaded_name_hash *a, overloaded_name_hash *b) + { return a->name == b->name && a->context == b->context; } +}; + +static hash_table<overloaded_name_hasher> *overloaded_names; + +/* Compute the overloading index of function DECL in its context. */ + +static unsigned int +compute_overloading_index (tree decl) +{ + const hashval_t hashcode + = iterative_hash_hashval_t (htab_hash_pointer (DECL_NAME (decl)), + htab_hash_pointer (DECL_CONTEXT (decl))); + struct overloaded_name_hash in, *h, **slot; + unsigned int index, *iter; + + if (!overloaded_names) + overloaded_names = new hash_table<overloaded_name_hasher> (512); + + /* Look up the list of homonyms in the table. */ + in.hash = hashcode; + in.name = DECL_NAME (decl); + in.context = DECL_CONTEXT (decl); + slot = overloaded_names->find_slot_with_hash (&in, hashcode, INSERT); + if (*slot) + h = *slot; + else + { + h = new overloaded_name_hash; + h->hash = hashcode; + h->name = DECL_NAME (decl); + h->context = DECL_CONTEXT (decl); + h->homonyms.create (0); + *slot = h; + } + + /* Look up the function in the list of homonyms. */ + FOR_EACH_VEC_ELT (h->homonyms, index, iter) + if (*iter == DECL_UID (decl)) + break; + + /* If it is not present, push it onto the list. */ + if (!iter) + h->homonyms.safe_push (DECL_UID (decl)); + + return index; +} + /* Dump in BUFFER the name of a DECL node if set, following Ada syntax. LIMITED_ACCESS indicates whether NODE can be accessed via a limited 'with' clause rather than a regular 'with' clause. */ static void -dump_ada_decl_name (pretty_printer *buffer, tree decl, int limited_access) +dump_ada_decl_name (pretty_printer *buffer, tree decl, bool limited_access) { if (DECL_NAME (decl)) - pp_ada_tree_identifier (buffer, DECL_NAME (decl), decl, limited_access); + { + const unsigned int index + = (TREE_CODE (decl) == FUNCTION_DECL && cpp_check) + ? compute_overloading_index (decl) : 0; + pp_ada_tree_identifier (buffer, DECL_NAME (decl), decl, index, + limited_access); + } else { tree type_name = TYPE_NAME (TREE_TYPE (decl)); @@ -1324,34 +1525,48 @@ pp_scalar (buffer, "%d", TYPE_UID (TREE_TYPE (decl))); } else if (TREE_CODE (type_name) == IDENTIFIER_NODE) - pp_ada_tree_identifier (buffer, type_name, decl, limited_access); + pp_ada_tree_identifier (buffer, type_name, decl, 0, limited_access); } } -/* Dump in BUFFER a name based on both T1 and T2, followed by S. */ +/* Dump in BUFFER a name based on both T1 and T2 followed by a suffix. */ static void -dump_ada_double_name (pretty_printer *buffer, tree t1, tree t2, const char *s) +dump_ada_double_name (pretty_printer *buffer, tree t1, tree t2) { if (DECL_NAME (t1)) - pp_ada_tree_identifier (buffer, DECL_NAME (t1), t1, false); + pp_ada_tree_identifier (buffer, DECL_NAME (t1), t1, 0, false); else { pp_string (buffer, "anon"); pp_scalar (buffer, "%d", TYPE_UID (TREE_TYPE (t1))); } - pp_character (buffer, '_'); - - if (DECL_NAME (t1)) - pp_ada_tree_identifier (buffer, DECL_NAME (t2), t2, false); + pp_underscore (buffer); + + if (DECL_NAME (t2)) + pp_ada_tree_identifier (buffer, DECL_NAME (t2), t2, 0, false); else { pp_string (buffer, "anon"); pp_scalar (buffer, "%d", TYPE_UID (TREE_TYPE (t2))); } - pp_string (buffer, s); + switch (TREE_CODE (TREE_TYPE (t2))) + { + case ARRAY_TYPE: + pp_string (buffer, "_array"); + break; + case RECORD_TYPE: + pp_string (buffer, "_struct"); + break; + case UNION_TYPE: + pp_string (buffer, "_union"); + break; + default: + pp_string (buffer, "_unknown"); + break; + } } /* Dump in BUFFER pragma Import C/CPP on a given node T. */ @@ -1365,7 +1580,7 @@ if (is_stdcall) pp_string (buffer, "pragma Import (Stdcall, "); - else if (name [0] == '_' && name [1] == 'Z') + else if (name[0] == '_' && name[1] == 'Z') pp_string (buffer, "pragma Import (CPP, "); else pp_string (buffer, "pragma Import (C, "); @@ -1415,14 +1630,14 @@ IS_DESTRUCTOR whether FUNC is a C++ destructor. SPC is the current indentation level. */ -static int +static void dump_ada_function_declaration (pretty_printer *buffer, tree func, - int is_method, int is_constructor, - int is_destructor, int spc) + bool is_method, bool is_constructor, + bool is_destructor, int spc) { tree arg; const tree node = TREE_TYPE (func); - char buf [16]; + char buf[17]; int num = 0, num_args = 0, have_args = true, have_ellipsis = false; /* Compute number of arguments. */ @@ -1455,7 +1670,7 @@ if (num_args > 0) { pp_space (buffer); - pp_character (buffer, '('); + pp_left_paren (buffer); } if (TREE_CODE (func) == FUNCTION_DECL) @@ -1484,7 +1699,8 @@ if (DECL_NAME (arg)) { check_name (buffer, arg); - pp_ada_tree_identifier (buffer, DECL_NAME (arg), 0, false); + pp_ada_tree_identifier (buffer, DECL_NAME (arg), NULL_TREE, 0, + false); pp_string (buffer, " : "); } else @@ -1493,30 +1709,33 @@ pp_string (buffer, buf); } - dump_generic_ada_node - (buffer, TREE_TYPE (arg), node, NULL, spc, 0, true); + dump_generic_ada_node (buffer, TREE_TYPE (arg), node, spc, 0, true); } else { sprintf (buf, "arg%d : ", num); pp_string (buffer, buf); - dump_generic_ada_node - (buffer, TREE_VALUE (arg), node, NULL, spc, 0, true); + dump_generic_ada_node (buffer, TREE_VALUE (arg), node, spc, 0, true); } - if (TREE_TYPE (arg) && TREE_TYPE (TREE_TYPE (arg)) - && is_tagged_type (TREE_TYPE (TREE_TYPE (arg)))) - { - if (!is_method - || (num != 1 || (!DECL_VINDEX (func) && !is_constructor))) - pp_string (buffer, "'Class"); - } + /* If the type is a pointer to a tagged type, we need to differentiate + virtual methods from the rest (non-virtual methods, static member + or regular functions) and import only them as primitive operations, + because they make up the virtual table which is mirrored on the Ada + side by the dispatch table. So we add 'Class to the type of every + parameter that is not the first one of a method which either has a + slot in the virtual table or is a constructor. */ + if (TREE_TYPE (arg) + && POINTER_TYPE_P (TREE_TYPE (arg)) + && is_tagged_type (TREE_TYPE (TREE_TYPE (arg))) + && !(num == 1 && is_method && (DECL_VINDEX (func) || is_constructor))) + pp_string (buffer, "'Class"); arg = TREE_CHAIN (arg); if (num < num_args) { - pp_character (buffer, ';'); + pp_semicolon (buffer); if (num_args > 2) newline_and_indent (buffer, spc + INDENT_INCR); @@ -1532,8 +1751,14 @@ } if (num_args > 0) - pp_character (buffer, ')'); - return num_args; + pp_right_paren (buffer); + + if (is_constructor || !VOID_TYPE_P (TREE_TYPE (node))) + { + pp_string (buffer, " return "); + tree type = is_constructor ? DECL_CONTEXT (func) : TREE_TYPE (node); + dump_generic_ada_node (buffer, type, type, spc, false, true); + } } /* Dump in BUFFER all the domains associated with an array NODE, @@ -1543,7 +1768,7 @@ dump_ada_array_domains (pretty_printer *buffer, tree node, int spc) { int first = 1; - pp_character (buffer, '('); + pp_left_paren (buffer); for (; TREE_CODE (node) == ARRAY_TYPE; node = TREE_TYPE (node)) { @@ -1559,20 +1784,20 @@ first = 0; if (min) - dump_generic_ada_node (buffer, min, NULL_TREE, NULL, spc, 0, true); + dump_generic_ada_node (buffer, min, NULL_TREE, spc, 0, true); pp_string (buffer, " .. "); /* If the upper bound is zero, gcc may generate a NULL_TREE for TYPE_MAX_VALUE rather than an integer_cst. */ if (max) - dump_generic_ada_node (buffer, max, NULL_TREE, NULL, spc, 0, true); + dump_generic_ada_node (buffer, max, NULL_TREE, spc, 0, true); else pp_string (buffer, "0"); } else pp_string (buffer, "size_t"); } - pp_character (buffer, ')'); + pp_right_paren (buffer); } /* Dump in BUFFER file:line information related to NODE. */ @@ -1584,7 +1809,7 @@ xloc.file = NULL; - if (TREE_CODE_CLASS (TREE_CODE (node)) == tcc_declaration) + if (DECL_P (node)) xloc = expand_location (DECL_SOURCE_LOCATION (node)); else if (EXPR_HAS_LOCATION (node)) xloc = expand_location (EXPR_LOCATION (node)); @@ -1592,7 +1817,7 @@ if (xloc.file) { pp_string (buffer, xloc.file); - pp_string (buffer, ":"); + pp_colon (buffer); pp_decimal_int (buffer, xloc.line); } } @@ -1615,18 +1840,18 @@ tmp = TREE_TYPE (tmp); return num_dim == 1 && TREE_CODE (tmp) == INTEGER_TYPE - && !strcmp (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp))), "char"); + && id_equal (DECL_NAME (TYPE_NAME (tmp)), "char"); } /* Dump in BUFFER an array type T in Ada syntax. Assume that the "type" - keyword and name have already been printed. SPC is the indentation - level. */ + keyword and name have already been printed. PARENT is the parent node of T. + SPC is the indentation level. */ static void -dump_ada_array_type (pretty_printer *buffer, tree t, int spc) +dump_ada_array_type (pretty_printer *buffer, tree t, tree parent, int spc) { + const bool char_array = is_char_array (t); tree tmp; - bool char_array = is_char_array (t); /* Special case char arrays. */ if (char_array) @@ -1639,9 +1864,9 @@ /* Print the dimensions. */ dump_ada_array_domains (buffer, TREE_TYPE (t), spc); - /* Retrieve array's type. */ + /* Retrieve the element type. */ tmp = TREE_TYPE (t); - while (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE) + while (TREE_CODE (tmp) == ARRAY_TYPE) tmp = TREE_TYPE (tmp); /* Print array's type. */ @@ -1649,22 +1874,22 @@ { pp_string (buffer, " of "); - if (TREE_CODE (TREE_TYPE (tmp)) != POINTER_TYPE) + if (TREE_CODE (tmp) != POINTER_TYPE) pp_string (buffer, "aliased "); - dump_generic_ada_node - (buffer, TREE_TYPE (tmp), TREE_TYPE (t), NULL, spc, false, true); + if (TYPE_NAME (tmp) || !RECORD_OR_UNION_TYPE_P (tmp)) + dump_generic_ada_node (buffer, tmp, TREE_TYPE (t), spc, false, true); + else + dump_ada_double_name (buffer, parent, get_underlying_decl (tmp)); } } /* Dump in BUFFER type names associated with a template, each prepended with - '_'. TYPES is the TREE_PURPOSE of a DECL_TEMPLATE_INSTANTIATIONS. - CPP_CHECK is used to perform C++ queries on nodes. - SPC is the indentation level. */ + '_'. TYPES is the TREE_PURPOSE of a DECL_TEMPLATE_INSTANTIATIONS. SPC is + the indentation level. */ static void -dump_template_types (pretty_printer *buffer, tree types, - int (*cpp_check)(tree, cpp_operation), int spc) +dump_template_types (pretty_printer *buffer, tree types, int spc) { size_t i; size_t len = TREE_VEC_LENGTH (types); @@ -1672,8 +1897,8 @@ for (i = 0; i < len; i++) { tree elem = TREE_VEC_ELT (types, i); - pp_character (buffer, '_'); - if (!dump_generic_ada_node (buffer, elem, 0, cpp_check, spc, false, true)) + pp_underscore (buffer); + if (!dump_generic_ada_node (buffer, elem, 0, spc, false, true)) { pp_string (buffer, "unknown"); pp_scalar (buffer, "%lu", (unsigned long) TREE_HASH (elem)); @@ -1681,19 +1906,30 @@ } } -/* Dump in BUFFER the contents of all instantiations associated with a given - template T. CPP_CHECK is used to perform C++ queries on nodes. - SPC is the indentation level. */ +/* Dump in BUFFER the contents of all class instantiations associated with + a given template T. SPC is the indentation level. */ static int -dump_ada_template (pretty_printer *buffer, tree t, - int (*cpp_check)(tree, cpp_operation), int spc) +dump_ada_template (pretty_printer *buffer, tree t, int spc) { - tree inst = DECL_VINDEX (t); - /* DECL_VINDEX is DECL_TEMPLATE_INSTANTIATIONS in this context. */ + /* DECL_SIZE_UNIT is DECL_TEMPLATE_INSTANTIATIONS in this context. */ + tree inst = DECL_SIZE_UNIT (t); + /* This emulates DECL_TEMPLATE_RESULT in this context. */ + struct tree_template_decl { + struct tree_decl_common common; + tree arguments; + tree result; + }; + tree result = ((struct tree_template_decl *) t)->result; int num_inst = 0; - while (inst && inst != error_mark_node) + /* Don't look at template declarations declaring something coming from + another file. This can occur for template friend declarations. */ + if (LOCATION_FILE (decl_sloc (result, false)) + != LOCATION_FILE (decl_sloc (t, false))) + return 0; + + for (; inst && inst != error_mark_node; inst = TREE_CHAIN (inst)) { tree types = TREE_PURPOSE (inst); tree instance = TREE_VALUE (inst); @@ -1701,22 +1937,29 @@ if (TREE_VEC_LENGTH (types) == 0) break; - if (!TYPE_METHODS (instance)) + if (!RECORD_OR_UNION_TYPE_P (instance)) break; + /* We are interested in concrete template instantiations only: skip + partially specialized nodes. */ + if (RECORD_OR_UNION_TYPE_P (instance) + && cpp_check + && cpp_check (instance, HAS_DEPENDENT_TEMPLATE_ARGS)) + continue; + num_inst++; INDENT (spc); pp_string (buffer, "package "); package_prefix = false; - dump_generic_ada_node (buffer, instance, t, cpp_check, spc, false, true); - dump_template_types (buffer, types, cpp_check, spc); + dump_generic_ada_node (buffer, instance, t, spc, false, true); + dump_template_types (buffer, types, spc); pp_string (buffer, " is"); spc += INDENT_INCR; newline_and_indent (buffer, spc); TREE_VISITED (get_underlying_decl (instance)) = 1; pp_string (buffer, "type "); - dump_generic_ada_node (buffer, instance, t, cpp_check, spc, false, true); + dump_generic_ada_node (buffer, instance, t, spc, false, true); package_prefix = true; if (is_tagged_type (instance)) @@ -1724,7 +1967,7 @@ else pp_string (buffer, " is limited "); - dump_generic_ada_node (buffer, instance, t, cpp_check, spc, false, false); + dump_generic_ada_node (buffer, instance, t, spc, false, false); pp_newline (buffer); spc -= INDENT_INCR; newline_and_indent (buffer, spc); @@ -1733,14 +1976,12 @@ newline_and_indent (buffer, spc); pp_string (buffer, "use "); package_prefix = false; - dump_generic_ada_node (buffer, instance, t, cpp_check, spc, false, true); - dump_template_types (buffer, types, cpp_check, spc); + dump_generic_ada_node (buffer, instance, t, spc, false, true); + dump_template_types (buffer, types, spc); package_prefix = true; pp_semicolon (buffer); pp_newline (buffer); pp_newline (buffer); - - inst = TREE_CHAIN (inst); } return num_inst > 0; @@ -1752,7 +1993,7 @@ static bool is_simple_enum (tree node) { - unsigned HOST_WIDE_INT count = 0; + HOST_WIDE_INT count = 0; tree value; for (value = TYPE_VALUES (node); value; value = TREE_CHAIN (value)) @@ -1762,9 +2003,9 @@ if (TREE_CODE (int_val) != INTEGER_CST) int_val = DECL_INITIAL (int_val); - if (!host_integerp (int_val, 0)) + if (!tree_fits_shwi_p (int_val)) return false; - else if (TREE_INT_CST_LOW (int_val) != count) + else if (tree_to_shwi (int_val) != count) return false; count++; @@ -1773,19 +2014,16 @@ return true; } -static bool in_function = true; static bool bitfield_used = false; /* Recursively dump in BUFFER Ada declarations corresponding to NODE of type - TYPE. CPP_CHECK is used to perform C++ queries on nodes. SPC is the - indentation level. LIMITED_ACCESS indicates whether NODE can be referenced - via a "limited with" clause. NAME_ONLY indicates whether we should only - dump the name of NODE, instead of its full declaration. */ + TYPE. SPC is the indentation level. LIMITED_ACCESS indicates whether NODE + can be referenced via a "limited with" clause. NAME_ONLY indicates whether + we should only dump the name of NODE, instead of its full declaration. */ static int -dump_generic_ada_node (pretty_printer *buffer, tree node, tree type, - int (*cpp_check)(tree, cpp_operation), int spc, - int limited_access, bool name_only) +dump_generic_ada_node (pretty_printer *buffer, tree node, tree type, int spc, + bool limited_access, bool name_only) { if (node == NULL_TREE) return 0; @@ -1797,7 +2035,7 @@ return 0; case IDENTIFIER_NODE: - pp_ada_tree_identifier (buffer, node, type, limited_access); + pp_ada_tree_identifier (buffer, node, type, 0, limited_access); break; case TREE_LIST: @@ -1806,8 +2044,8 @@ case TREE_BINFO: dump_generic_ada_node - (buffer, BINFO_TYPE (node), type, cpp_check, - spc, limited_access, name_only); + (buffer, BINFO_TYPE (node), type, spc, limited_access, name_only); + return 0; case TREE_VEC: pp_string (buffer, "--- unexpected node: TREE_VEC"); @@ -1833,8 +2071,7 @@ case ENUMERAL_TYPE: if (name_only) - dump_generic_ada_node - (buffer, TYPE_NAME (node), node, cpp_check, spc, 0, true); + dump_generic_ada_node (buffer, TYPE_NAME (node), node, spc, 0, true); else { tree value = TYPE_VALUES (node); @@ -1844,19 +2081,19 @@ bool first = true; spc += INDENT_INCR; newline_and_indent (buffer, spc - 1); - pp_string (buffer, "("); + pp_left_paren (buffer); for (; value; value = TREE_CHAIN (value)) { if (first) first = false; else { - pp_string (buffer, ","); + pp_comma (buffer); newline_and_indent (buffer, spc); } - pp_ada_tree_identifier - (buffer, TREE_PURPOSE (value), node, false); + pp_ada_tree_identifier (buffer, TREE_PURPOSE (value), node, + 0, false); } pp_string (buffer, ");"); spc -= INDENT_INCR; @@ -1864,31 +2101,34 @@ pp_string (buffer, "pragma Convention (C, "); dump_generic_ada_node (buffer, DECL_NAME (type) ? type : TYPE_NAME (node), type, - cpp_check, spc, 0, true); - pp_string (buffer, ")"); + spc, 0, true); + pp_right_paren (buffer); } else { - pp_string (buffer, "unsigned"); + if (TYPE_UNSIGNED (node)) + pp_string (buffer, "unsigned"); + else + pp_string (buffer, "int"); for (; value; value = TREE_CHAIN (value)) { pp_semicolon (buffer); newline_and_indent (buffer, spc); - pp_ada_tree_identifier - (buffer, TREE_PURPOSE (value), node, false); + pp_ada_tree_identifier (buffer, TREE_PURPOSE (value), node, + 0, false); pp_string (buffer, " : constant "); dump_generic_ada_node (buffer, DECL_NAME (type) ? type : TYPE_NAME (node), type, - cpp_check, spc, 0, true); + spc, 0, true); pp_string (buffer, " := "); dump_generic_ada_node (buffer, TREE_CODE (TREE_VALUE (value)) == INTEGER_CST ? TREE_VALUE (value) : DECL_INITIAL (TREE_VALUE (value)), - node, cpp_check, spc, false, true); + node, spc, false, true); } } } @@ -1906,8 +2146,8 @@ if (tclass == tcc_declaration) { if (DECL_NAME (node)) - pp_ada_tree_identifier - (buffer, DECL_NAME (node), 0, limited_access); + pp_ada_tree_identifier (buffer, DECL_NAME (node), NULL_TREE, 0, + limited_access); else pp_string (buffer, "<unnamed type decl>"); } @@ -1916,8 +2156,8 @@ if (TYPE_NAME (node)) { if (TREE_CODE (TYPE_NAME (node)) == IDENTIFIER_NODE) - pp_ada_tree_identifier (buffer, TYPE_NAME (node), - node, limited_access); + pp_ada_tree_identifier (buffer, TYPE_NAME (node), node, 0, + limited_access); else if (TREE_CODE (TYPE_NAME (node)) == TYPE_DECL && DECL_NAME (TYPE_NAME (node))) dump_ada_decl_name (buffer, TYPE_NAME (node), limited_access); @@ -1947,33 +2187,29 @@ case POINTER_TYPE: case REFERENCE_TYPE: - if (TREE_CODE (TREE_TYPE (node)) == FUNCTION_TYPE) + if (name_only && TYPE_NAME (node)) + dump_generic_ada_node + (buffer, TYPE_NAME (node), node, spc, limited_access, true); + + else if (TREE_CODE (TREE_TYPE (node)) == FUNCTION_TYPE) { - tree fnode = TREE_TYPE (node); - bool is_function; - bool prev_in_function = in_function; - - if (VOID_TYPE_P (TREE_TYPE (fnode))) - { - is_function = false; - pp_string (buffer, "access procedure"); - } + if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (node)))) + pp_string (buffer, "access procedure "); else - { - is_function = true; - pp_string (buffer, "access function"); - } - - in_function = is_function; + pp_string (buffer, "access function "); + dump_ada_function_declaration (buffer, node, false, false, false, spc + INDENT_INCR); - in_function = prev_in_function; - - if (is_function) + + /* If we are dumping the full type, it means we are part of a + type definition and need also a Convention C pragma. */ + if (!name_only) { - pp_string (buffer, " return "); - dump_generic_ada_node - (buffer, TREE_TYPE (fnode), type, cpp_check, spc, 0, true); + pp_semicolon (buffer); + newline_and_indent (buffer, spc); + pp_string (buffer, "pragma Convention (C, "); + dump_generic_ada_node (buffer, type, 0, spc, false, true); + pp_right_paren (buffer); } } else @@ -1981,11 +2217,7 @@ int is_access = false; unsigned int quals = TYPE_QUALS (TREE_TYPE (node)); - if (name_only && TYPE_NAME (node)) - dump_generic_ada_node - (buffer, TYPE_NAME (node), node, cpp_check, - spc, limited_access, true); - else if (VOID_TYPE_P (TREE_TYPE (node))) + if (VOID_TYPE_P (TREE_TYPE (node))) { if (!name_only) pp_string (buffer, "new "); @@ -2018,37 +2250,25 @@ } else { - /* For now, handle all access-to-access or - access-to-unknown-structs as opaque system.address. */ - tree type_name = TYPE_NAME (TREE_TYPE (node)); - const_tree typ2 = !type || - DECL_P (type) ? type : TYPE_NAME (type); - const_tree underlying_type = - get_underlying_decl (TREE_TYPE (node)); - + tree decl = get_underlying_decl (TREE_TYPE (node)); + tree enclosing_decl = get_underlying_decl (type); + + /* For now, handle access-to-access, access-to-empty-struct + or access-to-incomplete as opaque system.address. */ if (TREE_CODE (TREE_TYPE (node)) == POINTER_TYPE - /* Pointer to pointer. */ - || (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node)) - && (!underlying_type - || !TYPE_FIELDS (TREE_TYPE (underlying_type)))) - /* Pointer to opaque structure. */ - - || underlying_type == NULL_TREE - || (!typ2 - && !TREE_VISITED (underlying_type) - && !TREE_VISITED (type_name) - && !is_tagged_type (TREE_TYPE (node)) - && DECL_SOURCE_FILE (underlying_type) - == source_file_base) - || (type_name && typ2 - && DECL_P (underlying_type) - && DECL_P (typ2) - && decl_sloc (underlying_type, true) - > decl_sloc (typ2, true) - && DECL_SOURCE_FILE (underlying_type) - == DECL_SOURCE_FILE (typ2))) + && !TYPE_FIELDS (TREE_TYPE (node))) + || !decl + || (!enclosing_decl + && !TREE_VISITED (decl) + && DECL_SOURCE_FILE (decl) == current_source_file) + || (enclosing_decl + && !TREE_VISITED (decl) + && DECL_SOURCE_FILE (decl) + == DECL_SOURCE_FILE (enclosing_decl) + && decl_sloc (decl, true) + > decl_sloc (enclosing_decl, true))) { if (package_prefix) { @@ -2078,11 +2298,6 @@ } else if (quals & TYPE_QUAL_CONST) pp_string (buffer, "in "); - else if (in_function) - { - is_access = true; - pp_string (buffer, "access "); - } else { is_access = true; @@ -2099,15 +2314,12 @@ pp_string (buffer, "all "); } - if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node)) - && type_name != NULL_TREE) - dump_generic_ada_node - (buffer, type_name, - TREE_TYPE (node), cpp_check, spc, is_access, true); + if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node)) && type_name) + dump_generic_ada_node (buffer, type_name, TREE_TYPE (node), + spc, is_access, true); else - dump_generic_ada_node - (buffer, TREE_TYPE (node), TREE_TYPE (node), - cpp_check, spc, 0, true); + dump_generic_ada_node (buffer, TREE_TYPE (node), + TREE_TYPE (node), spc, 0, true); } } } @@ -2116,21 +2328,18 @@ case ARRAY_TYPE: if (name_only) dump_generic_ada_node - (buffer, TYPE_NAME (node), node, cpp_check, - spc, limited_access, true); + (buffer, TYPE_NAME (node), node, spc, limited_access, true); else - dump_ada_array_type (buffer, node, spc); + dump_ada_array_type (buffer, node, type, spc); break; case RECORD_TYPE: case UNION_TYPE: - case QUAL_UNION_TYPE: if (name_only) { if (TYPE_NAME (node)) dump_generic_ada_node - (buffer, TYPE_NAME (node), node, cpp_check, - spc, limited_access, true); + (buffer, TYPE_NAME (node), node, spc, limited_access, true); else { pp_string (buffer, "anon_"); @@ -2138,35 +2347,36 @@ } } else - print_ada_struct_decl - (buffer, node, type, cpp_check, spc, true); + dump_ada_struct_decl (buffer, node, type, spc, true); break; case INTEGER_CST: - if (TREE_CODE (TREE_TYPE (node)) == POINTER_TYPE) - { - pp_wide_integer (buffer, TREE_INT_CST_LOW (node)); - pp_string (buffer, "B"); /* pseudo-unit */ - } - else if (!host_integerp (node, 0)) + /* We treat the upper half of the sizetype range as negative. This + is consistent with the internal treatment and makes it possible + to generate the (0 .. -1) range for flexible array members. */ + if (TREE_TYPE (node) == sizetype) + node = fold_convert (ssizetype, node); + if (tree_fits_shwi_p (node)) + pp_wide_integer (buffer, tree_to_shwi (node)); + else if (tree_fits_uhwi_p (node)) + pp_unsigned_wide_integer (buffer, tree_to_uhwi (node)); + else { - tree val = node; - unsigned HOST_WIDE_INT low = TREE_INT_CST_LOW (val); - HOST_WIDE_INT high = TREE_INT_CST_HIGH (val); - - if (tree_int_cst_sgn (val) < 0) + wide_int val = wi::to_wide (node); + int i; + if (wi::neg_p (val)) { - pp_character (buffer, '-'); - high = ~high + !low; - low = -low; + pp_minus (buffer); + val = -val; } sprintf (pp_buffer (buffer)->digit_buffer, - HOST_WIDE_INT_PRINT_DOUBLE_HEX, - (unsigned HOST_WIDE_INT) high, low); + "16#%" HOST_WIDE_INT_PRINT "x", + val.elt (val.get_len () - 1)); + for (i = val.get_len () - 2; i >= 0; i--) + sprintf (pp_buffer (buffer)->digit_buffer, + HOST_WIDE_INT_PRINT_PADDED_HEX, val.elt (i)); pp_string (buffer, pp_buffer (buffer)->digit_buffer); } - else - pp_wide_integer (buffer, TREE_INT_CST_LOW (node)); break; case REAL_CST: @@ -2176,11 +2386,6 @@ case VECTOR_CST: return 0; - case FUNCTION_DECL: - case CONST_DECL: - dump_ada_decl_name (buffer, node, limited_access); - break; - case TYPE_DECL: if (DECL_IS_BUILTIN (node)) { @@ -2207,13 +2412,14 @@ { if (is_tagged_type (TREE_TYPE (node))) { - tree tmp = TYPE_FIELDS (TREE_TYPE (node)); int first = 1; /* Look for ancestors. */ - for (; tmp; tmp = TREE_CHAIN (tmp)) + for (tree fld = TYPE_FIELDS (TREE_TYPE (node)); + fld; + fld = TREE_CHAIN (fld)) { - if (!DECL_NAME (tmp) && is_tagged_type (TREE_TYPE (tmp))) + if (!DECL_NAME (fld) && is_tagged_type (TREE_TYPE (fld))) { if (first) { @@ -2223,22 +2429,23 @@ else pp_string (buffer, " and "); - dump_ada_decl_name - (buffer, TYPE_NAME (TREE_TYPE (tmp)), false); + dump_ada_decl_name (buffer, TYPE_NAME (TREE_TYPE (fld)), + false); } } pp_string (buffer, first ? "tagged limited " : " with "); } - else if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node)) - && TYPE_METHODS (TREE_TYPE (node))) + else if (has_nontrivial_methods (TREE_TYPE (node))) pp_string (buffer, "limited "); dump_generic_ada_node - (buffer, TREE_TYPE (node), type, cpp_check, spc, false, false); + (buffer, TREE_TYPE (node), type, spc, false, false); } break; + case FUNCTION_DECL: + case CONST_DECL: case VAR_DECL: case PARM_DECL: case FIELD_DECL: @@ -2254,235 +2461,232 @@ return 1; } -/* Dump in BUFFER NODE's methods. CPP_CHECK is used to perform C++ queries on - nodes. SPC is the indentation level. */ - -static void -print_ada_methods (pretty_printer *buffer, tree node, - int (*cpp_check)(tree, cpp_operation), int spc) +/* Dump in BUFFER NODE's methods. SPC is the indentation level. Return 1 if + methods were printed, 0 otherwise. */ + +static int +dump_ada_methods (pretty_printer *buffer, tree node, int spc) { - tree tmp = TYPE_METHODS (node); + if (!has_nontrivial_methods (node)) + return 0; + + pp_semicolon (buffer); + int res = 1; - - if (tmp) - { - pp_semicolon (buffer); - - for (; tmp; tmp = TREE_CHAIN (tmp)) - { - if (res) - { - pp_newline (buffer); - pp_newline (buffer); - } - res = print_ada_declaration (buffer, tmp, node, cpp_check, spc); - } - } + for (tree fld = TYPE_FIELDS (node); fld; fld = DECL_CHAIN (fld)) + if (TREE_CODE (fld) == FUNCTION_DECL) + { + if (res) + { + pp_newline (buffer); + pp_newline (buffer); + } + + res = dump_ada_declaration (buffer, fld, node, spc); + } + + return 1; } +static void dump_nested_type (pretty_printer *, tree, tree, tree, int); + /* Dump in BUFFER anonymous types nested inside T's definition. PARENT is the parent node of T. FORWARD indicates whether a forward declaration of T should be generated. - CPP_CHECK is used to perform C++ queries on - nodes. SPC is the indentation level. */ + SPC is the indentation level. + + In C anonymous nested tagged types have no name whereas in C++ they have + one. In C their TYPE_DECL is at top level whereas in C++ it is nested. + In both languages untagged types (pointers and arrays) have no name. + In C++ the nested TYPE_DECLs can come after their associated FIELD_DECL. + + Therefore, in order to have a common processing for both languages, we + disregard anonymous TYPE_DECLs at top level and here we make a first + pass on the nested TYPE_DECLs and a second pass on the unnamed types. */ static void dump_nested_types (pretty_printer *buffer, tree t, tree parent, bool forward, - int (*cpp_check)(tree, cpp_operation), int spc) + int spc) { - tree field, outer, decl; + tree type, field; /* Avoid recursing over the same tree. */ if (TREE_VISITED (t)) return; - /* Find possible anonymous arrays/unions/structs recursively. */ - - outer = TREE_TYPE (t); - - if (outer == NULL_TREE) + /* Find possible anonymous pointers/arrays/structs/unions recursively. */ + type = TREE_TYPE (t); + if (type == NULL_TREE) return; if (forward) { pp_string (buffer, "type "); - dump_generic_ada_node - (buffer, t, t, cpp_check, spc, false, true); + dump_generic_ada_node (buffer, t, t, spc, false, true); pp_semicolon (buffer); newline_and_indent (buffer, spc); TREE_VISITED (t) = 1; } - field = TYPE_FIELDS (outer); - while (field) + for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field)) + if (TREE_CODE (field) == TYPE_DECL + && DECL_NAME (field) != DECL_NAME (t) + && TYPE_NAME (TREE_TYPE (field)) != TYPE_NAME (type)) + dump_nested_type (buffer, field, t, parent, spc); + + for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field)) + if (TREE_CODE (field) == FIELD_DECL && !TYPE_NAME (TREE_TYPE (field))) + dump_nested_type (buffer, field, t, parent, spc); + + TREE_VISITED (t) = 1; +} + +/* Dump in BUFFER the anonymous type of FIELD inside T. + PARENT is the parent node of T. + FORWARD indicates whether a forward declaration of T should be generated. + SPC is the indentation level. */ + +static void +dump_nested_type (pretty_printer *buffer, tree field, tree t, tree parent, + int spc) +{ + tree field_type = TREE_TYPE (field); + tree decl, tmp; + + switch (TREE_CODE (field_type)) { - if ((TREE_TYPE (field) != outer - || (TREE_CODE (TREE_TYPE (field)) == POINTER_TYPE - && TREE_TYPE (TREE_TYPE (field)) != outer)) - && (!TYPE_NAME (TREE_TYPE (field)) - || (TREE_CODE (field) == TYPE_DECL - && DECL_NAME (field) != DECL_NAME (t) - && TYPE_NAME (TREE_TYPE (field)) != TYPE_NAME (outer)))) + case POINTER_TYPE: + tmp = TREE_TYPE (field_type); + + if (TREE_CODE (tmp) == FUNCTION_TYPE) + for (tmp = TREE_TYPE (tmp); + tmp && TREE_CODE (tmp) == POINTER_TYPE; + tmp = TREE_TYPE (tmp)) + ; + + decl = get_underlying_decl (tmp); + if (decl + && !DECL_IS_BUILTIN (decl) + && (!RECORD_OR_UNION_TYPE_P (TREE_TYPE (decl)) + || TYPE_FIELDS (TREE_TYPE (decl))) + && !TREE_VISITED (decl) + && DECL_SOURCE_FILE (decl) == DECL_SOURCE_FILE (t) + && decl_sloc (decl, true) > decl_sloc (t, true)) + { + /* Generate forward declaration. */ + pp_string (buffer, "type "); + dump_generic_ada_node (buffer, decl, 0, spc, false, true); + pp_semicolon (buffer); + newline_and_indent (buffer, spc); + TREE_VISITED (decl) = 1; + } + break; + + case ARRAY_TYPE: + tmp = TREE_TYPE (field_type); + while (TREE_CODE (tmp) == ARRAY_TYPE) + tmp = TREE_TYPE (tmp); + decl = get_underlying_decl (tmp); + if (decl && !DECL_NAME (decl) && !TREE_VISITED (decl)) { - switch (TREE_CODE (TREE_TYPE (field))) + /* Generate full declaration. */ + dump_nested_type (buffer, decl, t, parent, spc); + TREE_VISITED (decl) = 1; + } + + /* Special case char arrays. */ + if (is_char_array (field)) + pp_string (buffer, "sub"); + + pp_string (buffer, "type "); + dump_ada_double_name (buffer, parent, field); + pp_string (buffer, " is "); + dump_ada_array_type (buffer, field, parent, spc); + pp_semicolon (buffer); + newline_and_indent (buffer, spc); + break; + + case RECORD_TYPE: + case UNION_TYPE: + if (TYPE_NAME (TREE_TYPE (t)) && !TREE_VISITED (t)) + { + pp_string (buffer, "type "); + dump_generic_ada_node (buffer, t, parent, spc, false, true); + pp_semicolon (buffer); + newline_and_indent (buffer, spc); + } + + TREE_VISITED (t) = 1; + dump_nested_types (buffer, field, t, false, spc); + + pp_string (buffer, "type "); + + if (TYPE_NAME (field_type)) + { + dump_generic_ada_node (buffer, field_type, 0, spc, false, true); + if (TREE_CODE (field_type) == UNION_TYPE) + pp_string (buffer, " (discr : unsigned := 0)"); + pp_string (buffer, " is "); + dump_ada_struct_decl (buffer, field_type, t, spc, false); + + pp_string (buffer, "pragma Convention (C_Pass_By_Copy, "); + dump_generic_ada_node (buffer, field_type, 0, spc, false, true); + pp_string (buffer, ");"); + newline_and_indent (buffer, spc); + + if (TREE_CODE (field_type) == UNION_TYPE) { - case POINTER_TYPE: - decl = TREE_TYPE (TREE_TYPE (field)); - - if (TREE_CODE (decl) == FUNCTION_TYPE) - for (decl = TREE_TYPE (decl); - decl && TREE_CODE (decl) == POINTER_TYPE; - decl = TREE_TYPE (decl)); - - decl = get_underlying_decl (decl); - - if (decl - && DECL_P (decl) - && decl_sloc (decl, true) > decl_sloc (t, true) - && DECL_SOURCE_FILE (decl) == DECL_SOURCE_FILE (t) - && !TREE_VISITED (decl) - && !DECL_IS_BUILTIN (decl) - && (!RECORD_OR_UNION_TYPE_P (TREE_TYPE (decl)) - || TYPE_FIELDS (TREE_TYPE (decl)))) - { - /* Generate forward declaration. */ - - pp_string (buffer, "type "); - dump_generic_ada_node - (buffer, decl, 0, cpp_check, spc, false, true); - pp_semicolon (buffer); - newline_and_indent (buffer, spc); - - /* Ensure we do not generate duplicate forward - declarations for this type. */ - TREE_VISITED (decl) = 1; - } - break; - - case ARRAY_TYPE: - /* Special case char arrays. */ - if (is_char_array (field)) - pp_string (buffer, "sub"); - - pp_string (buffer, "type "); - dump_ada_double_name (buffer, parent, field, "_array is "); - dump_ada_array_type (buffer, field, spc); - pp_semicolon (buffer); - newline_and_indent (buffer, spc); - break; - - case UNION_TYPE: - TREE_VISITED (t) = 1; - dump_nested_types (buffer, field, t, false, cpp_check, spc); - - pp_string (buffer, "type "); - - if (TYPE_NAME (TREE_TYPE (field))) - { - dump_generic_ada_node - (buffer, TYPE_NAME (TREE_TYPE (field)), 0, cpp_check, - spc, false, true); - pp_string (buffer, " (discr : unsigned := 0) is "); - print_ada_struct_decl - (buffer, TREE_TYPE (field), t, cpp_check, spc, false); - - pp_string (buffer, "pragma Convention (C_Pass_By_Copy, "); - dump_generic_ada_node - (buffer, TREE_TYPE (field), 0, cpp_check, - spc, false, true); - pp_string (buffer, ");"); - newline_and_indent (buffer, spc); - - pp_string (buffer, "pragma Unchecked_Union ("); - dump_generic_ada_node - (buffer, TREE_TYPE (field), 0, cpp_check, - spc, false, true); - pp_string (buffer, ");"); - } - else - { - dump_ada_double_name - (buffer, parent, field, - "_union (discr : unsigned := 0) is "); - print_ada_struct_decl - (buffer, TREE_TYPE (field), t, cpp_check, spc, false); - pp_string (buffer, "pragma Convention (C_Pass_By_Copy, "); - dump_ada_double_name (buffer, parent, field, "_union);"); - newline_and_indent (buffer, spc); - - pp_string (buffer, "pragma Unchecked_Union ("); - dump_ada_double_name (buffer, parent, field, "_union);"); - } - - newline_and_indent (buffer, spc); - break; - - case RECORD_TYPE: - if (TYPE_NAME (TREE_TYPE (t)) && !TREE_VISITED (t)) - { - pp_string (buffer, "type "); - dump_generic_ada_node - (buffer, t, parent, 0, spc, false, true); - pp_semicolon (buffer); - newline_and_indent (buffer, spc); - } - - TREE_VISITED (t) = 1; - dump_nested_types (buffer, field, t, false, cpp_check, spc); - pp_string (buffer, "type "); - - if (TYPE_NAME (TREE_TYPE (field))) - { - dump_generic_ada_node - (buffer, TREE_TYPE (field), 0, cpp_check, - spc, false, true); - pp_string (buffer, " is "); - print_ada_struct_decl - (buffer, TREE_TYPE (field), t, cpp_check, spc, false); - pp_string (buffer, "pragma Convention (C_Pass_By_Copy, "); - dump_generic_ada_node - (buffer, TREE_TYPE (field), 0, cpp_check, - spc, false, true); - pp_string (buffer, ");"); - } - else - { - dump_ada_double_name - (buffer, parent, field, "_struct is "); - print_ada_struct_decl - (buffer, TREE_TYPE (field), t, cpp_check, spc, false); - pp_string (buffer, "pragma Convention (C_Pass_By_Copy, "); - dump_ada_double_name (buffer, parent, field, "_struct);"); - } - - newline_and_indent (buffer, spc); - break; - - default: - break; + pp_string (buffer, "pragma Unchecked_Union ("); + dump_generic_ada_node (buffer, field_type, 0, spc, false, true); + pp_string (buffer, ");"); } } - field = TREE_CHAIN (field); + else + { + dump_ada_double_name (buffer, parent, field); + if (TREE_CODE (field_type) == UNION_TYPE) + pp_string (buffer, " (discr : unsigned := 0)"); + pp_string (buffer, " is "); + dump_ada_struct_decl (buffer, field_type, t, spc, false); + + pp_string (buffer, "pragma Convention (C_Pass_By_Copy, "); + dump_ada_double_name (buffer, parent, field); + pp_string (buffer, ");"); + newline_and_indent (buffer, spc); + + if (TREE_CODE (field_type) == UNION_TYPE) + { + pp_string (buffer, "pragma Unchecked_Union ("); + dump_ada_double_name (buffer, parent, field); + pp_string (buffer, ");"); + } + } + + default: + break; } - - TREE_VISITED (t) = 1; +} + +/* Dump in BUFFER constructor spec corresponding to T for TYPE. */ + +static void +print_constructor (pretty_printer *buffer, tree t, tree type) +{ + tree decl_name = DECL_NAME (TYPE_NAME (type)); + + pp_string (buffer, "New_"); + pp_ada_tree_identifier (buffer, decl_name, t, 0, false); } /* Dump in BUFFER destructor spec corresponding to T. */ static void -print_destructor (pretty_printer *buffer, tree t) +print_destructor (pretty_printer *buffer, tree t, tree type) { - const char *s = IDENTIFIER_POINTER (DECL_NAME (t)); - - if (*s == '_') - for (s += 2; *s != ' '; s++) - pp_character (buffer, *s); - else - { - pp_string (buffer, "Delete_"); - pp_ada_tree_identifier (buffer, DECL_NAME (t), t, false); - } + tree decl_name = DECL_NAME (TYPE_NAME (type)); + + pp_string (buffer, "Delete_"); + pp_ada_tree_identifier (buffer, decl_name, t, 0, false); } /* Return the name of type T. */ @@ -2498,23 +2702,21 @@ return IDENTIFIER_POINTER (DECL_NAME (n)); } -/* Print in BUFFER the declaration of a variable T of type TYPE in Ada syntax. - CPP_CHECK is used to perform C++ queries on nodes. SPC is the indentation - level. Return 1 if a declaration was printed, 0 otherwise. */ +/* Dump in BUFFER the declaration of a variable T of type TYPE in Ada syntax. + SPC is the indentation level. Return 1 if a declaration was printed, + 0 otherwise. */ static int -print_ada_declaration (pretty_printer *buffer, tree t, tree type, - int (*cpp_check)(tree, cpp_operation), int spc) +dump_ada_declaration (pretty_printer *buffer, tree t, tree type, int spc) { int is_var = 0, need_indent = 0; int is_class = false; tree name = TYPE_NAME (TREE_TYPE (t)); tree decl_name = DECL_NAME (t); - bool dump_internal = get_dump_file_info (TDI_ada)->flags & TDF_RAW; tree orig = NULL_TREE; if (cpp_check && cpp_check (t, IS_TEMPLATE)) - return dump_ada_template (buffer, t, cpp_check, spc); + return dump_ada_template (buffer, t, spc); if (TREE_CODE (t) == CONST_DECL && TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE) /* Skip enumeral values: will be handled as part of the type itself. */ @@ -2535,71 +2737,49 @@ casing), then ignore the second type. */ if (type_name (typ) == type_name (TREE_TYPE (t)) || !strcasecmp (type_name (typ), type_name (TREE_TYPE (t)))) - return 0; + { + TREE_VISITED (t) = 1; + return 0; + } INDENT (spc); if (RECORD_OR_UNION_TYPE_P (typ) && !TYPE_FIELDS (typ)) { pp_string (buffer, "-- skipped empty struct "); - dump_generic_ada_node (buffer, t, type, 0, spc, false, true); + dump_generic_ada_node (buffer, t, type, spc, false, true); } else { - if (!TREE_VISITED (stub) - && DECL_SOURCE_FILE (stub) == source_file_base) - dump_nested_types - (buffer, stub, stub, true, cpp_check, spc); + if (RECORD_OR_UNION_TYPE_P (typ) + && DECL_SOURCE_FILE (stub) == current_source_file) + dump_nested_types (buffer, stub, stub, true, spc); pp_string (buffer, "subtype "); - dump_generic_ada_node (buffer, t, type, 0, spc, false, true); + dump_generic_ada_node (buffer, t, type, spc, false, true); pp_string (buffer, " is "); - dump_generic_ada_node - (buffer, typ, type, 0, spc, false, true); - pp_semicolon (buffer); + dump_generic_ada_node (buffer, typ, type, spc, false, true); + pp_string (buffer, "; -- "); + dump_sloc (buffer, t); } + + TREE_VISITED (t) = 1; return 1; } } /* Skip unnamed or anonymous structs/unions/enum types. */ - if (!orig && !decl_name && !name) - { - tree tmp; - location_t sloc; - - if (cpp_check || TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE) - return 0; - - if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t))) - { - /* Search next items until finding a named type decl. */ - sloc = decl_sloc_common (t, true, true); - - for (tmp = TREE_CHAIN (t); tmp; tmp = TREE_CHAIN (tmp)) - { - if (TREE_CODE (tmp) == TYPE_DECL - && (DECL_NAME (tmp) || TYPE_NAME (TREE_TYPE (tmp)))) - { - /* If same sloc, it means we can ignore the anonymous - struct. */ - if (decl_sloc_common (tmp, true, true) == sloc) - return 0; - else - break; - } - } - if (tmp == NULL) - return 0; - } - } - + if (!orig && !decl_name && !name + && (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t)) + || TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE)) + return 0; + + /* Skip anonymous enum types (duplicates of real types). */ if (!orig && TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE && decl_name && (*IDENTIFIER_POINTER (decl_name) == '.' || *IDENTIFIER_POINTER (decl_name) == '$')) - /* Skip anonymous enum types (duplicates of real types). */ return 0; INDENT (spc); @@ -2608,13 +2788,12 @@ { case RECORD_TYPE: case UNION_TYPE: - case QUAL_UNION_TYPE: /* Skip empty structs (typically forward references to real structs). */ if (!TYPE_FIELDS (TREE_TYPE (t))) { pp_string (buffer, "-- skipped empty struct "); - dump_generic_ada_node (buffer, t, type, 0, spc, false, true); + dump_generic_ada_node (buffer, t, type, spc, false, true); return 1; } @@ -2623,7 +2802,7 @@ || *IDENTIFIER_POINTER (decl_name) == '$')) { pp_string (buffer, "-- skipped anonymous struct "); - dump_generic_ada_node (buffer, t, type, 0, spc, false, true); + dump_generic_ada_node (buffer, t, type, spc, false, true); TREE_VISITED (t) = 1; return 1; } @@ -2632,14 +2811,13 @@ pp_string (buffer, "subtype "); else { - dump_nested_types (buffer, t, t, false, cpp_check, spc); + dump_nested_types (buffer, t, t, false, spc); if (separate_class_package (t)) { is_class = true; pp_string (buffer, "package Class_"); - dump_generic_ada_node - (buffer, t, type, 0, spc, false, true); + dump_generic_ada_node (buffer, t, type, spc, false, true); pp_string (buffer, " is"); spc += INDENT_INCR; newline_and_indent (buffer, spc); @@ -2661,9 +2839,8 @@ case FUNCTION_TYPE: pp_string (buffer, "-- skipped function type "); - dump_generic_ada_node (buffer, t, type, 0, spc, false, true); + dump_generic_ada_node (buffer, t, type, spc, false, true); return 1; - break; case ENUMERAL_TYPE: if ((orig && TYPE_NAME (orig) && orig != TREE_TYPE (t)) @@ -2680,8 +2857,7 @@ } else { - if (!dump_internal - && TREE_CODE (t) == VAR_DECL + if (VAR_P (t) && decl_name && *IDENTIFIER_POINTER (decl_name) == '_') return 0; @@ -2696,7 +2872,7 @@ INDENT (spc); /* Print variable's name. */ - dump_generic_ada_node (buffer, t, type, cpp_check, spc, false, true); + dump_generic_ada_node (buffer, t, type, spc, false, true); if (TREE_CODE (t) == TYPE_DECL) { @@ -2704,10 +2880,9 @@ if (orig && TYPE_NAME (orig) && orig != TREE_TYPE (t)) dump_generic_ada_node - (buffer, TYPE_NAME (orig), type, - cpp_check, spc, false, true); + (buffer, TYPE_NAME (orig), type, spc, false, true); else - dump_ada_array_type (buffer, t, spc); + dump_ada_array_type (buffer, t, type, spc); } else { @@ -2718,34 +2893,27 @@ pp_string (buffer, " : "); + if (TREE_CODE (TREE_TYPE (TREE_TYPE (t))) != POINTER_TYPE) + pp_string (buffer, "aliased "); + if (tmp) - { - if (TREE_CODE (TREE_TYPE (tmp)) != POINTER_TYPE - && TREE_CODE (tmp) != INTEGER_TYPE) - pp_string (buffer, "aliased "); - - dump_generic_ada_node (buffer, tmp, type, 0, spc, false, true); - } + dump_generic_ada_node (buffer, tmp, type, spc, false, true); + else if (type) + dump_ada_double_name (buffer, type, t); else - { - pp_string (buffer, "aliased "); - - if (!type) - dump_ada_array_type (buffer, t, spc); - else - dump_ada_double_name (buffer, type, t, "_array"); - } + dump_ada_array_type (buffer, t, type, spc); } } else if (TREE_CODE (t) == FUNCTION_DECL) { - bool is_function = true, is_method, is_abstract_class = false; + bool is_abstract_class = false; + bool is_method = TREE_CODE (TREE_TYPE (t)) == METHOD_TYPE; tree decl_name = DECL_NAME (t); - int prev_in_function = in_function; bool is_abstract = false; bool is_constructor = false; bool is_destructor = false; bool is_copy_constructor = false; + bool is_move_constructor = false; if (!decl_name) return 0; @@ -2756,27 +2924,29 @@ is_constructor = cpp_check (t, IS_CONSTRUCTOR); is_destructor = cpp_check (t, IS_DESTRUCTOR); is_copy_constructor = cpp_check (t, IS_COPY_CONSTRUCTOR); + is_move_constructor = cpp_check (t, IS_MOVE_CONSTRUCTOR); } - /* Skip __comp_dtor destructor which is redundant with the '~class()' - destructor. */ - if (is_destructor - && !strncmp (IDENTIFIER_POINTER (decl_name), "__comp", 6)) + /* Skip copy constructors and C++11 move constructors: some are internal + only and those that are not cannot be called easily from Ada. */ + if (is_copy_constructor || is_move_constructor) return 0; - /* Skip copy constructors: some are internal only, and those that are - not cannot be called easily from Ada anyway. */ - if (is_copy_constructor) - return 0; - - /* If this function has an entry in the dispatch table, we cannot - omit it. */ - if (!dump_internal && !DECL_VINDEX (t) - && *IDENTIFIER_POINTER (decl_name) == '_') + if (is_constructor || is_destructor) { - if (IDENTIFIER_POINTER (decl_name)[1] == '_') + /* ??? Skip implicit constructors/destructors for now. */ + if (DECL_ARTIFICIAL (t)) return 0; + /* Only consider constructors/destructors for complete objects. */ + if (strncmp (IDENTIFIER_POINTER (decl_name), "__ct_comp", 9) != 0 + && strncmp (IDENTIFIER_POINTER (decl_name), "__dt_comp", 9) != 0) + return 0; + } + + /* If this function has an entry in the vtable, we cannot omit it. */ + else if (!DECL_VINDEX (t) && *IDENTIFIER_POINTER (decl_name) == '_') + { INDENT (spc); pp_string (buffer, "-- skipped func "); pp_string (buffer, IDENTIFIER_POINTER (decl_name)); @@ -2786,57 +2956,28 @@ if (need_indent) INDENT (spc); - if (is_constructor) - pp_string (buffer, "function New_"); - else if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t)))) - { - is_function = false; - pp_string (buffer, "procedure "); - } + if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t))) && !is_constructor) + pp_string (buffer, "procedure "); else pp_string (buffer, "function "); - in_function = is_function; - is_method = TREE_CODE (TREE_TYPE (t)) == METHOD_TYPE; - - if (is_destructor) - print_destructor (buffer, t); + if (is_constructor) + print_constructor (buffer, t, type); + else if (is_destructor) + print_destructor (buffer, t, type); else dump_ada_decl_name (buffer, t, false); dump_ada_function_declaration (buffer, t, is_method, is_constructor, is_destructor, spc); - in_function = prev_in_function; - - if (is_function) - { - pp_string (buffer, " return "); - - if (is_constructor) + + if (is_constructor && RECORD_OR_UNION_TYPE_P (type)) + for (tree fld = TYPE_FIELDS (type); fld; fld = DECL_CHAIN (fld)) + if (TREE_CODE (fld) == FUNCTION_DECL && cpp_check (fld, IS_ABSTRACT)) { - dump_ada_decl_name (buffer, t, false); - } - else - { - dump_generic_ada_node - (buffer, TREE_TYPE (TREE_TYPE (t)), type, cpp_check, - spc, false, true); + is_abstract_class = true; + break; } - } - - if (is_constructor && cpp_check && type - && AGGREGATE_TYPE_P (type) - && TYPE_METHODS (type)) - { - tree tmp = TYPE_METHODS (type); - - for (; tmp; tmp = TREE_CHAIN (tmp)) - if (cpp_check (tmp, IS_ABSTRACT)) - { - is_abstract_class = 1; - break; - } - } if (is_abstract || is_abstract_class) pp_string (buffer, " is abstract"); @@ -2845,15 +2986,15 @@ pp_string (buffer, " -- "); dump_sloc (buffer, t); - if (is_abstract) + if (is_abstract || !DECL_ASSEMBLER_NAME (t)) return 1; newline_and_indent (buffer, spc); if (is_constructor) { - pp_string (buffer, "pragma CPP_Constructor (New_"); - dump_ada_decl_name (buffer, t, false); + pp_string (buffer, "pragma CPP_Constructor ("); + print_constructor (buffer, t, type); pp_string (buffer, ", \""); pp_asm_name (buffer, t); pp_string (buffer, "\");"); @@ -2861,15 +3002,13 @@ else if (is_destructor) { pp_string (buffer, "pragma Import (CPP, "); - print_destructor (buffer, t); + print_destructor (buffer, t, type); pp_string (buffer, ", \""); pp_asm_name (buffer, t); pp_string (buffer, "\");"); } else - { - dump_ada_import (buffer, t); - } + dump_ada_import (buffer, t); return 1; } @@ -2882,42 +3021,44 @@ INDENT (spc); /* Anonymous structs/unions */ - dump_generic_ada_node - (buffer, TREE_TYPE (t), t, cpp_check, spc, false, true); - - if (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE - || TREE_CODE (TREE_TYPE (t)) == QUAL_UNION_TYPE) + dump_generic_ada_node (buffer, TREE_TYPE (t), t, spc, false, true); + + if (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE) { pp_string (buffer, " (discr : unsigned := 0)"); } pp_string (buffer, " is "); - /* Check whether we have an Ada interface compatible class. */ - if (cpp_check && AGGREGATE_TYPE_P (TREE_TYPE (t)) - && TYPE_METHODS (TREE_TYPE (t))) + /* Check whether we have an Ada interface compatible class. + That is only have a vtable non-static data member and no + non-abstract methods. */ + if (cpp_check + && RECORD_OR_UNION_TYPE_P (TREE_TYPE (t))) { - int num_fields = 0; - tree tmp = TYPE_FIELDS (TREE_TYPE (t)); + bool has_fields = false; /* Check that there are no fields other than the virtual table. */ - for (; tmp; tmp = TREE_CHAIN (tmp)) + for (tree fld = TYPE_FIELDS (TREE_TYPE (t)); + fld; + fld = TREE_CHAIN (fld)) { - if (TREE_CODE (tmp) == TYPE_DECL) - continue; - num_fields++; - } - - if (num_fields == 1) - is_interface = 1; - - /* Also check that there are only virtual methods. */ - for (tmp = TYPE_METHODS (TREE_TYPE (t)); tmp; tmp = TREE_CHAIN (tmp)) - { - if (cpp_check (tmp, IS_ABSTRACT)) - is_abstract_record = 1; - else - is_interface = 0; + if (TREE_CODE (fld) == FIELD_DECL) + { + if (!has_fields && DECL_VIRTUAL_P (fld)) + is_interface = 1; + else + is_interface = 0; + has_fields = true; + } + else if (TREE_CODE (fld) == FUNCTION_DECL + && !DECL_ARTIFICIAL (fld)) + { + if (cpp_check (fld, IS_ABSTRACT)) + is_abstract_record = 1; + else + is_interface = 0; + } } } @@ -2929,17 +3070,16 @@ newline_and_indent (buffer, spc); pp_string (buffer, "pragma Import (CPP, "); dump_generic_ada_node - (buffer, TYPE_NAME (TREE_TYPE (t)), type, cpp_check, - spc, false, true); - pp_character (buffer, ')'); - - print_ada_methods (buffer, TREE_TYPE (t), cpp_check, spc); + (buffer, TYPE_NAME (TREE_TYPE (t)), type, spc, false, true); + pp_right_paren (buffer); + + dump_ada_methods (buffer, TREE_TYPE (t), spc); } else { if (is_abstract_record) pp_string (buffer, "abstract "); - dump_generic_ada_node (buffer, t, t, cpp_check, spc, false, false); + dump_generic_ada_node (buffer, t, t, spc, false, false); } } else @@ -2951,22 +3091,19 @@ check_name (buffer, t); /* Print variable/type's name. */ - dump_generic_ada_node (buffer, t, t, cpp_check, spc, false, true); + dump_generic_ada_node (buffer, t, t, spc, false, true); if (TREE_CODE (t) == TYPE_DECL) { tree orig = DECL_ORIGINAL_TYPE (t); int is_subtype = orig && TYPE_NAME (orig) && orig != TREE_TYPE (t); - if (!is_subtype - && (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE - || TREE_CODE (TREE_TYPE (t)) == QUAL_UNION_TYPE)) + if (!is_subtype && TREE_CODE (TREE_TYPE (t)) == UNION_TYPE) pp_string (buffer, " (discr : unsigned := 0)"); pp_string (buffer, " is "); - dump_generic_ada_node - (buffer, orig, t, cpp_check, spc, false, is_subtype); + dump_generic_ada_node (buffer, orig, t, spc, false, is_subtype); } else { @@ -2975,20 +3112,18 @@ pp_string (buffer, " : "); - /* Print type declaration. */ - - if (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE - && !TYPE_NAME (TREE_TYPE (t))) + if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t))) { - dump_ada_double_name (buffer, type, t, "_union"); - } - else if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t))) - { - if (TREE_CODE (TREE_TYPE (t)) == RECORD_TYPE) - pp_string (buffer, "aliased "); - - dump_generic_ada_node - (buffer, TREE_TYPE (t), t, cpp_check, spc, false, true); + pp_string (buffer, "aliased "); + + if (TREE_READONLY (t)) + pp_string (buffer, "constant "); + + if (TYPE_NAME (TREE_TYPE (t))) + dump_generic_ada_node + (buffer, TREE_TYPE (t), t, spc, false, true); + else if (type) + dump_ada_double_name (buffer, type, t); } else { @@ -2997,21 +3132,23 @@ || TREE_CODE (TREE_TYPE (t)) != INTEGER_TYPE)) pp_string (buffer, "aliased "); + if (TREE_READONLY (t)) + pp_string (buffer, "constant "); + dump_generic_ada_node - (buffer, TREE_TYPE (t), TREE_TYPE (t), cpp_check, - spc, false, true); + (buffer, TREE_TYPE (t), TREE_TYPE (t), spc, false, true); } } } if (is_class) { - spc -= 3; + spc -= INDENT_INCR; newline_and_indent (buffer, spc); pp_string (buffer, "end;"); newline_and_indent (buffer, spc); pp_string (buffer, "use Class_"); - dump_generic_ada_node (buffer, t, type, 0, spc, false, true); + dump_generic_ada_node (buffer, t, type, spc, false, true); pp_semicolon (buffer); pp_newline (buffer); @@ -3033,34 +3170,28 @@ return 1; } -/* Prints in BUFFER a structure NODE of type TYPE: name, fields, and methods - with Ada syntax. CPP_CHECK is used to perform C++ queries on nodes. SPC - is the indentation level. If DISPLAY_CONVENTION is true, also print the - pragma Convention for NODE. */ +/* Dump in BUFFER a structure NODE of type TYPE: name, fields, and methods + with Ada syntax. SPC is the indentation level. If DISPLAY_CONVENTION is + true, also print the pragma Convention for NODE. */ static void -print_ada_struct_decl (pretty_printer *buffer, tree node, tree type, - int (*cpp_check)(tree, cpp_operation), int spc, +dump_ada_struct_decl (pretty_printer *buffer, tree node, tree type, int spc, bool display_convention) { tree tmp; - int is_union = - TREE_CODE (node) == UNION_TYPE || TREE_CODE (node) == QUAL_UNION_TYPE; - char buf [16]; + const bool is_union = (TREE_CODE (node) == UNION_TYPE); + char buf[32]; int field_num = 0; int field_spc = spc + INDENT_INCR; int need_semicolon; bitfield_used = false; - if (!TYPE_FIELDS (node)) - pp_string (buffer, "null record;"); - else + if (TYPE_FIELDS (node)) { + /* Print the contents of the structure. */ pp_string (buffer, "record"); - /* Print the contents of the structure. */ - if (is_union) { newline_and_indent (buffer, spc + INDENT_INCR); @@ -3079,17 +3210,16 @@ if (!is_tagged_type (TREE_TYPE (tmp))) { if (!TYPE_NAME (TREE_TYPE (tmp))) - print_ada_declaration - (buffer, tmp, type, cpp_check, field_spc); + dump_ada_declaration (buffer, tmp, type, field_spc); else { INDENT (field_spc); if (field_num == 0) - pp_string (buffer, "parent : "); + pp_string (buffer, "parent : aliased "); else { - sprintf (buf, "field_%d : ", field_num + 1); + sprintf (buf, "field_%d : aliased ", field_num + 1); pp_string (buffer, buf); } dump_ada_decl_name @@ -3100,15 +3230,10 @@ field_num++; } } - /* Avoid printing the structure recursively. */ - else if ((TREE_TYPE (tmp) != node - || (TREE_CODE (TREE_TYPE (tmp)) == POINTER_TYPE - && TREE_TYPE (TREE_TYPE (tmp)) != node)) - && TREE_CODE (tmp) != TYPE_DECL - && !TREE_STATIC (tmp)) + else if (TREE_CODE (tmp) == FIELD_DECL) { /* Skip internal virtual table field. */ - if (strncmp (IDENTIFIER_POINTER (DECL_NAME (tmp)), "_vptr", 5)) + if (!DECL_VIRTUAL_P (tmp)) { if (is_union) { @@ -3124,8 +3249,7 @@ pp_newline (buffer); } - if (print_ada_declaration (buffer, - tmp, type, cpp_check, field_spc)) + if (dump_ada_declaration (buffer, tmp, type, field_spc)) { pp_newline (buffer); field_num++; @@ -3151,6 +3275,8 @@ INDENT (spc); pp_string (buffer, "end record;"); } + else + pp_string (buffer, "null record;"); newline_and_indent (buffer, spc); @@ -3159,7 +3285,7 @@ if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (type))) { - if (TYPE_METHODS (TREE_TYPE (type))) + if (has_nontrivial_methods (TREE_TYPE (type))) pp_string (buffer, "pragma Import (CPP, "); else pp_string (buffer, "pragma Convention (C_Pass_By_Copy, "); @@ -3168,10 +3294,9 @@ pp_string (buffer, "pragma Convention (C, "); package_prefix = false; - dump_generic_ada_node - (buffer, TREE_TYPE (type), type, cpp_check, spc, false, true); + dump_generic_ada_node (buffer, TREE_TYPE (type), type, spc, false, true); package_prefix = true; - pp_character (buffer, ')'); + pp_right_paren (buffer); if (is_union) { @@ -3179,9 +3304,8 @@ newline_and_indent (buffer, spc); pp_string (buffer, "pragma Unchecked_Union ("); - dump_generic_ada_node - (buffer, TREE_TYPE (type), type, cpp_check, spc, false, true); - pp_character (buffer, ')'); + dump_generic_ada_node (buffer, TREE_TYPE (type), type, spc, false, true); + pp_right_paren (buffer); } if (bitfield_used) @@ -3190,18 +3314,17 @@ newline_and_indent (buffer, spc); pp_string (buffer, "pragma Pack ("); dump_generic_ada_node - (buffer, TREE_TYPE (type), type, cpp_check, spc, false, true); - pp_character (buffer, ')'); + (buffer, TREE_TYPE (type), type, spc, false, true); + pp_right_paren (buffer); bitfield_used = false; } - print_ada_methods (buffer, node, cpp_check, spc); + need_semicolon = !dump_ada_methods (buffer, node, spc); /* Print the static fields of the structure, if any. */ - need_semicolon = TYPE_METHODS (node) == NULL_TREE; for (tmp = TYPE_FIELDS (node); tmp; tmp = TREE_CHAIN (tmp)) { - if (DECL_NAME (tmp) && TREE_STATIC (tmp)) + if (TREE_CODE (tmp) == VAR_DECL && DECL_NAME (tmp)) { if (need_semicolon) { @@ -3210,20 +3333,19 @@ } pp_newline (buffer); pp_newline (buffer); - print_ada_declaration (buffer, tmp, type, cpp_check, spc); + dump_ada_declaration (buffer, tmp, type, spc); } } } /* Dump all the declarations in SOURCE_FILE to an Ada spec. COLLECT_ALL_REFS is a front-end callback used to collect all relevant - nodes for SOURCE_FILE. CPP_CHECK is used to perform C++ queries on - nodes. */ + nodes for SOURCE_FILE. CHECK is used to perform C++ queries on nodes. */ static void dump_ads (const char *source_file, void (*collect_all_refs)(const char *), - int (*cpp_check)(tree, cpp_operation)) + int (*check)(tree, cpp_operation)) { char *ads_name; char *pkg_name; @@ -3232,11 +3354,14 @@ pkg_name = get_ada_package (source_file); - /* Construct the the .ads filename and package name. */ + /* Construct the .ads filename and package name. */ ads_name = xstrdup (pkg_name); for (s = ads_name; *s; s++) - *s = TOLOWER (*s); + if (*s == '.') + *s = '-'; + else + *s = TOLOWER (*s); ads_name = reconcat (ads_name, ads_name, ".ads", NULL); @@ -3246,7 +3371,6 @@ { pretty_printer pp; - pp_construct (&pp, NULL, 0); pp_needs_newline (&pp) = true; pp.buffer->stream = f; @@ -3259,7 +3383,12 @@ (*collect_all_refs) (source_file); /* Dump all references. */ - dump_ada_nodes (&pp, source_file, cpp_check); + cpp_check = check; + dump_ada_nodes (&pp, source_file); + + /* Requires Ada 2005 syntax, so generate corresponding pragma. + Also, disable style checks since this file is auto-generated. */ + fprintf (f, "pragma Ada_2005;\npragma Style_Checks (Off);\n\n"); /* Dump withs. */ dump_ada_withs (f); @@ -3296,7 +3425,7 @@ } for (i = 0; i < source_refs_used; i++) - if (filename == source_refs [i]) + if (filename == source_refs[i]) return; if (source_refs_used == source_refs_allocd) @@ -3305,26 +3434,25 @@ source_refs = XRESIZEVEC (const char *, source_refs, source_refs_allocd); } - source_refs [source_refs_used++] = filename; + source_refs[source_refs_used++] = filename; } /* Main entry point: dump all Ada specs corresponding to SOURCE_REFS - using callbacks COLLECT_ALL_REFS and CPP_CHECK. + using callbacks COLLECT_ALL_REFS and CHECK. COLLECT_ALL_REFS is a front-end callback used to collect all relevant nodes for a given source file. - CPP_CHECK is used to perform C++ queries on nodes, or NULL for the C + CHECK is used to perform C++ queries on nodes, or NULL for the C front-end. */ void dump_ada_specs (void (*collect_all_refs)(const char *), - int (*cpp_check)(tree, cpp_operation)) + int (*check)(tree, cpp_operation)) { - int i; - - /* Iterate over the list of files to dump specs for */ - for (i = 0; i < source_refs_used; i++) - dump_ads (source_refs [i], collect_all_refs, cpp_check); - - /* Free files table. */ + /* Iterate over the list of files to dump specs for. */ + for (int i = 0; i < source_refs_used; i++) + dump_ads (source_refs[i], collect_all_refs, check); + + /* Free various tables. */ free (source_refs); + delete overloaded_names; }