URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [c-family/] [c-ada-spec.c] - Rev 713
Go to most recent revision | Compare with Previous | Blame | View Log
/* 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. Adapted from tree-pretty-print.c by Arnaud Charlet <charlet@adacore.com> This file is part of GCC. GCC is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 3, or (at your option) any later version. GCC is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GCC; see the file COPYING3. If not see <http://www.gnu.org/licenses/>. */ #include "config.h" #include "system.h" #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 "c-pragma.h" #include "cpp-id-data.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, 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) #define INDENT_INCR 3 /* 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. */ static void macro_length (const cpp_macro *macro, int *supported, int *buffer_len, int *param_len) { int i; unsigned j; *supported = 1; *buffer_len = 0; *param_len = 0; if (macro->fun_like) { param_len++; for (i = 0; i < macro->paramc; i++) { cpp_hashnode *param = macro->params[i]; *param_len += NODE_LEN (param); if (i + 1 < macro->paramc) { *param_len += 2; /* ", " */ } else if (macro->variadic) { *supported = 0; return; } } *param_len += 2; /* ")\0" */ } for (j = 0; j < macro->count; j++) { cpp_token *token = ¯o->exp.tokens[j]; if (token->flags & PREV_WHITE) (*buffer_len)++; if (token->flags & STRINGIFY_ARG || token->flags & PASTE_LEFT) { *supported = 0; return; } if (token->type == CPP_MACRO_ARG) *buffer_len += NODE_LEN (macro->params[token->val.macro_arg.arg_no - 1]); else /* Include enough extra space to handle e.g. special characters. */ *buffer_len += (cpp_token_len (token) + 1) * 8; } (*buffer_len)++; } /* Dump into PP a set of MAX_ADA_MACROS MACROS (C/C++) as Ada constants when possible. */ static void print_ada_macros (pretty_printer *pp, cpp_hashnode **macros, int max_ada_macros) { int j, num_macros = 0, prev_line = -1; for (j = 0; j < max_ada_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; macro_length (macro, &supported, &buffer_len, ¶m_len); s = buffer = XALLOCAVEC (unsigned char, buffer_len); params = buf_param = XALLOCAVEC (unsigned char, param_len); if (supported) { if (macro->fun_like) { *buf_param++ = '('; for (i = 0; i < macro->paramc; i++) { cpp_hashnode *param = macro->params[i]; memcpy (buf_param, NODE_NAME (param), NODE_LEN (param)); buf_param += NODE_LEN (param); if (i + 1 < macro->paramc) { *buf_param++ = ','; *buf_param++ = ' '; } else if (macro->variadic) { supported = 0; break; } } *buf_param++ = ')'; *buf_param = '\0'; } for (i = 0; supported && i < macro->count; i++) { cpp_token *token = ¯o->exp.tokens[i]; int is_one = 0; if (token->flags & PREV_WHITE) *buffer++ = ' '; if (token->flags & STRINGIFY_ARG || token->flags & PASTE_LEFT) { supported = 0; break; } switch (token->type) { case CPP_MACRO_ARG: { cpp_hashnode *param = macro->params[token->val.macro_arg.arg_no - 1]; memcpy (buffer, NODE_NAME (param), NODE_LEN (param)); buffer += NODE_LEN (param); } break; case CPP_EQ_EQ: *buffer++ = '='; break; case CPP_GREATER: *buffer++ = '>'; break; case CPP_LESS: *buffer++ = '<'; break; case CPP_PLUS: *buffer++ = '+'; break; case CPP_MINUS: *buffer++ = '-'; break; case CPP_MULT: *buffer++ = '*'; break; case CPP_DIV: *buffer++ = '/'; break; case CPP_COMMA: *buffer++ = ','; break; case CPP_OPEN_SQUARE: case CPP_OPEN_PAREN: *buffer++ = '('; break; case CPP_CLOSE_SQUARE: /* fallthrough */ case CPP_CLOSE_PAREN: *buffer++ = ')'; break; case CPP_DEREF: /* fallthrough */ case CPP_SCOPE: /* fallthrough */ case CPP_DOT: *buffer++ = '.'; break; case CPP_EQ: *buffer++ = ':'; *buffer++ = '='; break; case CPP_NOT_EQ: *buffer++ = '/'; *buffer++ = '='; break; case CPP_GREATER_EQ: *buffer++ = '>'; *buffer++ = '='; break; case CPP_LESS_EQ: *buffer++ = '<'; *buffer++ = '='; break; case CPP_NOT: *buffer++ = 'n'; *buffer++ = 'o'; *buffer++ = 't'; break; case CPP_MOD: *buffer++ = 'm'; *buffer++ = 'o'; *buffer++ = 'd'; break; case CPP_AND: *buffer++ = 'a'; *buffer++ = 'n'; *buffer++ = 'd'; break; case CPP_OR: *buffer++ = 'o'; *buffer++ = 'r'; break; case CPP_XOR: *buffer++ = 'x'; *buffer++ = 'o'; *buffer++ = 'r'; break; case CPP_AND_AND: strcpy ((char *) buffer, " and then "); buffer += 10; break; case CPP_OR_OR: strcpy ((char *) buffer, " or else "); buffer += 9; break; case CPP_PADDING: *buffer++ = ' '; is_one = prev_is_one; break; case CPP_COMMENT: break; case CPP_WSTRING: case CPP_STRING16: case CPP_STRING32: case CPP_UTF8STRING: case CPP_WCHAR: case CPP_CHAR16: case CPP_CHAR32: 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_CHAR: is_char = 1; { unsigned chars_seen; int ignored; cppchar_t c; c = cpp_interpret_charconst (parse_in, token, &chars_seen, &ignored); if (c >= 32 && c <= 126) { *buffer++ = '\''; *buffer++ = (char) c; *buffer++ = '\''; } else { chars_seen = sprintf ((char *) buffer, "Character'Val (%d)", (int) c); buffer += chars_seen; } } break; case CPP_LSHIFT: if (prev_is_one) { /* Replace "1 << N" by "2 ** N" */ *char_one = '2'; *buffer++ = '*'; *buffer++ = '*'; break; } /* fallthrough */ case CPP_RSHIFT: case CPP_COMPL: case CPP_QUERY: case CPP_EOF: case CPP_PLUS_EQ: case CPP_MINUS_EQ: case CPP_MULT_EQ: case CPP_DIV_EQ: case CPP_MOD_EQ: case CPP_AND_EQ: case CPP_OR_EQ: case CPP_XOR_EQ: case CPP_RSHIFT_EQ: case CPP_LSHIFT_EQ: case CPP_PRAGMA: case CPP_PRAGMA_EOL: case CPP_HASH: case CPP_PASTE: case CPP_OPEN_BRACE: case CPP_CLOSE_BRACE: case CPP_SEMICOLON: case CPP_ELLIPSIS: case CPP_PLUS_PLUS: case CPP_MINUS_MINUS: case CPP_DEREF_STAR: case CPP_DOT_STAR: case CPP_ATSIGN: case CPP_HEADER_NAME: case CPP_AT_NAME: case CPP_OTHER: case CPP_OBJC_STRING: default: if (!macro->fun_like) supported = 0; else buffer = cpp_spell_token (parse_in, token, buffer, false); break; } prev_is_one = is_one; } if (supported) *buffer = '\0'; } if (macro->fun_like && supported) { char *start = (char *) s; int is_function = 0; pp_string (pp, " -- arg-macro: "); if (*start == '(' && buffer [-1] == ')') { start++; buffer [-1] = '\0'; is_function = 1; pp_string (pp, "function "); } else { pp_string (pp, "procedure "); } pp_string (pp, (const char *) NODE_NAME (node)); pp_space (pp); pp_string (pp, (char *) params); pp_newline (pp); pp_string (pp, " -- "); if (is_function) { pp_string (pp, "return "); pp_string (pp, start); pp_semicolon (pp); } else pp_string (pp, start); pp_newline (pp); } else if (supported) { expanded_location sloc = expand_location (macro->line); if (sloc.line != prev_line + 1) pp_newline (pp); num_macros++; prev_line = sloc.line; pp_string (pp, " "); ada_name = to_ada_name ((const char *) NODE_NAME (node), NULL); pp_string (pp, ada_name); free (ada_name); pp_string (pp, " : "); if (is_string) pp_string (pp, "aliased constant String"); else if (is_char) pp_string (pp, "aliased constant Character"); else pp_string (pp, "constant"); pp_string (pp, " := "); pp_string (pp, (char *) s); if (is_string) pp_string (pp, " & ASCII.NUL"); pp_string (pp, "; -- "); pp_string (pp, sloc.file); pp_character (pp, ':'); pp_scalar (pp, "%d", sloc.line); pp_newline (pp); } else { pp_string (pp, " -- unsupported macro: "); pp_string (pp, (const char *) cpp_macro_definition (parse_in, node)); pp_newline (pp); } } if (num_macros > 0) 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); } /* 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); } /* Compare two declarations (LP and RP) by their source location. */ static int compare_node (const void *lp, const void *rp) { const_tree lhs = *((const tree *) lp); const_tree rhs = *((const tree *) rp); return decl_sloc (lhs, true) - decl_sloc (rhs, true); } /* Compare two comments (LP and RP) by their source location. */ static int compare_comment (const void *lp, const void *rp) { 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 filename_cmp (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; } static tree *to_dump = NULL; static int to_dump_count = 0; /* Collect a list of declarations from T relevant to SOURCE_FILE to be dumped by a subsequent call to dump_ada_nodes. */ void collect_ada_nodes (tree t, const char *source_file) { tree n; int i = to_dump_count; /* Count the likely relevant nodes. */ for (n = t; n; n = TREE_CHAIN (n)) if (!DECL_IS_BUILTIN (n) && LOCATION_FILE (decl_sloc (n, false)) == source_file) to_dump_count++; /* Allocate sufficient storage for all nodes. */ to_dump = XRESIZEVEC (tree, to_dump, to_dump_count); /* Store the relevant nodes. */ for (n = t; n; n = TREE_CHAIN (n)) if (!DECL_IS_BUILTIN (n) && LOCATION_FILE (decl_sloc (n, false)) == source_file) to_dump [i++] = n; } /* Call back for walk_tree to clear the TREE_VISITED flag of TP. */ static tree unmark_visited_r (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED, void *data ATTRIBUTE_UNUSED) { if (TREE_VISITED (*tp)) TREE_VISITED (*tp) = 0; else *walk_subtrees = 0; 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 print_comment (pretty_printer *pp, const char *comment) { int len = strlen (comment); char *str = XALLOCAVEC (char, len + 1); char *tok; bool extra_newline = false; memcpy (str, comment, len + 1); /* Trim C/C++ comment indicators. */ if (str[len - 2] == '*' && str[len - 1] == '/') { str[len - 2] = ' '; str[len - 1] = '\0'; } str += 2; tok = strtok (str, "\n"); while (tok) { pp_string (pp, " --"); pp_string (pp, tok); pp_newline (pp); tok = strtok (NULL, "\n"); /* Leave a blank line after multi-line comments. */ if (tok) extra_newline = true; } if (extra_newline) 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. */ static void print_generic_ada_decl (pretty_printer *pp, tree decl, int (*cpp_check)(tree, cpp_operation), const char* source_file) { source_file_base = source_file; if (print_ada_declaration (pp, decl, 0, cpp_check, INDENT_INCR)) { pp_newline (pp); pp_newline (pp); } } /* Dump a newline and indent BUFFER by SPC chars. */ static void newline_and_indent (pretty_printer *buffer, int spc) { pp_newline (buffer); INDENT (spc); } struct with { char *s; const char *in_file; int limited; }; static struct with *withs = NULL; static int withs_max = 4096; static int with_len = 0; /* Record a "with" clause on package S (a limited with if LIMITED_ACCESS is true), if not already done. */ static void append_withs (const char *s, int limited_access) { int i; if (withs == NULL) withs = XNEWVEC (struct with, withs_max); if (with_len == withs_max) { withs_max *= 2; withs = XRESIZEVEC (struct with, withs, withs_max); } for (i = 0; i < with_len; i++) if (!strcmp (s, withs [i].s) && source_file_base == withs [i].in_file) { 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; with_len++; } /* Reset "with" clauses. */ static void reset_ada_withs (void) { int i; if (!withs) return; for (i = 0; i < with_len; i++) free (withs [i].s); free (withs); withs = NULL; withs_max = 4096; with_len = 0; } /* Dump "with" clauses in F. */ static void dump_ada_withs (FILE *f) { int i; fprintf (f, "with Interfaces.C; use Interfaces.C;\n"); for (i = 0; i < with_len; i++) fprintf (f, "%swith %s;\n", withs [i].limited ? "limited " : "", withs [i].s); } /* Return suitable Ada package name from FILE. */ static char * get_ada_package (const char *file) { const char *base; char *res; const char *s; int i; 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++) switch (*base) { case '+': res [i] = 'p'; break; case '.': case '-': case '_': case '/': case '\\': res [i] = (i == 0 || res [i - 1] == '_') ? 'u' : '_'; break; default: res [i] = *base; break; } res [i] = '\0'; return res; } static const char *ada_reserved[] = { "abort", "abs", "abstract", "accept", "access", "aliased", "all", "and", "array", "at", "begin", "body", "case", "constant", "declare", "delay", "delta", "digits", "do", "else", "elsif", "end", "entry", "exception", "exit", "for", "function", "generic", "goto", "if", "in", "interface", "is", "limited", "loop", "mod", "new", "not", "null", "others", "out", "of", "or", "overriding", "package", "pragma", "private", "procedure", "protected", "raise", "range", "record", "rem", "renames", "requeue", "return", "reverse", "select", "separate", "subtype", "synchronized", "tagged", "task", "terminate", "then", "type", "until", "use", "when", "while", "with", "xor", NULL}; /* ??? would be nice to specify this list via a config file, so that users can create their own dictionary of conflicts. */ static const char *c_duplicates[] = { /* system will cause troubles with System.Address. */ "system", /* The following values have other definitions with same name/other casing. */ "funmap", "rl_vi_fWord", "rl_vi_bWord", "rl_vi_eWord", "rl_readline_version", "_Vx_ushort", "USHORT", "XLookupKeysym", NULL}; /* Return a declaration tree corresponding to TYPE. */ static tree get_underlying_decl (tree type) { tree decl = NULL_TREE; if (type == NULL_TREE) return NULL_TREE; /* type is a declaration. */ if (DECL_P (type)) decl = type; /* type is a typedef. */ if (TYPE_P (type) && TYPE_NAME (type) && DECL_P (TYPE_NAME (type))) decl = 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; } /* Return whether TYPE has static fields. */ static int 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; } return false; } /* Return whether TYPE corresponds to an Ada tagged type (has a dispatch table). */ static int 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)) 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. */ static char * to_ada_name (const char *name, int *space_found) { const char **names; int len = strlen (name); int j, len2 = 0; int found = false; char *s = XNEWVEC (char, len * 2 + 5); char c; if (space_found) *space_found = false; /* Add trailing "c_" if name is an Ada reserved word. */ for (names = ada_reserved; *names; names++) if (!strcasecmp (name, *names)) { s [len2++] = 'c'; s [len2++] = '_'; found = true; break; } if (!found) /* Add trailing "c_" if name is an potential case sensitive duplicate. */ for (names = c_duplicates; *names; names++) if (!strcmp (name, *names)) { s [len2++] = 'c'; s [len2++] = '_'; found = true; break; } for (j = 0; name [j] == '_'; j++) s [len2++] = 'u'; if (j > 0) s [len2++] = '_'; else if (*name == '.' || *name == '$') { 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]) { case ' ': if (space_found) *space_found = true; s [len2++] = '_'; break; /* ??? missing some C++ operators. */ case '=': s [len2++] = '_'; if (name [j + 1] == '=') { j++; s [len2++] = 'e'; s [len2++] = 'q'; } else { s [len2++] = 'a'; s [len2++] = 's'; } break; case '!': s [len2++] = '_'; if (name [j + 1] == '=') { j++; s [len2++] = 'n'; s [len2++] = 'e'; } break; case '~': 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] == '=') { j++; s [len2++] = 'e'; } break; case '+': case '-': case '*': case '/': case '(': case '[': 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; /* / */ } 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; /* /= */ } s [len2++] = 'a'; break; case '-': /* -- */ j++; s [len2++] = 'm'; s [len2++] = 'm'; break; case '+': /* ++ */ j++; s [len2++] = 'p'; s [len2++] = 'p'; break; case ')': /* () */ j++; s [len2++] = 'o'; s [len2++] = 'p'; break; case ']': /* [] */ j++; s [len2++] = 'o'; s [len2++] = 'b'; break; } break; case '<': case '>': c = name [j] == '<' ? 'l' : 'g'; s [len2++] = '_'; switch (name [j + 1]) { case '\0': s [len2++] = c; s [len2++] = 't'; break; case '=': j++; s [len2++] = c; s [len2++] = 'e'; break; case '>': j++; s [len2++] = 's'; s [len2++] = 'r'; break; case '<': j++; s [len2++] = 's'; s [len2++] = 'l'; break; default: break; } break; case '_': if (len2 && s [len2 - 1] == '_') s [len2++] = 'u'; /* fall through */ default: s [len2++] = name [j]; } if (s [len2 - 1] == '_') s [len2++] = 'u'; s [len2] = '\0'; return s; } /* Return true if DECL refers to a C++ class type for which a separate enclosing package has been or should be generated. */ 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; } 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 'with' clause rather than a regular 'with' clause. */ static void pp_ada_tree_identifier (pretty_printer *buffer, tree node, tree type, int 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); if (decl) { expanded_location xloc = expand_location (decl_sloc (decl, false)); if (xloc.file && xloc.line) { if (xloc.file != source_file_base) { switch (TREE_CODE (type)) { case ENUMERAL_TYPE: case INTEGER_TYPE: case REAL_TYPE: case FIXED_POINT_TYPE: case BOOLEAN_TYPE: case REFERENCE_TYPE: case POINTER_TYPE: 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); } break; default: break; } if (separate_class_package (decl)) { pp_string (buffer, "Class_"); pp_string (buffer, s); pp_string (buffer, "."); } } } } if (space_found) if (!strcmp (s, "short_int")) pp_string (buffer, "short"); else if (!strcmp (s, "short_unsigned_int")) pp_string (buffer, "unsigned_short"); else if (!strcmp (s, "unsigned_int")) pp_string (buffer, "unsigned"); else if (!strcmp (s, "long_int")) pp_string (buffer, "long"); else if (!strcmp (s, "long_unsigned_int")) pp_string (buffer, "unsigned_long"); else if (!strcmp (s, "long_long_int")) pp_string (buffer, "Long_Long_Integer"); else if (!strcmp (s, "long_long_unsigned_int")) { if (package_prefix) { append_withs ("Interfaces.C.Extensions", false); pp_string (buffer, "Extensions.unsigned_long_long"); } else pp_string (buffer, "unsigned_long_long"); } else pp_string(buffer, s); else if (!strcmp (s, "bool")) { if (package_prefix) { append_withs ("Interfaces.C.Extensions", false); pp_string (buffer, "Extensions.bool"); } else pp_string (buffer, "bool"); } else pp_string(buffer, s); free (s); } /* Dump in BUFFER the assembly name of T. */ static void pp_asm_name (pretty_printer *buffer, tree t) { tree name = DECL_ASSEMBLER_NAME (t); char *ada_name = XALLOCAVEC (char, IDENTIFIER_LENGTH (name) + 1), *s; const char *ident = IDENTIFIER_POINTER (name); for (s = ada_name; *ident; ident++) { if (*ident == ' ') break; else if (*ident != '*') *s++ = *ident; } *s = '\0'; pp_string (buffer, ada_name); } /* 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) { if (DECL_NAME (decl)) pp_ada_tree_identifier (buffer, DECL_NAME (decl), decl, limited_access); else { tree type_name = TYPE_NAME (TREE_TYPE (decl)); if (!type_name) { pp_string (buffer, "anon"); if (TREE_CODE (decl) == FIELD_DECL) pp_scalar (buffer, "%d", DECL_UID (decl)); else 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); } } /* Dump in BUFFER a name based on both T1 and T2, followed by S. */ static void dump_ada_double_name (pretty_printer *buffer, tree t1, tree t2, const char *s) { if (DECL_NAME (t1)) pp_ada_tree_identifier (buffer, DECL_NAME (t1), t1, 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); else { pp_string (buffer, "anon"); pp_scalar (buffer, "%d", TYPE_UID (TREE_TYPE (t2))); } pp_string (buffer, s); } /* Dump in BUFFER pragma Import C/CPP on a given node T. */ static void dump_ada_import (pretty_printer *buffer, tree t) { const char *name = IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (t)); int is_stdcall = TREE_CODE (t) == FUNCTION_DECL && lookup_attribute ("stdcall", TYPE_ATTRIBUTES (TREE_TYPE (t))); if (is_stdcall) pp_string (buffer, "pragma Import (Stdcall, "); else if (name [0] == '_' && name [1] == 'Z') pp_string (buffer, "pragma Import (CPP, "); else pp_string (buffer, "pragma Import (C, "); dump_ada_decl_name (buffer, t, false); pp_string (buffer, ", \""); if (is_stdcall) pp_string (buffer, IDENTIFIER_POINTER (DECL_NAME (t))); else pp_asm_name (buffer, t); pp_string (buffer, "\");"); } /* Check whether T and its type have different names, and append "the_" otherwise in BUFFER. */ static void check_name (pretty_printer *buffer, tree t) { const char *s; tree tmp = TREE_TYPE (t); while (TREE_CODE (tmp) == POINTER_TYPE && !TYPE_NAME (tmp)) tmp = TREE_TYPE (tmp); if (TREE_CODE (tmp) != FUNCTION_TYPE) { if (TREE_CODE (tmp) == IDENTIFIER_NODE) s = IDENTIFIER_POINTER (tmp); else if (!TYPE_NAME (tmp)) s = ""; else if (TREE_CODE (TYPE_NAME (tmp)) == IDENTIFIER_NODE) s = IDENTIFIER_POINTER (TYPE_NAME (tmp)); else s = IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp))); if (!strcasecmp (IDENTIFIER_POINTER (DECL_NAME (t)), s)) pp_string (buffer, "the_"); } } /* Dump in BUFFER a function declaration FUNC with Ada syntax. IS_METHOD indicates whether FUNC is a C++ method. IS_CONSTRUCTOR whether FUNC is a C++ constructor. IS_DESTRUCTOR whether FUNC is a C++ destructor. SPC is the current indentation level. */ static int dump_ada_function_declaration (pretty_printer *buffer, tree func, int is_method, int is_constructor, int is_destructor, int spc) { tree arg; const tree node = TREE_TYPE (func); char buf [16]; int num = 0, num_args = 0, have_args = true, have_ellipsis = false; /* Compute number of arguments. */ arg = TYPE_ARG_TYPES (node); if (arg) { while (TREE_CHAIN (arg) && arg != error_mark_node) { num_args++; arg = TREE_CHAIN (arg); } if (TREE_CODE (TREE_VALUE (arg)) != VOID_TYPE) { num_args++; have_ellipsis = true; } } if (is_constructor) num_args--; if (is_destructor) num_args = 1; if (num_args > 2) newline_and_indent (buffer, spc + 1); if (num_args > 0) { pp_space (buffer); pp_character (buffer, '('); } if (TREE_CODE (func) == FUNCTION_DECL) arg = DECL_ARGUMENTS (func); else arg = NULL_TREE; if (arg == NULL_TREE) { have_args = false; arg = TYPE_ARG_TYPES (node); if (arg && TREE_CODE (TREE_VALUE (arg)) == VOID_TYPE) arg = NULL_TREE; } if (is_constructor) arg = TREE_CHAIN (arg); /* Print the argument names (if available) & types. */ for (num = 1; num <= num_args; num++) { if (have_args) { if (DECL_NAME (arg)) { check_name (buffer, arg); pp_ada_tree_identifier (buffer, DECL_NAME (arg), 0, false); pp_string (buffer, " : "); } else { sprintf (buf, "arg%d : ", num); pp_string (buffer, buf); } dump_generic_ada_node (buffer, TREE_TYPE (arg), node, NULL, 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); } 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"); } arg = TREE_CHAIN (arg); if (num < num_args) { pp_character (buffer, ';'); if (num_args > 2) newline_and_indent (buffer, spc + INDENT_INCR); else pp_space (buffer); } } if (have_ellipsis) { pp_string (buffer, " -- , ..."); newline_and_indent (buffer, spc + INDENT_INCR); } if (num_args > 0) pp_character (buffer, ')'); return num_args; } /* Dump in BUFFER all the domains associated with an array NODE, using Ada syntax. SPC is the current indentation level. */ static void dump_ada_array_domains (pretty_printer *buffer, tree node, int spc) { int first = 1; pp_character (buffer, '('); for (; TREE_CODE (node) == ARRAY_TYPE; node = TREE_TYPE (node)) { tree domain = TYPE_DOMAIN (node); if (domain) { tree min = TYPE_MIN_VALUE (domain); tree max = TYPE_MAX_VALUE (domain); if (!first) pp_string (buffer, ", "); first = 0; if (min) dump_generic_ada_node (buffer, min, NULL_TREE, NULL, 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); else pp_string (buffer, "0"); } else pp_string (buffer, "size_t"); } pp_character (buffer, ')'); } /* Dump in BUFFER file:line information related to NODE. */ static void dump_sloc (pretty_printer *buffer, tree node) { expanded_location xloc; xloc.file = NULL; if (TREE_CODE_CLASS (TREE_CODE (node)) == tcc_declaration) xloc = expand_location (DECL_SOURCE_LOCATION (node)); else if (EXPR_HAS_LOCATION (node)) xloc = expand_location (EXPR_LOCATION (node)); if (xloc.file) { pp_string (buffer, xloc.file); pp_string (buffer, ":"); pp_decimal_int (buffer, xloc.line); } } /* Return true if T designates a one dimension array of "char". */ static bool is_char_array (tree t) { tree tmp; int num_dim = 0; /* Retrieve array's type. */ tmp = t; while (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE) { num_dim++; tmp = TREE_TYPE (tmp); } tmp = TREE_TYPE (tmp); return num_dim == 1 && TREE_CODE (tmp) == INTEGER_TYPE && !strcmp (IDENTIFIER_POINTER (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. */ static void dump_ada_array_type (pretty_printer *buffer, tree t, int spc) { tree tmp; bool char_array = is_char_array (t); /* Special case char arrays. */ if (char_array) { pp_string (buffer, "Interfaces.C.char_array "); } else pp_string (buffer, "array "); /* Print the dimensions. */ dump_ada_array_domains (buffer, TREE_TYPE (t), spc); /* Retrieve array's type. */ tmp = TREE_TYPE (t); while (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE) tmp = TREE_TYPE (tmp); /* Print array's type. */ if (!char_array) { pp_string (buffer, " of "); if (TREE_CODE (TREE_TYPE (tmp)) != POINTER_TYPE) pp_string (buffer, "aliased "); dump_generic_ada_node (buffer, TREE_TYPE (tmp), TREE_TYPE (t), NULL, spc, false, true); } } /* 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. */ static void dump_template_types (pretty_printer *buffer, tree types, int (*cpp_check)(tree, cpp_operation), int spc) { size_t i; size_t len = TREE_VEC_LENGTH (types); 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_string (buffer, "unknown"); pp_scalar (buffer, "%lu", (unsigned long) TREE_HASH (elem)); } } } /* Dump in BUFFER the contents of all class instantiations associated with a given template T. CPP_CHECK is used to perform C++ queries on nodes. SPC is the indentation level. */ static int dump_ada_template (pretty_printer *buffer, tree t, int (*cpp_check)(tree, cpp_operation), int spc) { tree inst = DECL_VINDEX (t); /* DECL_VINDEX is DECL_TEMPLATE_INSTANTIATIONS in this context. */ int num_inst = 0; while (inst && inst != error_mark_node) { tree types = TREE_PURPOSE (inst); tree instance = TREE_VALUE (inst); if (TREE_VEC_LENGTH (types) == 0) break; if (!TYPE_P (instance) || !TYPE_METHODS (instance)) break; 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); 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); package_prefix = true; if (is_tagged_type (instance)) pp_string (buffer, " is tagged limited "); else pp_string (buffer, " is limited "); dump_generic_ada_node (buffer, instance, t, cpp_check, spc, false, false); pp_newline (buffer); spc -= INDENT_INCR; newline_and_indent (buffer, spc); pp_string (buffer, "end;"); 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); package_prefix = true; pp_semicolon (buffer); pp_newline (buffer); pp_newline (buffer); inst = TREE_CHAIN (inst); } return num_inst > 0; } /* Return true if NODE is a simple enum types, that can be mapped to an Ada enum type directly. */ static bool is_simple_enum (tree node) { unsigned HOST_WIDE_INT count = 0; tree value; for (value = TYPE_VALUES (node); value; value = TREE_CHAIN (value)) { tree int_val = TREE_VALUE (value); if (TREE_CODE (int_val) != INTEGER_CST) int_val = DECL_INITIAL (int_val); if (!host_integerp (int_val, 0)) return false; else if (TREE_INT_CST_LOW (int_val) != count) return false; count++; } 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. */ 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) { if (node == NULL_TREE) return 0; switch (TREE_CODE (node)) { case ERROR_MARK: pp_string (buffer, "<<< error >>>"); return 0; case IDENTIFIER_NODE: pp_ada_tree_identifier (buffer, node, type, limited_access); break; case TREE_LIST: pp_string (buffer, "--- unexpected node: TREE_LIST"); return 0; case TREE_BINFO: dump_generic_ada_node (buffer, BINFO_TYPE (node), type, cpp_check, spc, limited_access, name_only); case TREE_VEC: pp_string (buffer, "--- unexpected node: TREE_VEC"); return 0; case VOID_TYPE: if (package_prefix) { append_withs ("System", false); pp_string (buffer, "System.Address"); } else pp_string (buffer, "address"); break; case VECTOR_TYPE: pp_string (buffer, "<vector>"); break; case COMPLEX_TYPE: pp_string (buffer, "<complex>"); break; case ENUMERAL_TYPE: if (name_only) dump_generic_ada_node (buffer, TYPE_NAME (node), node, cpp_check, spc, 0, true); else { tree value = TYPE_VALUES (node); if (is_simple_enum (node)) { bool first = true; spc += INDENT_INCR; newline_and_indent (buffer, spc - 1); pp_string (buffer, "("); for (; value; value = TREE_CHAIN (value)) { if (first) first = false; else { pp_string (buffer, ","); newline_and_indent (buffer, spc); } pp_ada_tree_identifier (buffer, TREE_PURPOSE (value), node, false); } pp_string (buffer, ");"); spc -= INDENT_INCR; newline_and_indent (buffer, spc); 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, ")"); } else { pp_string (buffer, "unsigned"); 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_string (buffer, " : constant "); dump_generic_ada_node (buffer, DECL_NAME (type) ? type : TYPE_NAME (node), type, cpp_check, 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); } } } break; case INTEGER_TYPE: case REAL_TYPE: case FIXED_POINT_TYPE: case BOOLEAN_TYPE: { enum tree_code_class tclass; tclass = TREE_CODE_CLASS (TREE_CODE (node)); if (tclass == tcc_declaration) { if (DECL_NAME (node)) pp_ada_tree_identifier (buffer, DECL_NAME (node), 0, limited_access); else pp_string (buffer, "<unnamed type decl>"); } else if (tclass == tcc_type) { if (TYPE_NAME (node)) { if (TREE_CODE (TYPE_NAME (node)) == IDENTIFIER_NODE) pp_ada_tree_identifier (buffer, TYPE_NAME (node), node, 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); else pp_string (buffer, "<unnamed type>"); } else if (TREE_CODE (node) == INTEGER_TYPE) { append_withs ("Interfaces.C.Extensions", false); bitfield_used = true; if (TYPE_PRECISION (node) == 1) pp_string (buffer, "Extensions.Unsigned_1"); else { pp_string (buffer, (TYPE_UNSIGNED (node) ? "Extensions.Unsigned_" : "Extensions.Signed_")); pp_decimal_int (buffer, TYPE_PRECISION (node)); } } else pp_string (buffer, "<unnamed type>"); } break; } case POINTER_TYPE: case REFERENCE_TYPE: 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"); } else { is_function = true; pp_string (buffer, "access function"); } in_function = is_function; dump_ada_function_declaration (buffer, node, false, false, false, spc + INDENT_INCR); in_function = prev_in_function; if (is_function) { pp_string (buffer, " return "); dump_generic_ada_node (buffer, TREE_TYPE (fnode), type, cpp_check, spc, 0, true); } } else { 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 (!name_only) pp_string (buffer, "new "); if (package_prefix) { append_withs ("System", false); pp_string (buffer, "System.Address"); } else pp_string (buffer, "address"); } else { if (TREE_CODE (node) == POINTER_TYPE && TREE_CODE (TREE_TYPE (node)) == INTEGER_TYPE && !strcmp (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (TREE_TYPE (node)))), "char")) { if (!name_only) pp_string (buffer, "new "); if (package_prefix) { pp_string (buffer, "Interfaces.C.Strings.chars_ptr"); append_withs ("Interfaces.C.Strings", false); } else pp_string (buffer, "chars_ptr"); } 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)); 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))) { if (package_prefix) { append_withs ("System", false); if (!name_only) pp_string (buffer, "new "); pp_string (buffer, "System.Address"); } else pp_string (buffer, "address"); return spc; } if (!package_prefix) pp_string (buffer, "access"); else if (AGGREGATE_TYPE_P (TREE_TYPE (node))) { if (!type || TREE_CODE (type) != FUNCTION_DECL) { pp_string (buffer, "access "); is_access = true; if (quals & TYPE_QUAL_CONST) pp_string (buffer, "constant "); else if (!name_only) pp_string (buffer, "all "); } 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; pp_string (buffer, "access "); /* ??? should be configurable: access or in out. */ } } else { is_access = true; pp_string (buffer, "access "); if (!name_only) 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); else dump_generic_ada_node (buffer, TREE_TYPE (node), TREE_TYPE (node), cpp_check, spc, 0, true); } } } break; case ARRAY_TYPE: if (name_only) dump_generic_ada_node (buffer, TYPE_NAME (node), node, cpp_check, spc, limited_access, true); else dump_ada_array_type (buffer, node, 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); else { pp_string (buffer, "anon_"); pp_scalar (buffer, "%d", TYPE_UID (node)); } } else print_ada_struct_decl (buffer, node, type, cpp_check, 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)) { 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) { pp_character (buffer, '-'); high = ~high + !low; low = -low; } sprintf (pp_buffer (buffer)->digit_buffer, HOST_WIDE_INT_PRINT_DOUBLE_HEX, (unsigned HOST_WIDE_INT) high, low); pp_string (buffer, pp_buffer (buffer)->digit_buffer); } else pp_wide_integer (buffer, TREE_INT_CST_LOW (node)); break; case REAL_CST: case FIXED_CST: case COMPLEX_CST: case STRING_CST: 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)) { /* Don't print the declaration of built-in types. */ if (name_only) { /* If we're in the middle of a declaration, defaults to System.Address. */ if (package_prefix) { append_withs ("System", false); pp_string (buffer, "System.Address"); } else pp_string (buffer, "address"); } break; } if (name_only) dump_ada_decl_name (buffer, node, limited_access); else { 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)) { if (!DECL_NAME (tmp) && is_tagged_type (TREE_TYPE (tmp))) { if (first) { pp_string (buffer, "limited new "); first = 0; } else pp_string (buffer, " and "); dump_ada_decl_name (buffer, TYPE_NAME (TREE_TYPE (tmp)), false); } } pp_string (buffer, first ? "tagged limited " : " with "); } else if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node)) && TYPE_METHODS (TREE_TYPE (node))) pp_string (buffer, "limited "); dump_generic_ada_node (buffer, TREE_TYPE (node), type, cpp_check, spc, false, false); } break; case VAR_DECL: case PARM_DECL: case FIELD_DECL: case NAMESPACE_DECL: dump_ada_decl_name (buffer, node, false); break; default: /* Ignore other nodes (e.g. expressions). */ return 0; } 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) { tree tmp = TYPE_METHODS (node); 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); } } } /* 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. */ static void dump_nested_types (pretty_printer *buffer, tree t, tree parent, bool forward, int (*cpp_check)(tree, cpp_operation), int spc) { tree field, outer, decl; /* 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) return; if (forward) { pp_string (buffer, "type "); dump_generic_ada_node (buffer, t, t, cpp_check, spc, false, true); pp_semicolon (buffer); newline_and_indent (buffer, spc); TREE_VISITED (t) = 1; } field = TYPE_FIELDS (outer); while (field) { 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)))) { switch (TREE_CODE (TREE_TYPE (field))) { 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; } } field = TREE_CHAIN (field); } TREE_VISITED (t) = 1; } /* Dump in BUFFER destructor spec corresponding to T. */ static void print_destructor (pretty_printer *buffer, tree t) { 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); } } /* Return the name of type T. */ static const char * type_name (tree t) { tree n = TYPE_NAME (t); if (TREE_CODE (n) == IDENTIFIER_NODE) return IDENTIFIER_POINTER (n); else 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. */ static int print_ada_declaration (pretty_printer *buffer, tree t, tree type, int (*cpp_check)(tree, cpp_operation), 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); 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. */ return 0; if (TREE_CODE (t) == TYPE_DECL) { orig = DECL_ORIGINAL_TYPE (t); if (orig && TYPE_STUB_DECL (orig)) { tree stub = TYPE_STUB_DECL (orig); tree typ = TREE_TYPE (stub); if (TYPE_NAME (typ)) { /* If types have same representation, and same name (ignoring 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; 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); } else { if (!TREE_VISITED (stub) && DECL_SOURCE_FILE (stub) == source_file_base) dump_nested_types (buffer, stub, stub, true, cpp_check, spc); pp_string (buffer, "subtype "); dump_generic_ada_node (buffer, t, type, 0, spc, false, true); pp_string (buffer, " is "); dump_generic_ada_node (buffer, typ, type, 0, spc, false, true); pp_semicolon (buffer); } 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 && 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); switch (TREE_CODE (TREE_TYPE (t))) { 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); return 1; } if (decl_name && (*IDENTIFIER_POINTER (decl_name) == '.' || *IDENTIFIER_POINTER (decl_name) == '$')) { pp_string (buffer, "-- skipped anonymous struct "); dump_generic_ada_node (buffer, t, type, 0, spc, false, true); TREE_VISITED (t) = 1; return 1; } if (orig && TYPE_NAME (orig) && orig != TREE_TYPE (t)) pp_string (buffer, "subtype "); else { dump_nested_types (buffer, t, t, false, cpp_check, 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); pp_string (buffer, " is"); spc += INDENT_INCR; newline_and_indent (buffer, spc); } pp_string (buffer, "type "); } break; case ARRAY_TYPE: case POINTER_TYPE: case REFERENCE_TYPE: if ((orig && TYPE_NAME (orig) && orig != TREE_TYPE (t)) || is_char_array (t)) pp_string (buffer, "subtype "); else pp_string (buffer, "type "); break; case FUNCTION_TYPE: pp_string (buffer, "-- skipped function type "); dump_generic_ada_node (buffer, t, type, 0, spc, false, true); return 1; break; case ENUMERAL_TYPE: if ((orig && TYPE_NAME (orig) && orig != TREE_TYPE (t)) || !is_simple_enum (TREE_TYPE (t))) pp_string (buffer, "subtype "); else pp_string (buffer, "type "); break; default: pp_string (buffer, "subtype "); } TREE_VISITED (t) = 1; } else { if (!dump_internal && TREE_CODE (t) == VAR_DECL && decl_name && *IDENTIFIER_POINTER (decl_name) == '_') return 0; need_indent = 1; } /* Print the type and name. */ if (TREE_CODE (TREE_TYPE (t)) == ARRAY_TYPE) { if (need_indent) INDENT (spc); /* Print variable's name. */ dump_generic_ada_node (buffer, t, type, cpp_check, spc, false, true); if (TREE_CODE (t) == TYPE_DECL) { pp_string (buffer, " is "); if (orig && TYPE_NAME (orig) && orig != TREE_TYPE (t)) dump_generic_ada_node (buffer, TYPE_NAME (orig), type, cpp_check, spc, false, true); else dump_ada_array_type (buffer, t, spc); } else { tree tmp = TYPE_NAME (TREE_TYPE (t)); if (spc == INDENT_INCR || TREE_STATIC (t)) is_var = 1; pp_string (buffer, " : "); 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); } else { pp_string (buffer, "aliased "); if (!type) dump_ada_array_type (buffer, t, spc); else dump_ada_double_name (buffer, type, t, "_array"); } } } else if (TREE_CODE (t) == FUNCTION_DECL) { bool is_function = true, is_method, is_abstract_class = false; 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; if (!decl_name) return 0; if (cpp_check) { is_abstract = cpp_check (t, IS_ABSTRACT); is_constructor = cpp_check (t, IS_CONSTRUCTOR); is_destructor = cpp_check (t, IS_DESTRUCTOR); is_copy_constructor = cpp_check (t, IS_COPY_CONSTRUCTOR); } /* Skip __comp_dtor destructor which is redundant with the '~class()' destructor. */ if (is_destructor && !strncmp (IDENTIFIER_POINTER (decl_name), "__comp", 6)) 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 (IDENTIFIER_POINTER (decl_name)[1] == '_') return 0; INDENT (spc); pp_string (buffer, "-- skipped func "); pp_string (buffer, IDENTIFIER_POINTER (decl_name)); return 1; } 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 "); } 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); 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) { dump_ada_decl_name (buffer, t, false); } else { dump_generic_ada_node (buffer, TREE_TYPE (TREE_TYPE (t)), type, cpp_check, spc, false, true); } } 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"); pp_semicolon (buffer); pp_string (buffer, " -- "); dump_sloc (buffer, t); if (is_abstract) 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, ", \""); pp_asm_name (buffer, t); pp_string (buffer, "\");"); } else if (is_destructor) { pp_string (buffer, "pragma Import (CPP, "); print_destructor (buffer, t); pp_string (buffer, ", \""); pp_asm_name (buffer, t); pp_string (buffer, "\");"); } else { dump_ada_import (buffer, t); } return 1; } else if (TREE_CODE (t) == TYPE_DECL && !DECL_ORIGINAL_TYPE (t)) { int is_interface = 0; int is_abstract_record = 0; if (need_indent) 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) { 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))) { int num_fields = 0; tree tmp = TYPE_FIELDS (TREE_TYPE (t)); /* Check that there are no fields other than the virtual table. */ for (; tmp; tmp = TREE_CHAIN (tmp)) { 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; } } TREE_VISITED (t) = 1; if (is_interface) { pp_string (buffer, "limited interface; -- "); dump_sloc (buffer, t); 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); } else { if (is_abstract_record) pp_string (buffer, "abstract "); dump_generic_ada_node (buffer, t, t, cpp_check, spc, false, false); } } else { if (need_indent) INDENT (spc); if (TREE_CODE (t) == FIELD_DECL && DECL_NAME (t)) check_name (buffer, t); /* Print variable/type's name. */ dump_generic_ada_node (buffer, t, t, cpp_check, 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)) pp_string (buffer, " (discr : unsigned := 0)"); pp_string (buffer, " is "); dump_generic_ada_node (buffer, orig, t, cpp_check, spc, false, is_subtype); } else { if (spc == INDENT_INCR || TREE_STATIC (t)) is_var = 1; pp_string (buffer, " : "); /* Print type declaration. */ if (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE && !TYPE_NAME (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); } else { if (TREE_CODE (TREE_TYPE (t)) != POINTER_TYPE && (TYPE_NAME (TREE_TYPE (t)) || TREE_CODE (TREE_TYPE (t)) != INTEGER_TYPE)) pp_string (buffer, "aliased "); dump_generic_ada_node (buffer, TREE_TYPE (t), TREE_TYPE (t), cpp_check, spc, false, true); } } } if (is_class) { spc -= 3; 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); pp_semicolon (buffer); pp_newline (buffer); /* All needed indentation/newline performed already, so return 0. */ return 0; } else { pp_string (buffer, "; -- "); dump_sloc (buffer, t); } if (is_var) { newline_and_indent (buffer, spc); dump_ada_import (buffer, t); } 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. */ static void print_ada_struct_decl (pretty_printer *buffer, tree node, tree type, int (*cpp_check)(tree, cpp_operation), int spc, bool display_convention) { tree tmp; int is_union = TREE_CODE (node) == UNION_TYPE || TREE_CODE (node) == QUAL_UNION_TYPE; char buf [16]; 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 { pp_string (buffer, "record"); /* Print the contents of the structure. */ if (is_union) { newline_and_indent (buffer, spc + INDENT_INCR); pp_string (buffer, "case discr is"); field_spc = spc + INDENT_INCR * 3; } pp_newline (buffer); /* Print the non-static fields of the structure. */ for (tmp = TYPE_FIELDS (node); tmp; tmp = TREE_CHAIN (tmp)) { /* Add parent field if needed. */ if (!DECL_NAME (tmp)) { if (!is_tagged_type (TREE_TYPE (tmp))) { if (!TYPE_NAME (TREE_TYPE (tmp))) print_ada_declaration (buffer, tmp, type, cpp_check, field_spc); else { INDENT (field_spc); if (field_num == 0) pp_string (buffer, "parent : "); else { sprintf (buf, "field_%d : ", field_num + 1); pp_string (buffer, buf); } dump_ada_decl_name (buffer, TYPE_NAME (TREE_TYPE (tmp)), false); pp_semicolon (buffer); } pp_newline (buffer); 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)) { /* Skip internal virtual table field. */ if (strncmp (IDENTIFIER_POINTER (DECL_NAME (tmp)), "_vptr", 5)) { if (is_union) { if (TREE_CHAIN (tmp) && TREE_TYPE (TREE_CHAIN (tmp)) != node && TREE_CODE (TREE_CHAIN (tmp)) != TYPE_DECL) sprintf (buf, "when %d =>", field_num); else sprintf (buf, "when others =>"); INDENT (spc + INDENT_INCR * 2); pp_string (buffer, buf); pp_newline (buffer); } if (print_ada_declaration (buffer, tmp, type, cpp_check, field_spc)) { pp_newline (buffer); field_num++; } } } } if (is_union) { INDENT (spc + INDENT_INCR); pp_string (buffer, "end case;"); pp_newline (buffer); } if (field_num == 0) { INDENT (spc + INDENT_INCR); pp_string (buffer, "null;"); pp_newline (buffer); } INDENT (spc); pp_string (buffer, "end record;"); } newline_and_indent (buffer, spc); if (!display_convention) return; if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (type))) { if (TYPE_METHODS (TREE_TYPE (type))) pp_string (buffer, "pragma Import (CPP, "); else pp_string (buffer, "pragma Convention (C_Pass_By_Copy, "); } else pp_string (buffer, "pragma Convention (C, "); package_prefix = false; dump_generic_ada_node (buffer, TREE_TYPE (type), type, cpp_check, spc, false, true); package_prefix = true; pp_character (buffer, ')'); if (is_union) { pp_semicolon (buffer); 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, ')'); } if (bitfield_used) { pp_semicolon (buffer); 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, ')'); bitfield_used = false; } print_ada_methods (buffer, node, cpp_check, 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 (need_semicolon) { need_semicolon = false; pp_semicolon (buffer); } pp_newline (buffer); pp_newline (buffer); print_ada_declaration (buffer, tmp, type, cpp_check, 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. */ static void dump_ads (const char *source_file, void (*collect_all_refs)(const char *), int (*cpp_check)(tree, cpp_operation)) { char *ads_name; char *pkg_name; char *s; FILE *f; pkg_name = get_ada_package (source_file); /* Construct the .ads filename and package name. */ ads_name = xstrdup (pkg_name); for (s = ads_name; *s; s++) *s = TOLOWER (*s); ads_name = reconcat (ads_name, ads_name, ".ads", NULL); /* Write out the .ads file. */ f = fopen (ads_name, "w"); if (f) { pretty_printer pp; pp_construct (&pp, NULL, 0); pp_needs_newline (&pp) = true; pp.buffer->stream = f; /* Dump all relevant macros. */ dump_ada_macros (&pp, source_file); /* Reset the table of withs for this file. */ reset_ada_withs (); (*collect_all_refs) (source_file); /* Dump all references. */ dump_ada_nodes (&pp, source_file, cpp_check); /* Dump withs. */ dump_ada_withs (f); fprintf (f, "\npackage %s is\n\n", pkg_name); pp_write_text_to_stream (&pp); /* ??? need to free pp */ fprintf (f, "end %s;\n", pkg_name); fclose (f); } free (ads_name); free (pkg_name); } static const char **source_refs = NULL; static int source_refs_used = 0; static int source_refs_allocd = 0; /* Add an entry for FILENAME to the table SOURCE_REFS. */ void collect_source_ref (const char *filename) { int i; if (!filename) return; if (source_refs_allocd == 0) { source_refs_allocd = 1024; source_refs = XNEWVEC (const char *, source_refs_allocd); } for (i = 0; i < source_refs_used; i++) if (filename == source_refs [i]) return; if (source_refs_used == source_refs_allocd) { source_refs_allocd *= 2; source_refs = XRESIZEVEC (const char *, source_refs, source_refs_allocd); } 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. 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 front-end. */ void dump_ada_specs (void (*collect_all_refs)(const char *), int (*cpp_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. */ free (source_refs); }
Go to most recent revision | Compare with Previous | Blame | View Log