/* Print GENERIC declaration (functions, variables, types) trees coming from
|
/* Print GENERIC declaration (functions, variables, types) trees coming from
|
the C and C++ front-ends as well as macros in Ada syntax.
|
the C and C++ front-ends as well as macros in Ada syntax.
|
Copyright (C) 2010 Free Software Foundation, Inc.
|
Copyright (C) 2010 Free Software Foundation, Inc.
|
Adapted from tree-pretty-print.c by Arnaud Charlet <charlet@adacore.com>
|
Adapted from tree-pretty-print.c by Arnaud Charlet <charlet@adacore.com>
|
|
|
This file is part of GCC.
|
This file is part of GCC.
|
|
|
GCC is free software; you can redistribute it and/or modify it under
|
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
|
the terms of the GNU General Public License as published by the Free
|
Software Foundation; either version 3, or (at your option) any later
|
Software Foundation; either version 3, or (at your option) any later
|
version.
|
version.
|
|
|
GCC is distributed in the hope that it will be useful, but WITHOUT ANY
|
GCC is distributed in the hope that it will be useful, but WITHOUT ANY
|
WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
for more details.
|
for more details.
|
|
|
You should have received a copy of the GNU General Public License
|
You should have received a copy of the GNU General Public License
|
along with GCC; see the file COPYING3. If not see
|
along with GCC; see the file COPYING3. If not see
|
<http://www.gnu.org/licenses/>. */
|
<http://www.gnu.org/licenses/>. */
|
|
|
#include "config.h"
|
#include "config.h"
|
#include "system.h"
|
#include "system.h"
|
#include "coretypes.h"
|
#include "coretypes.h"
|
#include "tm.h"
|
#include "tm.h"
|
#include "tree.h"
|
#include "tree.h"
|
#include "tree-pass.h" /* For TDI_ada and friends. */
|
#include "tree-pass.h" /* For TDI_ada and friends. */
|
#include "output.h"
|
#include "output.h"
|
#include "c-ada-spec.h"
|
#include "c-ada-spec.h"
|
#include "cpplib.h"
|
#include "cpplib.h"
|
#include "c-pragma.h"
|
#include "c-pragma.h"
|
#include "cpp-id-data.h"
|
#include "cpp-id-data.h"
|
|
|
/* Local functions, macros and variables. */
|
/* Local functions, macros and variables. */
|
static int dump_generic_ada_node (pretty_printer *, tree, tree,
|
static int dump_generic_ada_node (pretty_printer *, tree, tree,
|
int (*)(tree, cpp_operation), int, int, bool);
|
int (*)(tree, cpp_operation), int, int, bool);
|
static int print_ada_declaration (pretty_printer *, tree, tree,
|
static int print_ada_declaration (pretty_printer *, tree, tree,
|
int (*cpp_check)(tree, cpp_operation), int);
|
int (*cpp_check)(tree, cpp_operation), int);
|
static void print_ada_struct_decl (pretty_printer *, tree, tree,
|
static void print_ada_struct_decl (pretty_printer *, tree, tree,
|
int (*cpp_check)(tree, cpp_operation), int,
|
int (*cpp_check)(tree, cpp_operation), int,
|
bool);
|
bool);
|
static void dump_sloc (pretty_printer *buffer, tree node);
|
static void dump_sloc (pretty_printer *buffer, tree node);
|
static void print_comment (pretty_printer *, const char *);
|
static void print_comment (pretty_printer *, const char *);
|
static void print_generic_ada_decl (pretty_printer *, tree,
|
static void print_generic_ada_decl (pretty_printer *, tree,
|
int (*)(tree, cpp_operation), const char *);
|
int (*)(tree, cpp_operation), const char *);
|
static char *get_ada_package (const char *);
|
static char *get_ada_package (const char *);
|
static void dump_ada_nodes (pretty_printer *, const char *,
|
static void dump_ada_nodes (pretty_printer *, const char *,
|
int (*)(tree, cpp_operation));
|
int (*)(tree, cpp_operation));
|
static void reset_ada_withs (void);
|
static void reset_ada_withs (void);
|
static void dump_ada_withs (FILE *);
|
static void dump_ada_withs (FILE *);
|
static void dump_ads (const char *, void (*)(const char *),
|
static void dump_ads (const char *, void (*)(const char *),
|
int (*)(tree, cpp_operation));
|
int (*)(tree, cpp_operation));
|
static char *to_ada_name (const char *, int *);
|
static char *to_ada_name (const char *, int *);
|
static bool separate_class_package (tree);
|
static bool separate_class_package (tree);
|
|
|
#define LOCATION_COL(LOC) ((expand_location (LOC)).column)
|
#define LOCATION_COL(LOC) ((expand_location (LOC)).column)
|
|
|
#define INDENT(SPACE) do { \
|
#define INDENT(SPACE) do { \
|
int i; for (i = 0; i<SPACE; i++) pp_space (buffer); } while (0)
|
int i; for (i = 0; i<SPACE; i++) pp_space (buffer); } while (0)
|
|
|
#define INDENT_INCR 3
|
#define INDENT_INCR 3
|
|
|
/* Given a cpp MACRO, compute the max length BUFFER_LEN of the macro, as well
|
/* 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
|
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. */
|
SUPPORTED to 0 if the macro cannot be mapped to an Ada construct. */
|
|
|
static void
|
static void
|
macro_length (const cpp_macro *macro, int *supported, int *buffer_len,
|
macro_length (const cpp_macro *macro, int *supported, int *buffer_len,
|
int *param_len)
|
int *param_len)
|
{
|
{
|
int i;
|
int i;
|
unsigned j;
|
unsigned j;
|
|
|
*supported = 1;
|
*supported = 1;
|
*buffer_len = 0;
|
*buffer_len = 0;
|
*param_len = 0;
|
*param_len = 0;
|
|
|
if (macro->fun_like)
|
if (macro->fun_like)
|
{
|
{
|
param_len++;
|
param_len++;
|
for (i = 0; i < macro->paramc; i++)
|
for (i = 0; i < macro->paramc; i++)
|
{
|
{
|
cpp_hashnode *param = macro->params[i];
|
cpp_hashnode *param = macro->params[i];
|
|
|
*param_len += NODE_LEN (param);
|
*param_len += NODE_LEN (param);
|
|
|
if (i + 1 < macro->paramc)
|
if (i + 1 < macro->paramc)
|
{
|
{
|
*param_len += 2; /* ", " */
|
*param_len += 2; /* ", " */
|
}
|
}
|
else if (macro->variadic)
|
else if (macro->variadic)
|
{
|
{
|
*supported = 0;
|
*supported = 0;
|
return;
|
return;
|
}
|
}
|
}
|
}
|
*param_len += 2; /* ")\0" */
|
*param_len += 2; /* ")\0" */
|
}
|
}
|
|
|
for (j = 0; j < macro->count; j++)
|
for (j = 0; j < macro->count; j++)
|
{
|
{
|
cpp_token *token = ¯o->exp.tokens[j];
|
cpp_token *token = ¯o->exp.tokens[j];
|
|
|
if (token->flags & PREV_WHITE)
|
if (token->flags & PREV_WHITE)
|
(*buffer_len)++;
|
(*buffer_len)++;
|
|
|
if (token->flags & STRINGIFY_ARG || token->flags & PASTE_LEFT)
|
if (token->flags & STRINGIFY_ARG || token->flags & PASTE_LEFT)
|
{
|
{
|
*supported = 0;
|
*supported = 0;
|
return;
|
return;
|
}
|
}
|
|
|
if (token->type == CPP_MACRO_ARG)
|
if (token->type == CPP_MACRO_ARG)
|
*buffer_len +=
|
*buffer_len +=
|
NODE_LEN (macro->params[token->val.macro_arg.arg_no - 1]);
|
NODE_LEN (macro->params[token->val.macro_arg.arg_no - 1]);
|
else
|
else
|
/* Include enough extra space to handle e.g. special characters. */
|
/* Include enough extra space to handle e.g. special characters. */
|
*buffer_len += (cpp_token_len (token) + 1) * 8;
|
*buffer_len += (cpp_token_len (token) + 1) * 8;
|
}
|
}
|
|
|
(*buffer_len)++;
|
(*buffer_len)++;
|
}
|
}
|
|
|
/* Dump into PP a set of MAX_ADA_MACROS MACROS (C/C++) as Ada constants when
|
/* Dump into PP a set of MAX_ADA_MACROS MACROS (C/C++) as Ada constants when
|
possible. */
|
possible. */
|
|
|
static void
|
static void
|
print_ada_macros (pretty_printer *pp, cpp_hashnode **macros, int max_ada_macros)
|
print_ada_macros (pretty_printer *pp, cpp_hashnode **macros, int max_ada_macros)
|
{
|
{
|
int j, num_macros = 0, prev_line = -1;
|
int j, num_macros = 0, prev_line = -1;
|
|
|
for (j = 0; j < max_ada_macros; j++)
|
for (j = 0; j < max_ada_macros; j++)
|
{
|
{
|
cpp_hashnode *node = macros [j];
|
cpp_hashnode *node = macros [j];
|
const cpp_macro *macro = node->value.macro;
|
const cpp_macro *macro = node->value.macro;
|
unsigned i;
|
unsigned i;
|
int supported = 1, prev_is_one = 0, buffer_len, param_len;
|
int supported = 1, prev_is_one = 0, buffer_len, param_len;
|
int is_string = 0, is_char = 0;
|
int is_string = 0, is_char = 0;
|
char *ada_name;
|
char *ada_name;
|
unsigned char *s, *params, *buffer, *buf_param, *char_one = NULL;
|
unsigned char *s, *params, *buffer, *buf_param, *char_one = NULL;
|
|
|
macro_length (macro, &supported, &buffer_len, ¶m_len);
|
macro_length (macro, &supported, &buffer_len, ¶m_len);
|
s = buffer = XALLOCAVEC (unsigned char, buffer_len);
|
s = buffer = XALLOCAVEC (unsigned char, buffer_len);
|
params = buf_param = XALLOCAVEC (unsigned char, param_len);
|
params = buf_param = XALLOCAVEC (unsigned char, param_len);
|
|
|
if (supported)
|
if (supported)
|
{
|
{
|
if (macro->fun_like)
|
if (macro->fun_like)
|
{
|
{
|
*buf_param++ = '(';
|
*buf_param++ = '(';
|
for (i = 0; i < macro->paramc; i++)
|
for (i = 0; i < macro->paramc; i++)
|
{
|
{
|
cpp_hashnode *param = macro->params[i];
|
cpp_hashnode *param = macro->params[i];
|
|
|
memcpy (buf_param, NODE_NAME (param), NODE_LEN (param));
|
memcpy (buf_param, NODE_NAME (param), NODE_LEN (param));
|
buf_param += NODE_LEN (param);
|
buf_param += NODE_LEN (param);
|
|
|
if (i + 1 < macro->paramc)
|
if (i + 1 < macro->paramc)
|
{
|
{
|
*buf_param++ = ',';
|
*buf_param++ = ',';
|
*buf_param++ = ' ';
|
*buf_param++ = ' ';
|
}
|
}
|
else if (macro->variadic)
|
else if (macro->variadic)
|
{
|
{
|
supported = 0;
|
supported = 0;
|
break;
|
break;
|
}
|
}
|
}
|
}
|
*buf_param++ = ')';
|
*buf_param++ = ')';
|
*buf_param = '\0';
|
*buf_param = '\0';
|
}
|
}
|
|
|
for (i = 0; supported && i < macro->count; i++)
|
for (i = 0; supported && i < macro->count; i++)
|
{
|
{
|
cpp_token *token = ¯o->exp.tokens[i];
|
cpp_token *token = ¯o->exp.tokens[i];
|
int is_one = 0;
|
int is_one = 0;
|
|
|
if (token->flags & PREV_WHITE)
|
if (token->flags & PREV_WHITE)
|
*buffer++ = ' ';
|
*buffer++ = ' ';
|
|
|
if (token->flags & STRINGIFY_ARG || token->flags & PASTE_LEFT)
|
if (token->flags & STRINGIFY_ARG || token->flags & PASTE_LEFT)
|
{
|
{
|
supported = 0;
|
supported = 0;
|
break;
|
break;
|
}
|
}
|
|
|
switch (token->type)
|
switch (token->type)
|
{
|
{
|
case CPP_MACRO_ARG:
|
case CPP_MACRO_ARG:
|
{
|
{
|
cpp_hashnode *param =
|
cpp_hashnode *param =
|
macro->params[token->val.macro_arg.arg_no - 1];
|
macro->params[token->val.macro_arg.arg_no - 1];
|
memcpy (buffer, NODE_NAME (param), NODE_LEN (param));
|
memcpy (buffer, NODE_NAME (param), NODE_LEN (param));
|
buffer += NODE_LEN (param);
|
buffer += NODE_LEN (param);
|
}
|
}
|
break;
|
break;
|
|
|
case CPP_EQ_EQ: *buffer++ = '='; break;
|
case CPP_EQ_EQ: *buffer++ = '='; break;
|
case CPP_GREATER: *buffer++ = '>'; break;
|
case CPP_GREATER: *buffer++ = '>'; break;
|
case CPP_LESS: *buffer++ = '<'; break;
|
case CPP_LESS: *buffer++ = '<'; break;
|
case CPP_PLUS: *buffer++ = '+'; break;
|
case CPP_PLUS: *buffer++ = '+'; break;
|
case CPP_MINUS: *buffer++ = '-'; break;
|
case CPP_MINUS: *buffer++ = '-'; break;
|
case CPP_MULT: *buffer++ = '*'; break;
|
case CPP_MULT: *buffer++ = '*'; break;
|
case CPP_DIV: *buffer++ = '/'; break;
|
case CPP_DIV: *buffer++ = '/'; break;
|
case CPP_COMMA: *buffer++ = ','; break;
|
case CPP_COMMA: *buffer++ = ','; break;
|
case CPP_OPEN_SQUARE:
|
case CPP_OPEN_SQUARE:
|
case CPP_OPEN_PAREN: *buffer++ = '('; break;
|
case CPP_OPEN_PAREN: *buffer++ = '('; break;
|
case CPP_CLOSE_SQUARE: /* fallthrough */
|
case CPP_CLOSE_SQUARE: /* fallthrough */
|
case CPP_CLOSE_PAREN: *buffer++ = ')'; break;
|
case CPP_CLOSE_PAREN: *buffer++ = ')'; break;
|
case CPP_DEREF: /* fallthrough */
|
case CPP_DEREF: /* fallthrough */
|
case CPP_SCOPE: /* fallthrough */
|
case CPP_SCOPE: /* fallthrough */
|
case CPP_DOT: *buffer++ = '.'; break;
|
case CPP_DOT: *buffer++ = '.'; break;
|
|
|
case CPP_EQ: *buffer++ = ':'; *buffer++ = '='; break;
|
case CPP_EQ: *buffer++ = ':'; *buffer++ = '='; break;
|
case CPP_NOT_EQ: *buffer++ = '/'; *buffer++ = '='; break;
|
case CPP_NOT_EQ: *buffer++ = '/'; *buffer++ = '='; break;
|
case CPP_GREATER_EQ: *buffer++ = '>'; *buffer++ = '='; break;
|
case CPP_GREATER_EQ: *buffer++ = '>'; *buffer++ = '='; break;
|
case CPP_LESS_EQ: *buffer++ = '<'; *buffer++ = '='; break;
|
case CPP_LESS_EQ: *buffer++ = '<'; *buffer++ = '='; break;
|
|
|
case CPP_NOT:
|
case CPP_NOT:
|
*buffer++ = 'n'; *buffer++ = 'o'; *buffer++ = 't'; break;
|
*buffer++ = 'n'; *buffer++ = 'o'; *buffer++ = 't'; break;
|
case CPP_MOD:
|
case CPP_MOD:
|
*buffer++ = 'm'; *buffer++ = 'o'; *buffer++ = 'd'; break;
|
*buffer++ = 'm'; *buffer++ = 'o'; *buffer++ = 'd'; break;
|
case CPP_AND:
|
case CPP_AND:
|
*buffer++ = 'a'; *buffer++ = 'n'; *buffer++ = 'd'; break;
|
*buffer++ = 'a'; *buffer++ = 'n'; *buffer++ = 'd'; break;
|
case CPP_OR:
|
case CPP_OR:
|
*buffer++ = 'o'; *buffer++ = 'r'; break;
|
*buffer++ = 'o'; *buffer++ = 'r'; break;
|
case CPP_XOR:
|
case CPP_XOR:
|
*buffer++ = 'x'; *buffer++ = 'o'; *buffer++ = 'r'; break;
|
*buffer++ = 'x'; *buffer++ = 'o'; *buffer++ = 'r'; break;
|
case CPP_AND_AND:
|
case CPP_AND_AND:
|
strcpy ((char *) buffer, " and then ");
|
strcpy ((char *) buffer, " and then ");
|
buffer += 10;
|
buffer += 10;
|
break;
|
break;
|
case CPP_OR_OR:
|
case CPP_OR_OR:
|
strcpy ((char *) buffer, " or else ");
|
strcpy ((char *) buffer, " or else ");
|
buffer += 9;
|
buffer += 9;
|
break;
|
break;
|
|
|
case CPP_PADDING:
|
case CPP_PADDING:
|
*buffer++ = ' ';
|
*buffer++ = ' ';
|
is_one = prev_is_one;
|
is_one = prev_is_one;
|
break;
|
break;
|
|
|
case CPP_COMMENT: break;
|
case CPP_COMMENT: break;
|
|
|
case CPP_WSTRING:
|
case CPP_WSTRING:
|
case CPP_STRING16:
|
case CPP_STRING16:
|
case CPP_STRING32:
|
case CPP_STRING32:
|
case CPP_UTF8STRING:
|
case CPP_UTF8STRING:
|
case CPP_WCHAR:
|
case CPP_WCHAR:
|
case CPP_CHAR16:
|
case CPP_CHAR16:
|
case CPP_CHAR32:
|
case CPP_CHAR32:
|
case CPP_NAME:
|
case CPP_NAME:
|
case CPP_STRING:
|
case CPP_STRING:
|
case CPP_NUMBER:
|
case CPP_NUMBER:
|
if (!macro->fun_like)
|
if (!macro->fun_like)
|
supported = 0;
|
supported = 0;
|
else
|
else
|
buffer = cpp_spell_token (parse_in, token, buffer, false);
|
buffer = cpp_spell_token (parse_in, token, buffer, false);
|
break;
|
break;
|
|
|
case CPP_CHAR:
|
case CPP_CHAR:
|
is_char = 1;
|
is_char = 1;
|
{
|
{
|
unsigned chars_seen;
|
unsigned chars_seen;
|
int ignored;
|
int ignored;
|
cppchar_t c;
|
cppchar_t c;
|
|
|
c = cpp_interpret_charconst (parse_in, token,
|
c = cpp_interpret_charconst (parse_in, token,
|
&chars_seen, &ignored);
|
&chars_seen, &ignored);
|
if (c >= 32 && c <= 126)
|
if (c >= 32 && c <= 126)
|
{
|
{
|
*buffer++ = '\'';
|
*buffer++ = '\'';
|
*buffer++ = (char) c;
|
*buffer++ = (char) c;
|
*buffer++ = '\'';
|
*buffer++ = '\'';
|
}
|
}
|
else
|
else
|
{
|
{
|
chars_seen = sprintf
|
chars_seen = sprintf
|
((char *) buffer, "Character'Val (%d)", (int) c);
|
((char *) buffer, "Character'Val (%d)", (int) c);
|
buffer += chars_seen;
|
buffer += chars_seen;
|
}
|
}
|
}
|
}
|
break;
|
break;
|
|
|
case CPP_LSHIFT:
|
case CPP_LSHIFT:
|
if (prev_is_one)
|
if (prev_is_one)
|
{
|
{
|
/* Replace "1 << N" by "2 ** N" */
|
/* Replace "1 << N" by "2 ** N" */
|
*char_one = '2';
|
*char_one = '2';
|
*buffer++ = '*';
|
*buffer++ = '*';
|
*buffer++ = '*';
|
*buffer++ = '*';
|
break;
|
break;
|
}
|
}
|
/* fallthrough */
|
/* fallthrough */
|
|
|
case CPP_RSHIFT:
|
case CPP_RSHIFT:
|
case CPP_COMPL:
|
case CPP_COMPL:
|
case CPP_QUERY:
|
case CPP_QUERY:
|
case CPP_EOF:
|
case CPP_EOF:
|
case CPP_PLUS_EQ:
|
case CPP_PLUS_EQ:
|
case CPP_MINUS_EQ:
|
case CPP_MINUS_EQ:
|
case CPP_MULT_EQ:
|
case CPP_MULT_EQ:
|
case CPP_DIV_EQ:
|
case CPP_DIV_EQ:
|
case CPP_MOD_EQ:
|
case CPP_MOD_EQ:
|
case CPP_AND_EQ:
|
case CPP_AND_EQ:
|
case CPP_OR_EQ:
|
case CPP_OR_EQ:
|
case CPP_XOR_EQ:
|
case CPP_XOR_EQ:
|
case CPP_RSHIFT_EQ:
|
case CPP_RSHIFT_EQ:
|
case CPP_LSHIFT_EQ:
|
case CPP_LSHIFT_EQ:
|
case CPP_PRAGMA:
|
case CPP_PRAGMA:
|
case CPP_PRAGMA_EOL:
|
case CPP_PRAGMA_EOL:
|
case CPP_HASH:
|
case CPP_HASH:
|
case CPP_PASTE:
|
case CPP_PASTE:
|
case CPP_OPEN_BRACE:
|
case CPP_OPEN_BRACE:
|
case CPP_CLOSE_BRACE:
|
case CPP_CLOSE_BRACE:
|
case CPP_SEMICOLON:
|
case CPP_SEMICOLON:
|
case CPP_ELLIPSIS:
|
case CPP_ELLIPSIS:
|
case CPP_PLUS_PLUS:
|
case CPP_PLUS_PLUS:
|
case CPP_MINUS_MINUS:
|
case CPP_MINUS_MINUS:
|
case CPP_DEREF_STAR:
|
case CPP_DEREF_STAR:
|
case CPP_DOT_STAR:
|
case CPP_DOT_STAR:
|
case CPP_ATSIGN:
|
case CPP_ATSIGN:
|
case CPP_HEADER_NAME:
|
case CPP_HEADER_NAME:
|
case CPP_AT_NAME:
|
case CPP_AT_NAME:
|
case CPP_OTHER:
|
case CPP_OTHER:
|
case CPP_OBJC_STRING:
|
case CPP_OBJC_STRING:
|
default:
|
default:
|
if (!macro->fun_like)
|
if (!macro->fun_like)
|
supported = 0;
|
supported = 0;
|
else
|
else
|
buffer = cpp_spell_token (parse_in, token, buffer, false);
|
buffer = cpp_spell_token (parse_in, token, buffer, false);
|
break;
|
break;
|
}
|
}
|
|
|
prev_is_one = is_one;
|
prev_is_one = is_one;
|
}
|
}
|
|
|
if (supported)
|
if (supported)
|
*buffer = '\0';
|
*buffer = '\0';
|
}
|
}
|
|
|
if (macro->fun_like && supported)
|
if (macro->fun_like && supported)
|
{
|
{
|
char *start = (char *) s;
|
char *start = (char *) s;
|
int is_function = 0;
|
int is_function = 0;
|
|
|
pp_string (pp, " -- arg-macro: ");
|
pp_string (pp, " -- arg-macro: ");
|
|
|
if (*start == '(' && buffer [-1] == ')')
|
if (*start == '(' && buffer [-1] == ')')
|
{
|
{
|
start++;
|
start++;
|
buffer [-1] = '\0';
|
buffer [-1] = '\0';
|
is_function = 1;
|
is_function = 1;
|
pp_string (pp, "function ");
|
pp_string (pp, "function ");
|
}
|
}
|
else
|
else
|
{
|
{
|
pp_string (pp, "procedure ");
|
pp_string (pp, "procedure ");
|
}
|
}
|
|
|
pp_string (pp, (const char *) NODE_NAME (node));
|
pp_string (pp, (const char *) NODE_NAME (node));
|
pp_space (pp);
|
pp_space (pp);
|
pp_string (pp, (char *) params);
|
pp_string (pp, (char *) params);
|
pp_newline (pp);
|
pp_newline (pp);
|
pp_string (pp, " -- ");
|
pp_string (pp, " -- ");
|
|
|
if (is_function)
|
if (is_function)
|
{
|
{
|
pp_string (pp, "return ");
|
pp_string (pp, "return ");
|
pp_string (pp, start);
|
pp_string (pp, start);
|
pp_semicolon (pp);
|
pp_semicolon (pp);
|
}
|
}
|
else
|
else
|
pp_string (pp, start);
|
pp_string (pp, start);
|
|
|
pp_newline (pp);
|
pp_newline (pp);
|
}
|
}
|
else if (supported)
|
else if (supported)
|
{
|
{
|
expanded_location sloc = expand_location (macro->line);
|
expanded_location sloc = expand_location (macro->line);
|
|
|
if (sloc.line != prev_line + 1)
|
if (sloc.line != prev_line + 1)
|
pp_newline (pp);
|
pp_newline (pp);
|
|
|
num_macros++;
|
num_macros++;
|
prev_line = sloc.line;
|
prev_line = sloc.line;
|
|
|
pp_string (pp, " ");
|
pp_string (pp, " ");
|
ada_name = to_ada_name ((const char *) NODE_NAME (node), NULL);
|
ada_name = to_ada_name ((const char *) NODE_NAME (node), NULL);
|
pp_string (pp, ada_name);
|
pp_string (pp, ada_name);
|
free (ada_name);
|
free (ada_name);
|
pp_string (pp, " : ");
|
pp_string (pp, " : ");
|
|
|
if (is_string)
|
if (is_string)
|
pp_string (pp, "aliased constant String");
|
pp_string (pp, "aliased constant String");
|
else if (is_char)
|
else if (is_char)
|
pp_string (pp, "aliased constant Character");
|
pp_string (pp, "aliased constant Character");
|
else
|
else
|
pp_string (pp, "constant");
|
pp_string (pp, "constant");
|
|
|
pp_string (pp, " := ");
|
pp_string (pp, " := ");
|
pp_string (pp, (char *) s);
|
pp_string (pp, (char *) s);
|
|
|
if (is_string)
|
if (is_string)
|
pp_string (pp, " & ASCII.NUL");
|
pp_string (pp, " & ASCII.NUL");
|
|
|
pp_string (pp, "; -- ");
|
pp_string (pp, "; -- ");
|
pp_string (pp, sloc.file);
|
pp_string (pp, sloc.file);
|
pp_character (pp, ':');
|
pp_character (pp, ':');
|
pp_scalar (pp, "%d", sloc.line);
|
pp_scalar (pp, "%d", sloc.line);
|
pp_newline (pp);
|
pp_newline (pp);
|
}
|
}
|
else
|
else
|
{
|
{
|
pp_string (pp, " -- unsupported macro: ");
|
pp_string (pp, " -- unsupported macro: ");
|
pp_string (pp, (const char *) cpp_macro_definition (parse_in, node));
|
pp_string (pp, (const char *) cpp_macro_definition (parse_in, node));
|
pp_newline (pp);
|
pp_newline (pp);
|
}
|
}
|
}
|
}
|
|
|
if (num_macros > 0)
|
if (num_macros > 0)
|
pp_newline (pp);
|
pp_newline (pp);
|
}
|
}
|
|
|
static const char *source_file;
|
static const char *source_file;
|
static int max_ada_macros;
|
static int max_ada_macros;
|
|
|
/* Callback used to count the number of relevant macros from
|
/* Callback used to count the number of relevant macros from
|
cpp_forall_identifiers. PFILE and V are not used. NODE is the current macro
|
cpp_forall_identifiers. PFILE and V are not used. NODE is the current macro
|
to consider. */
|
to consider. */
|
|
|
static int
|
static int
|
count_ada_macro (cpp_reader *pfile ATTRIBUTE_UNUSED, cpp_hashnode *node,
|
count_ada_macro (cpp_reader *pfile ATTRIBUTE_UNUSED, cpp_hashnode *node,
|
void *v ATTRIBUTE_UNUSED)
|
void *v ATTRIBUTE_UNUSED)
|
{
|
{
|
const cpp_macro *macro = node->value.macro;
|
const cpp_macro *macro = node->value.macro;
|
|
|
if (node->type == NT_MACRO && !(node->flags & NODE_BUILTIN)
|
if (node->type == NT_MACRO && !(node->flags & NODE_BUILTIN)
|
&& macro->count
|
&& macro->count
|
&& *NODE_NAME (node) != '_'
|
&& *NODE_NAME (node) != '_'
|
&& LOCATION_FILE (macro->line) == source_file)
|
&& LOCATION_FILE (macro->line) == source_file)
|
max_ada_macros++;
|
max_ada_macros++;
|
|
|
return 1;
|
return 1;
|
}
|
}
|
|
|
static int store_ada_macro_index;
|
static int store_ada_macro_index;
|
|
|
/* Callback used to store relevant macros from cpp_forall_identifiers.
|
/* Callback used to store relevant macros from cpp_forall_identifiers.
|
PFILE is not used. NODE is the current macro to store if relevant.
|
PFILE is not used. NODE is the current macro to store if relevant.
|
MACROS is an array of cpp_hashnode* used to store NODE. */
|
MACROS is an array of cpp_hashnode* used to store NODE. */
|
|
|
static int
|
static int
|
store_ada_macro (cpp_reader *pfile ATTRIBUTE_UNUSED,
|
store_ada_macro (cpp_reader *pfile ATTRIBUTE_UNUSED,
|
cpp_hashnode *node, void *macros)
|
cpp_hashnode *node, void *macros)
|
{
|
{
|
const cpp_macro *macro = node->value.macro;
|
const cpp_macro *macro = node->value.macro;
|
|
|
if (node->type == NT_MACRO && !(node->flags & NODE_BUILTIN)
|
if (node->type == NT_MACRO && !(node->flags & NODE_BUILTIN)
|
&& macro->count
|
&& macro->count
|
&& *NODE_NAME (node) != '_'
|
&& *NODE_NAME (node) != '_'
|
&& LOCATION_FILE (macro->line) == source_file)
|
&& LOCATION_FILE (macro->line) == source_file)
|
((cpp_hashnode **) macros)[store_ada_macro_index++] = node;
|
((cpp_hashnode **) macros)[store_ada_macro_index++] = node;
|
|
|
return 1;
|
return 1;
|
}
|
}
|
|
|
/* Callback used to compare (during qsort) macros. NODE1 and NODE2 are the
|
/* Callback used to compare (during qsort) macros. NODE1 and NODE2 are the
|
two macro nodes to compare. */
|
two macro nodes to compare. */
|
|
|
static int
|
static int
|
compare_macro (const void *node1, const void *node2)
|
compare_macro (const void *node1, const void *node2)
|
{
|
{
|
typedef const cpp_hashnode *const_hnode;
|
typedef const cpp_hashnode *const_hnode;
|
|
|
const_hnode n1 = *(const const_hnode *) node1;
|
const_hnode n1 = *(const const_hnode *) node1;
|
const_hnode n2 = *(const const_hnode *) node2;
|
const_hnode n2 = *(const const_hnode *) node2;
|
|
|
return n1->value.macro->line - n2->value.macro->line;
|
return n1->value.macro->line - n2->value.macro->line;
|
}
|
}
|
|
|
/* Dump in PP all relevant macros appearing in FILE. */
|
/* Dump in PP all relevant macros appearing in FILE. */
|
|
|
static void
|
static void
|
dump_ada_macros (pretty_printer *pp, const char* file)
|
dump_ada_macros (pretty_printer *pp, const char* file)
|
{
|
{
|
cpp_hashnode **macros;
|
cpp_hashnode **macros;
|
|
|
/* Initialize file-scope variables. */
|
/* Initialize file-scope variables. */
|
max_ada_macros = 0;
|
max_ada_macros = 0;
|
store_ada_macro_index = 0;
|
store_ada_macro_index = 0;
|
source_file = file;
|
source_file = file;
|
|
|
/* Count all potentially relevant macros, and then sort them by sloc. */
|
/* Count all potentially relevant macros, and then sort them by sloc. */
|
cpp_forall_identifiers (parse_in, count_ada_macro, NULL);
|
cpp_forall_identifiers (parse_in, count_ada_macro, NULL);
|
macros = XALLOCAVEC (cpp_hashnode *, max_ada_macros);
|
macros = XALLOCAVEC (cpp_hashnode *, max_ada_macros);
|
cpp_forall_identifiers (parse_in, store_ada_macro, macros);
|
cpp_forall_identifiers (parse_in, store_ada_macro, macros);
|
qsort (macros, max_ada_macros, sizeof (cpp_hashnode *), compare_macro);
|
qsort (macros, max_ada_macros, sizeof (cpp_hashnode *), compare_macro);
|
|
|
print_ada_macros (pp, macros, max_ada_macros);
|
print_ada_macros (pp, macros, max_ada_macros);
|
}
|
}
|
|
|
/* Current source file being handled. */
|
/* Current source file being handled. */
|
|
|
static const char *source_file_base;
|
static const char *source_file_base;
|
|
|
/* Compare the declaration (DECL) of struct-like types based on the sloc of
|
/* 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
|
their last field (if LAST is true), so that more nested types collate before
|
less nested ones.
|
less nested ones.
|
If ORIG_TYPE is true, also consider struct with a DECL_ORIGINAL_TYPE. */
|
If ORIG_TYPE is true, also consider struct with a DECL_ORIGINAL_TYPE. */
|
|
|
static location_t
|
static location_t
|
decl_sloc_common (const_tree decl, bool last, bool orig_type)
|
decl_sloc_common (const_tree decl, bool last, bool orig_type)
|
{
|
{
|
tree type = TREE_TYPE (decl);
|
tree type = TREE_TYPE (decl);
|
|
|
if (TREE_CODE (decl) == TYPE_DECL
|
if (TREE_CODE (decl) == TYPE_DECL
|
&& (orig_type || !DECL_ORIGINAL_TYPE (decl))
|
&& (orig_type || !DECL_ORIGINAL_TYPE (decl))
|
&& RECORD_OR_UNION_TYPE_P (type)
|
&& RECORD_OR_UNION_TYPE_P (type)
|
&& TYPE_FIELDS (type))
|
&& TYPE_FIELDS (type))
|
{
|
{
|
tree f = TYPE_FIELDS (type);
|
tree f = TYPE_FIELDS (type);
|
|
|
if (last)
|
if (last)
|
while (TREE_CHAIN (f))
|
while (TREE_CHAIN (f))
|
f = TREE_CHAIN (f);
|
f = TREE_CHAIN (f);
|
|
|
return DECL_SOURCE_LOCATION (f);
|
return DECL_SOURCE_LOCATION (f);
|
}
|
}
|
else
|
else
|
return DECL_SOURCE_LOCATION (decl);
|
return DECL_SOURCE_LOCATION (decl);
|
}
|
}
|
|
|
/* Return sloc of DECL, using sloc of last field if LAST is true. */
|
/* Return sloc of DECL, using sloc of last field if LAST is true. */
|
|
|
location_t
|
location_t
|
decl_sloc (const_tree decl, bool last)
|
decl_sloc (const_tree decl, bool last)
|
{
|
{
|
return decl_sloc_common (decl, last, false);
|
return decl_sloc_common (decl, last, false);
|
}
|
}
|
|
|
/* Compare two declarations (LP and RP) by their source location. */
|
/* Compare two declarations (LP and RP) by their source location. */
|
|
|
static int
|
static int
|
compare_node (const void *lp, const void *rp)
|
compare_node (const void *lp, const void *rp)
|
{
|
{
|
const_tree lhs = *((const tree *) lp);
|
const_tree lhs = *((const tree *) lp);
|
const_tree rhs = *((const tree *) rp);
|
const_tree rhs = *((const tree *) rp);
|
|
|
return decl_sloc (lhs, true) - decl_sloc (rhs, true);
|
return decl_sloc (lhs, true) - decl_sloc (rhs, true);
|
}
|
}
|
|
|
/* Compare two comments (LP and RP) by their source location. */
|
/* Compare two comments (LP and RP) by their source location. */
|
|
|
static int
|
static int
|
compare_comment (const void *lp, const void *rp)
|
compare_comment (const void *lp, const void *rp)
|
{
|
{
|
const cpp_comment *lhs = (const cpp_comment *) lp;
|
const cpp_comment *lhs = (const cpp_comment *) lp;
|
const cpp_comment *rhs = (const cpp_comment *) rp;
|
const cpp_comment *rhs = (const cpp_comment *) rp;
|
|
|
if (LOCATION_FILE (lhs->sloc) != LOCATION_FILE (rhs->sloc))
|
if (LOCATION_FILE (lhs->sloc) != LOCATION_FILE (rhs->sloc))
|
return filename_cmp (LOCATION_FILE (lhs->sloc),
|
return filename_cmp (LOCATION_FILE (lhs->sloc),
|
LOCATION_FILE (rhs->sloc));
|
LOCATION_FILE (rhs->sloc));
|
|
|
if (LOCATION_LINE (lhs->sloc) != LOCATION_LINE (rhs->sloc))
|
if (LOCATION_LINE (lhs->sloc) != LOCATION_LINE (rhs->sloc))
|
return 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))
|
if (LOCATION_COL (lhs->sloc) != LOCATION_COL (rhs->sloc))
|
return LOCATION_COL (lhs->sloc) - LOCATION_COL (rhs->sloc);
|
return LOCATION_COL (lhs->sloc) - LOCATION_COL (rhs->sloc);
|
|
|
return 0;
|
return 0;
|
}
|
}
|
|
|
static tree *to_dump = NULL;
|
static tree *to_dump = NULL;
|
static int to_dump_count = 0;
|
static int to_dump_count = 0;
|
|
|
/* Collect a list of declarations from T relevant to SOURCE_FILE to be dumped
|
/* Collect a list of declarations from T relevant to SOURCE_FILE to be dumped
|
by a subsequent call to dump_ada_nodes. */
|
by a subsequent call to dump_ada_nodes. */
|
|
|
void
|
void
|
collect_ada_nodes (tree t, const char *source_file)
|
collect_ada_nodes (tree t, const char *source_file)
|
{
|
{
|
tree n;
|
tree n;
|
int i = to_dump_count;
|
int i = to_dump_count;
|
|
|
/* Count the likely relevant nodes. */
|
/* Count the likely relevant nodes. */
|
for (n = t; n; n = TREE_CHAIN (n))
|
for (n = t; n; n = TREE_CHAIN (n))
|
if (!DECL_IS_BUILTIN (n)
|
if (!DECL_IS_BUILTIN (n)
|
&& LOCATION_FILE (decl_sloc (n, false)) == source_file)
|
&& LOCATION_FILE (decl_sloc (n, false)) == source_file)
|
to_dump_count++;
|
to_dump_count++;
|
|
|
/* Allocate sufficient storage for all nodes. */
|
/* Allocate sufficient storage for all nodes. */
|
to_dump = XRESIZEVEC (tree, to_dump, to_dump_count);
|
to_dump = XRESIZEVEC (tree, to_dump, to_dump_count);
|
|
|
/* Store the relevant nodes. */
|
/* Store the relevant nodes. */
|
for (n = t; n; n = TREE_CHAIN (n))
|
for (n = t; n; n = TREE_CHAIN (n))
|
if (!DECL_IS_BUILTIN (n)
|
if (!DECL_IS_BUILTIN (n)
|
&& LOCATION_FILE (decl_sloc (n, false)) == source_file)
|
&& 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. */
|
/* Call back for walk_tree to clear the TREE_VISITED flag of TP. */
|
|
|
static tree
|
static tree
|
unmark_visited_r (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED,
|
unmark_visited_r (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED,
|
void *data ATTRIBUTE_UNUSED)
|
void *data ATTRIBUTE_UNUSED)
|
{
|
{
|
if (TREE_VISITED (*tp))
|
if (TREE_VISITED (*tp))
|
TREE_VISITED (*tp) = 0;
|
TREE_VISITED (*tp) = 0;
|
else
|
else
|
*walk_subtrees = 0;
|
*walk_subtrees = 0;
|
|
|
return NULL_TREE;
|
return NULL_TREE;
|
}
|
}
|
|
|
/* Dump nodes into PP relevant to SOURCE_FILE, as collected by previous calls
|
/* 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. */
|
to collect_ada_nodes. CPP_CHECK is used to perform C++ queries on nodes. */
|
|
|
static void
|
static void
|
dump_ada_nodes (pretty_printer *pp, const char *source_file,
|
dump_ada_nodes (pretty_printer *pp, const char *source_file,
|
int (*cpp_check)(tree, cpp_operation))
|
int (*cpp_check)(tree, cpp_operation))
|
{
|
{
|
int i, j;
|
int i, j;
|
cpp_comment_table *comments;
|
cpp_comment_table *comments;
|
|
|
/* Sort the table of declarations to dump by sloc. */
|
/* Sort the table of declarations to dump by sloc. */
|
qsort (to_dump, to_dump_count, sizeof (tree), compare_node);
|
qsort (to_dump, to_dump_count, sizeof (tree), compare_node);
|
|
|
/* Fetch the table of comments. */
|
/* Fetch the table of comments. */
|
comments = cpp_get_comments (parse_in);
|
comments = cpp_get_comments (parse_in);
|
|
|
/* Sort the comments table by sloc. */
|
/* Sort the comments table by sloc. */
|
qsort (comments->entries, comments->count, sizeof (cpp_comment),
|
qsort (comments->entries, comments->count, sizeof (cpp_comment),
|
compare_comment);
|
compare_comment);
|
|
|
/* Interleave comments and declarations in line number order. */
|
/* Interleave comments and declarations in line number order. */
|
i = j = 0;
|
i = j = 0;
|
do
|
do
|
{
|
{
|
/* Advance j until comment j is in this file. */
|
/* Advance j until comment j is in this file. */
|
while (j != comments->count
|
while (j != comments->count
|
&& LOCATION_FILE (comments->entries[j].sloc) != source_file)
|
&& LOCATION_FILE (comments->entries[j].sloc) != source_file)
|
j++;
|
j++;
|
|
|
/* Advance j until comment j is not a duplicate. */
|
/* Advance j until comment j is not a duplicate. */
|
while (j < comments->count - 1
|
while (j < comments->count - 1
|
&& !compare_comment (&comments->entries[j],
|
&& !compare_comment (&comments->entries[j],
|
&comments->entries[j + 1]))
|
&comments->entries[j + 1]))
|
j++;
|
j++;
|
|
|
/* Write decls until decl i collates after comment j. */
|
/* Write decls until decl i collates after comment j. */
|
while (i != to_dump_count)
|
while (i != to_dump_count)
|
{
|
{
|
if (j == comments->count
|
if (j == comments->count
|
|| LOCATION_LINE (decl_sloc (to_dump[i], false))
|
|| LOCATION_LINE (decl_sloc (to_dump[i], false))
|
< LOCATION_LINE (comments->entries[j].sloc))
|
< LOCATION_LINE (comments->entries[j].sloc))
|
print_generic_ada_decl (pp, to_dump[i++], cpp_check, source_file);
|
print_generic_ada_decl (pp, to_dump[i++], cpp_check, source_file);
|
else
|
else
|
break;
|
break;
|
}
|
}
|
|
|
/* Write comment j, if there is one. */
|
/* Write comment j, if there is one. */
|
if (j != comments->count)
|
if (j != comments->count)
|
print_comment (pp, comments->entries[j++].comment);
|
print_comment (pp, comments->entries[j++].comment);
|
|
|
} while (i != to_dump_count || j != comments->count);
|
} while (i != to_dump_count || j != comments->count);
|
|
|
/* Clear the TREE_VISITED flag over each subtree we've dumped. */
|
/* Clear the TREE_VISITED flag over each subtree we've dumped. */
|
for (i = 0; i < to_dump_count; i++)
|
for (i = 0; i < to_dump_count; i++)
|
walk_tree (&to_dump[i], unmark_visited_r, NULL, NULL);
|
walk_tree (&to_dump[i], unmark_visited_r, NULL, NULL);
|
|
|
/* Finalize the to_dump table. */
|
/* Finalize the to_dump table. */
|
if (to_dump)
|
if (to_dump)
|
{
|
{
|
free (to_dump);
|
free (to_dump);
|
to_dump = NULL;
|
to_dump = NULL;
|
to_dump_count = 0;
|
to_dump_count = 0;
|
}
|
}
|
}
|
}
|
|
|
/* Print a COMMENT to the output stream PP. */
|
/* Print a COMMENT to the output stream PP. */
|
|
|
static void
|
static void
|
print_comment (pretty_printer *pp, const char *comment)
|
print_comment (pretty_printer *pp, const char *comment)
|
{
|
{
|
int len = strlen (comment);
|
int len = strlen (comment);
|
char *str = XALLOCAVEC (char, len + 1);
|
char *str = XALLOCAVEC (char, len + 1);
|
char *tok;
|
char *tok;
|
bool extra_newline = false;
|
bool extra_newline = false;
|
|
|
memcpy (str, comment, len + 1);
|
memcpy (str, comment, len + 1);
|
|
|
/* Trim C/C++ comment indicators. */
|
/* Trim C/C++ comment indicators. */
|
if (str[len - 2] == '*' && str[len - 1] == '/')
|
if (str[len - 2] == '*' && str[len - 1] == '/')
|
{
|
{
|
str[len - 2] = ' ';
|
str[len - 2] = ' ';
|
str[len - 1] = '\0';
|
str[len - 1] = '\0';
|
}
|
}
|
str += 2;
|
str += 2;
|
|
|
tok = strtok (str, "\n");
|
tok = strtok (str, "\n");
|
while (tok) {
|
while (tok) {
|
pp_string (pp, " --");
|
pp_string (pp, " --");
|
pp_string (pp, tok);
|
pp_string (pp, tok);
|
pp_newline (pp);
|
pp_newline (pp);
|
tok = strtok (NULL, "\n");
|
tok = strtok (NULL, "\n");
|
|
|
/* Leave a blank line after multi-line comments. */
|
/* Leave a blank line after multi-line comments. */
|
if (tok)
|
if (tok)
|
extra_newline = true;
|
extra_newline = true;
|
}
|
}
|
|
|
if (extra_newline)
|
if (extra_newline)
|
pp_newline (pp);
|
pp_newline (pp);
|
}
|
}
|
|
|
/* Prints declaration DECL to PP in Ada syntax. The current source file being
|
/* 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
|
handled is SOURCE_FILE, and CPP_CHECK is used to perform C++ queries on
|
nodes. */
|
nodes. */
|
|
|
static void
|
static void
|
print_generic_ada_decl (pretty_printer *pp, tree decl,
|
print_generic_ada_decl (pretty_printer *pp, tree decl,
|
int (*cpp_check)(tree, cpp_operation),
|
int (*cpp_check)(tree, cpp_operation),
|
const char* source_file)
|
const char* source_file)
|
{
|
{
|
source_file_base = source_file;
|
source_file_base = source_file;
|
|
|
if (print_ada_declaration (pp, decl, 0, cpp_check, INDENT_INCR))
|
if (print_ada_declaration (pp, decl, 0, cpp_check, INDENT_INCR))
|
{
|
{
|
pp_newline (pp);
|
pp_newline (pp);
|
pp_newline (pp);
|
pp_newline (pp);
|
}
|
}
|
}
|
}
|
|
|
/* Dump a newline and indent BUFFER by SPC chars. */
|
/* Dump a newline and indent BUFFER by SPC chars. */
|
|
|
static void
|
static void
|
newline_and_indent (pretty_printer *buffer, int spc)
|
newline_and_indent (pretty_printer *buffer, int spc)
|
{
|
{
|
pp_newline (buffer);
|
pp_newline (buffer);
|
INDENT (spc);
|
INDENT (spc);
|
}
|
}
|
|
|
struct with { char *s; const char *in_file; int limited; };
|
struct with { char *s; const char *in_file; int limited; };
|
static struct with *withs = NULL;
|
static struct with *withs = NULL;
|
static int withs_max = 4096;
|
static int withs_max = 4096;
|
static int with_len = 0;
|
static int with_len = 0;
|
|
|
/* Record a "with" clause on package S (a limited with if LIMITED_ACCESS is
|
/* Record a "with" clause on package S (a limited with if LIMITED_ACCESS is
|
true), if not already done. */
|
true), if not already done. */
|
|
|
static void
|
static void
|
append_withs (const char *s, int limited_access)
|
append_withs (const char *s, int limited_access)
|
{
|
{
|
int i;
|
int i;
|
|
|
if (withs == NULL)
|
if (withs == NULL)
|
withs = XNEWVEC (struct with, withs_max);
|
withs = XNEWVEC (struct with, withs_max);
|
|
|
if (with_len == withs_max)
|
if (with_len == withs_max)
|
{
|
{
|
withs_max *= 2;
|
withs_max *= 2;
|
withs = XRESIZEVEC (struct with, withs, withs_max);
|
withs = XRESIZEVEC (struct with, withs, withs_max);
|
}
|
}
|
|
|
for (i = 0; i < with_len; i++)
|
for (i = 0; i < with_len; i++)
|
if (!strcmp (s, withs [i].s)
|
if (!strcmp (s, withs [i].s)
|
&& source_file_base == withs [i].in_file)
|
&& source_file_base == withs [i].in_file)
|
{
|
{
|
withs [i].limited &= limited_access;
|
withs [i].limited &= limited_access;
|
return;
|
return;
|
}
|
}
|
|
|
withs [with_len].s = xstrdup (s);
|
withs [with_len].s = xstrdup (s);
|
withs [with_len].in_file = source_file_base;
|
withs [with_len].in_file = source_file_base;
|
withs [with_len].limited = limited_access;
|
withs [with_len].limited = limited_access;
|
with_len++;
|
with_len++;
|
}
|
}
|
|
|
/* Reset "with" clauses. */
|
/* Reset "with" clauses. */
|
|
|
static void
|
static void
|
reset_ada_withs (void)
|
reset_ada_withs (void)
|
{
|
{
|
int i;
|
int i;
|
|
|
if (!withs)
|
if (!withs)
|
return;
|
return;
|
|
|
for (i = 0; i < with_len; i++)
|
for (i = 0; i < with_len; i++)
|
free (withs [i].s);
|
free (withs [i].s);
|
free (withs);
|
free (withs);
|
withs = NULL;
|
withs = NULL;
|
withs_max = 4096;
|
withs_max = 4096;
|
with_len = 0;
|
with_len = 0;
|
}
|
}
|
|
|
/* Dump "with" clauses in F. */
|
/* Dump "with" clauses in F. */
|
|
|
static void
|
static void
|
dump_ada_withs (FILE *f)
|
dump_ada_withs (FILE *f)
|
{
|
{
|
int i;
|
int i;
|
|
|
fprintf (f, "with Interfaces.C; use Interfaces.C;\n");
|
fprintf (f, "with Interfaces.C; use Interfaces.C;\n");
|
|
|
for (i = 0; i < with_len; i++)
|
for (i = 0; i < with_len; i++)
|
fprintf
|
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. */
|
/* Return suitable Ada package name from FILE. */
|
|
|
static char *
|
static char *
|
get_ada_package (const char *file)
|
get_ada_package (const char *file)
|
{
|
{
|
const char *base;
|
const char *base;
|
char *res;
|
char *res;
|
const char *s;
|
const char *s;
|
int i;
|
int i;
|
|
|
s = strstr (file, "/include/");
|
s = strstr (file, "/include/");
|
if (s)
|
if (s)
|
base = s + 9;
|
base = s + 9;
|
else
|
else
|
base = lbasename (file);
|
base = lbasename (file);
|
res = XNEWVEC (char, strlen (base) + 1);
|
res = XNEWVEC (char, strlen (base) + 1);
|
|
|
for (i = 0; *base; base++, i++)
|
for (i = 0; *base; base++, i++)
|
switch (*base)
|
switch (*base)
|
{
|
{
|
case '+':
|
case '+':
|
res [i] = 'p';
|
res [i] = 'p';
|
break;
|
break;
|
|
|
case '.':
|
case '.':
|
case '-':
|
case '-':
|
case '_':
|
case '_':
|
case '/':
|
case '/':
|
case '\\':
|
case '\\':
|
res [i] = (i == 0 || res [i - 1] == '_') ? 'u' : '_';
|
res [i] = (i == 0 || res [i - 1] == '_') ? 'u' : '_';
|
break;
|
break;
|
|
|
default:
|
default:
|
res [i] = *base;
|
res [i] = *base;
|
break;
|
break;
|
}
|
}
|
res [i] = '\0';
|
res [i] = '\0';
|
|
|
return res;
|
return res;
|
}
|
}
|
|
|
static const char *ada_reserved[] = {
|
static const char *ada_reserved[] = {
|
"abort", "abs", "abstract", "accept", "access", "aliased", "all", "and",
|
"abort", "abs", "abstract", "accept", "access", "aliased", "all", "and",
|
"array", "at", "begin", "body", "case", "constant", "declare", "delay",
|
"array", "at", "begin", "body", "case", "constant", "declare", "delay",
|
"delta", "digits", "do", "else", "elsif", "end", "entry", "exception",
|
"delta", "digits", "do", "else", "elsif", "end", "entry", "exception",
|
"exit", "for", "function", "generic", "goto", "if", "in", "interface", "is",
|
"exit", "for", "function", "generic", "goto", "if", "in", "interface", "is",
|
"limited", "loop", "mod", "new", "not", "null", "others", "out", "of", "or",
|
"limited", "loop", "mod", "new", "not", "null", "others", "out", "of", "or",
|
"overriding", "package", "pragma", "private", "procedure", "protected",
|
"overriding", "package", "pragma", "private", "procedure", "protected",
|
"raise", "range", "record", "rem", "renames", "requeue", "return", "reverse",
|
"raise", "range", "record", "rem", "renames", "requeue", "return", "reverse",
|
"select", "separate", "subtype", "synchronized", "tagged", "task",
|
"select", "separate", "subtype", "synchronized", "tagged", "task",
|
"terminate", "then", "type", "until", "use", "when", "while", "with", "xor",
|
"terminate", "then", "type", "until", "use", "when", "while", "with", "xor",
|
NULL};
|
NULL};
|
|
|
/* ??? would be nice to specify this list via a config file, so that users
|
/* ??? would be nice to specify this list via a config file, so that users
|
can create their own dictionary of conflicts. */
|
can create their own dictionary of conflicts. */
|
static const char *c_duplicates[] = {
|
static const char *c_duplicates[] = {
|
/* system will cause troubles with System.Address. */
|
/* system will cause troubles with System.Address. */
|
"system",
|
"system",
|
|
|
/* The following values have other definitions with same name/other
|
/* The following values have other definitions with same name/other
|
casing. */
|
casing. */
|
"funmap",
|
"funmap",
|
"rl_vi_fWord",
|
"rl_vi_fWord",
|
"rl_vi_bWord",
|
"rl_vi_bWord",
|
"rl_vi_eWord",
|
"rl_vi_eWord",
|
"rl_readline_version",
|
"rl_readline_version",
|
"_Vx_ushort",
|
"_Vx_ushort",
|
"USHORT",
|
"USHORT",
|
"XLookupKeysym",
|
"XLookupKeysym",
|
NULL};
|
NULL};
|
|
|
/* Return a declaration tree corresponding to TYPE. */
|
/* Return a declaration tree corresponding to TYPE. */
|
|
|
static tree
|
static tree
|
get_underlying_decl (tree type)
|
get_underlying_decl (tree type)
|
{
|
{
|
tree decl = NULL_TREE;
|
tree decl = NULL_TREE;
|
|
|
if (type == NULL_TREE)
|
if (type == NULL_TREE)
|
return NULL_TREE;
|
return NULL_TREE;
|
|
|
/* type is a declaration. */
|
/* type is a declaration. */
|
if (DECL_P (type))
|
if (DECL_P (type))
|
decl = type;
|
decl = type;
|
|
|
/* type is a typedef. */
|
/* type is a typedef. */
|
if (TYPE_P (type) && TYPE_NAME (type) && DECL_P (TYPE_NAME (type)))
|
if (TYPE_P (type) && TYPE_NAME (type) && DECL_P (TYPE_NAME (type)))
|
decl = TYPE_NAME (type);
|
decl = TYPE_NAME (type);
|
|
|
/* TYPE_STUB_DECL has been set for type. */
|
/* TYPE_STUB_DECL has been set for type. */
|
if (TYPE_P (type) && TYPE_STUB_DECL (type) &&
|
if (TYPE_P (type) && TYPE_STUB_DECL (type) &&
|
DECL_P (TYPE_STUB_DECL (type)))
|
DECL_P (TYPE_STUB_DECL (type)))
|
decl = TYPE_STUB_DECL (type);
|
decl = TYPE_STUB_DECL (type);
|
|
|
return decl;
|
return decl;
|
}
|
}
|
|
|
/* Return whether TYPE has static fields. */
|
/* Return whether TYPE has static fields. */
|
|
|
static int
|
static int
|
has_static_fields (const_tree type)
|
has_static_fields (const_tree type)
|
{
|
{
|
tree tmp;
|
tree tmp;
|
|
|
for (tmp = TYPE_FIELDS (type); tmp; tmp = TREE_CHAIN (tmp))
|
for (tmp = TYPE_FIELDS (type); tmp; tmp = TREE_CHAIN (tmp))
|
{
|
{
|
if (DECL_NAME (tmp) && TREE_STATIC (tmp))
|
if (DECL_NAME (tmp) && TREE_STATIC (tmp))
|
return true;
|
return true;
|
}
|
}
|
return false;
|
return false;
|
}
|
}
|
|
|
/* Return whether TYPE corresponds to an Ada tagged type (has a dispatch
|
/* Return whether TYPE corresponds to an Ada tagged type (has a dispatch
|
table). */
|
table). */
|
|
|
static int
|
static int
|
is_tagged_type (const_tree type)
|
is_tagged_type (const_tree type)
|
{
|
{
|
tree tmp;
|
tree tmp;
|
|
|
if (!type || !RECORD_OR_UNION_TYPE_P (type))
|
if (!type || !RECORD_OR_UNION_TYPE_P (type))
|
return false;
|
return false;
|
|
|
for (tmp = TYPE_METHODS (type); tmp; tmp = TREE_CHAIN (tmp))
|
for (tmp = TYPE_METHODS (type); tmp; tmp = TREE_CHAIN (tmp))
|
if (DECL_VINDEX (tmp))
|
if (DECL_VINDEX (tmp))
|
return true;
|
return true;
|
|
|
return false;
|
return false;
|
}
|
}
|
|
|
/* Generate a legal Ada name from a C NAME, returning a malloc'd string.
|
/* 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
|
SPACE_FOUND, if not NULL, is used to indicate whether a space was found in
|
NAME. */
|
NAME. */
|
|
|
static char *
|
static char *
|
to_ada_name (const char *name, int *space_found)
|
to_ada_name (const char *name, int *space_found)
|
{
|
{
|
const char **names;
|
const char **names;
|
int len = strlen (name);
|
int len = strlen (name);
|
int j, len2 = 0;
|
int j, len2 = 0;
|
int found = false;
|
int found = false;
|
char *s = XNEWVEC (char, len * 2 + 5);
|
char *s = XNEWVEC (char, len * 2 + 5);
|
char c;
|
char c;
|
|
|
if (space_found)
|
if (space_found)
|
*space_found = false;
|
*space_found = false;
|
|
|
/* Add trailing "c_" if name is an Ada reserved word. */
|
/* Add trailing "c_" if name is an Ada reserved word. */
|
for (names = ada_reserved; *names; names++)
|
for (names = ada_reserved; *names; names++)
|
if (!strcasecmp (name, *names))
|
if (!strcasecmp (name, *names))
|
{
|
{
|
s [len2++] = 'c';
|
s [len2++] = 'c';
|
s [len2++] = '_';
|
s [len2++] = '_';
|
found = true;
|
found = true;
|
break;
|
break;
|
}
|
}
|
|
|
if (!found)
|
if (!found)
|
/* Add trailing "c_" if name is an potential case sensitive duplicate. */
|
/* Add trailing "c_" if name is an potential case sensitive duplicate. */
|
for (names = c_duplicates; *names; names++)
|
for (names = c_duplicates; *names; names++)
|
if (!strcmp (name, *names))
|
if (!strcmp (name, *names))
|
{
|
{
|
s [len2++] = 'c';
|
s [len2++] = 'c';
|
s [len2++] = '_';
|
s [len2++] = '_';
|
found = true;
|
found = true;
|
break;
|
break;
|
}
|
}
|
|
|
for (j = 0; name [j] == '_'; j++)
|
for (j = 0; name [j] == '_'; j++)
|
s [len2++] = 'u';
|
s [len2++] = 'u';
|
|
|
if (j > 0)
|
if (j > 0)
|
s [len2++] = '_';
|
s [len2++] = '_';
|
else if (*name == '.' || *name == '$')
|
else if (*name == '.' || *name == '$')
|
{
|
{
|
s [0] = 'a';
|
s [0] = 'a';
|
s [1] = 'n';
|
s [1] = 'n';
|
s [2] = 'o';
|
s [2] = 'o';
|
s [3] = 'n';
|
s [3] = 'n';
|
len2 = 4;
|
len2 = 4;
|
j++;
|
j++;
|
}
|
}
|
|
|
/* Replace unsuitable characters for Ada identifiers. */
|
/* Replace unsuitable characters for Ada identifiers. */
|
|
|
for (; j < len; j++)
|
for (; j < len; j++)
|
switch (name [j])
|
switch (name [j])
|
{
|
{
|
case ' ':
|
case ' ':
|
if (space_found)
|
if (space_found)
|
*space_found = true;
|
*space_found = true;
|
s [len2++] = '_';
|
s [len2++] = '_';
|
break;
|
break;
|
|
|
/* ??? missing some C++ operators. */
|
/* ??? missing some C++ operators. */
|
case '=':
|
case '=':
|
s [len2++] = '_';
|
s [len2++] = '_';
|
|
|
if (name [j + 1] == '=')
|
if (name [j + 1] == '=')
|
{
|
{
|
j++;
|
j++;
|
s [len2++] = 'e';
|
s [len2++] = 'e';
|
s [len2++] = 'q';
|
s [len2++] = 'q';
|
}
|
}
|
else
|
else
|
{
|
{
|
s [len2++] = 'a';
|
s [len2++] = 'a';
|
s [len2++] = 's';
|
s [len2++] = 's';
|
}
|
}
|
break;
|
break;
|
|
|
case '!':
|
case '!':
|
s [len2++] = '_';
|
s [len2++] = '_';
|
if (name [j + 1] == '=')
|
if (name [j + 1] == '=')
|
{
|
{
|
j++;
|
j++;
|
s [len2++] = 'n';
|
s [len2++] = 'n';
|
s [len2++] = 'e';
|
s [len2++] = 'e';
|
}
|
}
|
break;
|
break;
|
|
|
case '~':
|
case '~':
|
s [len2++] = '_';
|
s [len2++] = '_';
|
s [len2++] = 't';
|
s [len2++] = 't';
|
s [len2++] = 'i';
|
s [len2++] = 'i';
|
break;
|
break;
|
|
|
case '&':
|
case '&':
|
case '|':
|
case '|':
|
case '^':
|
case '^':
|
s [len2++] = '_';
|
s [len2++] = '_';
|
s [len2++] = name [j] == '&' ? 'a' : name [j] == '|' ? 'o' : 'x';
|
s [len2++] = name [j] == '&' ? 'a' : name [j] == '|' ? 'o' : 'x';
|
|
|
if (name [j + 1] == '=')
|
if (name [j + 1] == '=')
|
{
|
{
|
j++;
|
j++;
|
s [len2++] = 'e';
|
s [len2++] = 'e';
|
}
|
}
|
break;
|
break;
|
|
|
case '+':
|
case '+':
|
case '-':
|
case '-':
|
case '*':
|
case '*':
|
case '/':
|
case '/':
|
case '(':
|
case '(':
|
case '[':
|
case '[':
|
if (s [len2 - 1] != '_')
|
if (s [len2 - 1] != '_')
|
s [len2++] = '_';
|
s [len2++] = '_';
|
|
|
switch (name [j + 1]) {
|
switch (name [j + 1]) {
|
case '\0':
|
case '\0':
|
j++;
|
j++;
|
switch (name [j - 1]) {
|
switch (name [j - 1]) {
|
case '+': s [len2++] = 'p'; break; /* + */
|
case '+': s [len2++] = 'p'; break; /* + */
|
case '-': s [len2++] = 'm'; break; /* - */
|
case '-': s [len2++] = 'm'; break; /* - */
|
case '*': s [len2++] = 't'; break; /* * */
|
case '*': s [len2++] = 't'; break; /* * */
|
case '/': s [len2++] = 'd'; break; /* / */
|
case '/': s [len2++] = 'd'; break; /* / */
|
}
|
}
|
break;
|
break;
|
|
|
case '=':
|
case '=':
|
j++;
|
j++;
|
switch (name [j - 1]) {
|
switch (name [j - 1]) {
|
case '+': s [len2++] = 'p'; break; /* += */
|
case '+': s [len2++] = 'p'; break; /* += */
|
case '-': s [len2++] = 'm'; break; /* -= */
|
case '-': s [len2++] = 'm'; break; /* -= */
|
case '*': s [len2++] = 't'; break; /* *= */
|
case '*': s [len2++] = 't'; break; /* *= */
|
case '/': s [len2++] = 'd'; break; /* /= */
|
case '/': s [len2++] = 'd'; break; /* /= */
|
}
|
}
|
s [len2++] = 'a';
|
s [len2++] = 'a';
|
break;
|
break;
|
|
|
case '-': /* -- */
|
case '-': /* -- */
|
j++;
|
j++;
|
s [len2++] = 'm';
|
s [len2++] = 'm';
|
s [len2++] = 'm';
|
s [len2++] = 'm';
|
break;
|
break;
|
|
|
case '+': /* ++ */
|
case '+': /* ++ */
|
j++;
|
j++;
|
s [len2++] = 'p';
|
s [len2++] = 'p';
|
s [len2++] = 'p';
|
s [len2++] = 'p';
|
break;
|
break;
|
|
|
case ')': /* () */
|
case ')': /* () */
|
j++;
|
j++;
|
s [len2++] = 'o';
|
s [len2++] = 'o';
|
s [len2++] = 'p';
|
s [len2++] = 'p';
|
break;
|
break;
|
|
|
case ']': /* [] */
|
case ']': /* [] */
|
j++;
|
j++;
|
s [len2++] = 'o';
|
s [len2++] = 'o';
|
s [len2++] = 'b';
|
s [len2++] = 'b';
|
break;
|
break;
|
}
|
}
|
|
|
break;
|
break;
|
|
|
case '<':
|
case '<':
|
case '>':
|
case '>':
|
c = name [j] == '<' ? 'l' : 'g';
|
c = name [j] == '<' ? 'l' : 'g';
|
s [len2++] = '_';
|
s [len2++] = '_';
|
|
|
switch (name [j + 1]) {
|
switch (name [j + 1]) {
|
case '\0':
|
case '\0':
|
s [len2++] = c;
|
s [len2++] = c;
|
s [len2++] = 't';
|
s [len2++] = 't';
|
break;
|
break;
|
case '=':
|
case '=':
|
j++;
|
j++;
|
s [len2++] = c;
|
s [len2++] = c;
|
s [len2++] = 'e';
|
s [len2++] = 'e';
|
break;
|
break;
|
case '>':
|
case '>':
|
j++;
|
j++;
|
s [len2++] = 's';
|
s [len2++] = 's';
|
s [len2++] = 'r';
|
s [len2++] = 'r';
|
break;
|
break;
|
case '<':
|
case '<':
|
j++;
|
j++;
|
s [len2++] = 's';
|
s [len2++] = 's';
|
s [len2++] = 'l';
|
s [len2++] = 'l';
|
break;
|
break;
|
default:
|
default:
|
break;
|
break;
|
}
|
}
|
break;
|
break;
|
|
|
case '_':
|
case '_':
|
if (len2 && s [len2 - 1] == '_')
|
if (len2 && s [len2 - 1] == '_')
|
s [len2++] = 'u';
|
s [len2++] = 'u';
|
/* fall through */
|
/* fall through */
|
|
|
default:
|
default:
|
s [len2++] = name [j];
|
s [len2++] = name [j];
|
}
|
}
|
|
|
if (s [len2 - 1] == '_')
|
if (s [len2 - 1] == '_')
|
s [len2++] = 'u';
|
s [len2++] = 'u';
|
|
|
s [len2] = '\0';
|
s [len2] = '\0';
|
|
|
return s;
|
return s;
|
}
|
}
|
|
|
/* Return true if DECL refers to a C++ class type for which a
|
/* Return true if DECL refers to a C++ class type for which a
|
separate enclosing package has been or should be generated. */
|
separate enclosing package has been or should be generated. */
|
|
|
static bool
|
static bool
|
separate_class_package (tree decl)
|
separate_class_package (tree decl)
|
{
|
{
|
if (decl)
|
if (decl)
|
{
|
{
|
tree type = TREE_TYPE (decl);
|
tree type = TREE_TYPE (decl);
|
return type
|
return type
|
&& TREE_CODE (type) == RECORD_TYPE
|
&& TREE_CODE (type) == RECORD_TYPE
|
&& (TYPE_METHODS (type) || has_static_fields (type));
|
&& (TYPE_METHODS (type) || has_static_fields (type));
|
}
|
}
|
else
|
else
|
return false;
|
return false;
|
}
|
}
|
|
|
static bool package_prefix = true;
|
static bool package_prefix = true;
|
|
|
/* Dump in BUFFER the name of an identifier NODE of type TYPE, following Ada
|
/* 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. LIMITED_ACCESS indicates whether NODE can be accessed via a limited
|
'with' clause rather than a regular 'with' clause. */
|
'with' clause rather than a regular 'with' clause. */
|
|
|
static void
|
static void
|
pp_ada_tree_identifier (pretty_printer *buffer, tree node, tree type,
|
pp_ada_tree_identifier (pretty_printer *buffer, tree node, tree type,
|
int limited_access)
|
int limited_access)
|
{
|
{
|
const char *name = IDENTIFIER_POINTER (node);
|
const char *name = IDENTIFIER_POINTER (node);
|
int space_found = false;
|
int space_found = false;
|
char *s = to_ada_name (name, &space_found);
|
char *s = to_ada_name (name, &space_found);
|
tree decl;
|
tree decl;
|
|
|
/* If the entity is a type and comes from another file, generate "package"
|
/* If the entity is a type and comes from another file, generate "package"
|
prefix. */
|
prefix. */
|
|
|
decl = get_underlying_decl (type);
|
decl = get_underlying_decl (type);
|
|
|
if (decl)
|
if (decl)
|
{
|
{
|
expanded_location xloc = expand_location (decl_sloc (decl, false));
|
expanded_location xloc = expand_location (decl_sloc (decl, false));
|
|
|
if (xloc.file && xloc.line)
|
if (xloc.file && xloc.line)
|
{
|
{
|
if (xloc.file != source_file_base)
|
if (xloc.file != source_file_base)
|
{
|
{
|
switch (TREE_CODE (type))
|
switch (TREE_CODE (type))
|
{
|
{
|
case ENUMERAL_TYPE:
|
case ENUMERAL_TYPE:
|
case INTEGER_TYPE:
|
case INTEGER_TYPE:
|
case REAL_TYPE:
|
case REAL_TYPE:
|
case FIXED_POINT_TYPE:
|
case FIXED_POINT_TYPE:
|
case BOOLEAN_TYPE:
|
case BOOLEAN_TYPE:
|
case REFERENCE_TYPE:
|
case REFERENCE_TYPE:
|
case POINTER_TYPE:
|
case POINTER_TYPE:
|
case ARRAY_TYPE:
|
case ARRAY_TYPE:
|
case RECORD_TYPE:
|
case RECORD_TYPE:
|
case UNION_TYPE:
|
case UNION_TYPE:
|
case QUAL_UNION_TYPE:
|
case QUAL_UNION_TYPE:
|
case TYPE_DECL:
|
case TYPE_DECL:
|
{
|
{
|
char *s1 = get_ada_package (xloc.file);
|
char *s1 = get_ada_package (xloc.file);
|
|
|
if (package_prefix)
|
if (package_prefix)
|
{
|
{
|
append_withs (s1, limited_access);
|
append_withs (s1, limited_access);
|
pp_string (buffer, s1);
|
pp_string (buffer, s1);
|
pp_character (buffer, '.');
|
pp_character (buffer, '.');
|
}
|
}
|
free (s1);
|
free (s1);
|
}
|
}
|
break;
|
break;
|
default:
|
default:
|
break;
|
break;
|
}
|
}
|
|
|
if (separate_class_package (decl))
|
if (separate_class_package (decl))
|
{
|
{
|
pp_string (buffer, "Class_");
|
pp_string (buffer, "Class_");
|
pp_string (buffer, s);
|
pp_string (buffer, s);
|
pp_string (buffer, ".");
|
pp_string (buffer, ".");
|
}
|
}
|
|
|
}
|
}
|
}
|
}
|
}
|
}
|
|
|
if (space_found)
|
if (space_found)
|
if (!strcmp (s, "short_int"))
|
if (!strcmp (s, "short_int"))
|
pp_string (buffer, "short");
|
pp_string (buffer, "short");
|
else if (!strcmp (s, "short_unsigned_int"))
|
else if (!strcmp (s, "short_unsigned_int"))
|
pp_string (buffer, "unsigned_short");
|
pp_string (buffer, "unsigned_short");
|
else if (!strcmp (s, "unsigned_int"))
|
else if (!strcmp (s, "unsigned_int"))
|
pp_string (buffer, "unsigned");
|
pp_string (buffer, "unsigned");
|
else if (!strcmp (s, "long_int"))
|
else if (!strcmp (s, "long_int"))
|
pp_string (buffer, "long");
|
pp_string (buffer, "long");
|
else if (!strcmp (s, "long_unsigned_int"))
|
else if (!strcmp (s, "long_unsigned_int"))
|
pp_string (buffer, "unsigned_long");
|
pp_string (buffer, "unsigned_long");
|
else if (!strcmp (s, "long_long_int"))
|
else if (!strcmp (s, "long_long_int"))
|
pp_string (buffer, "Long_Long_Integer");
|
pp_string (buffer, "Long_Long_Integer");
|
else if (!strcmp (s, "long_long_unsigned_int"))
|
else if (!strcmp (s, "long_long_unsigned_int"))
|
{
|
{
|
if (package_prefix)
|
if (package_prefix)
|
{
|
{
|
append_withs ("Interfaces.C.Extensions", false);
|
append_withs ("Interfaces.C.Extensions", false);
|
pp_string (buffer, "Extensions.unsigned_long_long");
|
pp_string (buffer, "Extensions.unsigned_long_long");
|
}
|
}
|
else
|
else
|
pp_string (buffer, "unsigned_long_long");
|
pp_string (buffer, "unsigned_long_long");
|
}
|
}
|
else
|
else
|
pp_string(buffer, s);
|
pp_string(buffer, s);
|
else
|
else
|
if (!strcmp (s, "bool"))
|
if (!strcmp (s, "bool"))
|
{
|
{
|
if (package_prefix)
|
if (package_prefix)
|
{
|
{
|
append_withs ("Interfaces.C.Extensions", false);
|
append_withs ("Interfaces.C.Extensions", false);
|
pp_string (buffer, "Extensions.bool");
|
pp_string (buffer, "Extensions.bool");
|
}
|
}
|
else
|
else
|
pp_string (buffer, "bool");
|
pp_string (buffer, "bool");
|
}
|
}
|
else
|
else
|
pp_string(buffer, s);
|
pp_string(buffer, s);
|
|
|
free (s);
|
free (s);
|
}
|
}
|
|
|
/* Dump in BUFFER the assembly name of T. */
|
/* Dump in BUFFER the assembly name of T. */
|
|
|
static void
|
static void
|
pp_asm_name (pretty_printer *buffer, tree t)
|
pp_asm_name (pretty_printer *buffer, tree t)
|
{
|
{
|
tree name = DECL_ASSEMBLER_NAME (t);
|
tree name = DECL_ASSEMBLER_NAME (t);
|
char *ada_name = XALLOCAVEC (char, IDENTIFIER_LENGTH (name) + 1), *s;
|
char *ada_name = XALLOCAVEC (char, IDENTIFIER_LENGTH (name) + 1), *s;
|
const char *ident = IDENTIFIER_POINTER (name);
|
const char *ident = IDENTIFIER_POINTER (name);
|
|
|
for (s = ada_name; *ident; ident++)
|
for (s = ada_name; *ident; ident++)
|
{
|
{
|
if (*ident == ' ')
|
if (*ident == ' ')
|
break;
|
break;
|
else if (*ident != '*')
|
else if (*ident != '*')
|
*s++ = *ident;
|
*s++ = *ident;
|
}
|
}
|
|
|
*s = '\0';
|
*s = '\0';
|
pp_string (buffer, ada_name);
|
pp_string (buffer, ada_name);
|
}
|
}
|
|
|
/* Dump in BUFFER the name of a DECL node if set, following Ada syntax.
|
/* 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
|
LIMITED_ACCESS indicates whether NODE can be accessed via a limited
|
'with' clause rather than a regular 'with' clause. */
|
'with' clause rather than a regular 'with' clause. */
|
|
|
static void
|
static void
|
dump_ada_decl_name (pretty_printer *buffer, tree decl, int limited_access)
|
dump_ada_decl_name (pretty_printer *buffer, tree decl, int limited_access)
|
{
|
{
|
if (DECL_NAME (decl))
|
if (DECL_NAME (decl))
|
pp_ada_tree_identifier (buffer, DECL_NAME (decl), decl, limited_access);
|
pp_ada_tree_identifier (buffer, DECL_NAME (decl), decl, limited_access);
|
else
|
else
|
{
|
{
|
tree type_name = TYPE_NAME (TREE_TYPE (decl));
|
tree type_name = TYPE_NAME (TREE_TYPE (decl));
|
|
|
if (!type_name)
|
if (!type_name)
|
{
|
{
|
pp_string (buffer, "anon");
|
pp_string (buffer, "anon");
|
if (TREE_CODE (decl) == FIELD_DECL)
|
if (TREE_CODE (decl) == FIELD_DECL)
|
pp_scalar (buffer, "%d", DECL_UID (decl));
|
pp_scalar (buffer, "%d", DECL_UID (decl));
|
else
|
else
|
pp_scalar (buffer, "%d", TYPE_UID (TREE_TYPE (decl)));
|
pp_scalar (buffer, "%d", TYPE_UID (TREE_TYPE (decl)));
|
}
|
}
|
else if (TREE_CODE (type_name) == IDENTIFIER_NODE)
|
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, 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 S. */
|
|
|
static void
|
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, const char *s)
|
{
|
{
|
if (DECL_NAME (t1))
|
if (DECL_NAME (t1))
|
pp_ada_tree_identifier (buffer, DECL_NAME (t1), t1, false);
|
pp_ada_tree_identifier (buffer, DECL_NAME (t1), t1, false);
|
else
|
else
|
{
|
{
|
pp_string (buffer, "anon");
|
pp_string (buffer, "anon");
|
pp_scalar (buffer, "%d", TYPE_UID (TREE_TYPE (t1)));
|
pp_scalar (buffer, "%d", TYPE_UID (TREE_TYPE (t1)));
|
}
|
}
|
|
|
pp_character (buffer, '_');
|
pp_character (buffer, '_');
|
|
|
if (DECL_NAME (t1))
|
if (DECL_NAME (t1))
|
pp_ada_tree_identifier (buffer, DECL_NAME (t2), t2, false);
|
pp_ada_tree_identifier (buffer, DECL_NAME (t2), t2, false);
|
else
|
else
|
{
|
{
|
pp_string (buffer, "anon");
|
pp_string (buffer, "anon");
|
pp_scalar (buffer, "%d", TYPE_UID (TREE_TYPE (t2)));
|
pp_scalar (buffer, "%d", TYPE_UID (TREE_TYPE (t2)));
|
}
|
}
|
|
|
pp_string (buffer, s);
|
pp_string (buffer, s);
|
}
|
}
|
|
|
/* Dump in BUFFER pragma Import C/CPP on a given node T. */
|
/* Dump in BUFFER pragma Import C/CPP on a given node T. */
|
|
|
static void
|
static void
|
dump_ada_import (pretty_printer *buffer, tree t)
|
dump_ada_import (pretty_printer *buffer, tree t)
|
{
|
{
|
const char *name = IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (t));
|
const char *name = IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (t));
|
int is_stdcall = TREE_CODE (t) == FUNCTION_DECL &&
|
int is_stdcall = TREE_CODE (t) == FUNCTION_DECL &&
|
lookup_attribute ("stdcall", TYPE_ATTRIBUTES (TREE_TYPE (t)));
|
lookup_attribute ("stdcall", TYPE_ATTRIBUTES (TREE_TYPE (t)));
|
|
|
if (is_stdcall)
|
if (is_stdcall)
|
pp_string (buffer, "pragma Import (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, ");
|
pp_string (buffer, "pragma Import (CPP, ");
|
else
|
else
|
pp_string (buffer, "pragma Import (C, ");
|
pp_string (buffer, "pragma Import (C, ");
|
|
|
dump_ada_decl_name (buffer, t, false);
|
dump_ada_decl_name (buffer, t, false);
|
pp_string (buffer, ", \"");
|
pp_string (buffer, ", \"");
|
|
|
if (is_stdcall)
|
if (is_stdcall)
|
pp_string (buffer, IDENTIFIER_POINTER (DECL_NAME (t)));
|
pp_string (buffer, IDENTIFIER_POINTER (DECL_NAME (t)));
|
else
|
else
|
pp_asm_name (buffer, t);
|
pp_asm_name (buffer, t);
|
|
|
pp_string (buffer, "\");");
|
pp_string (buffer, "\");");
|
}
|
}
|
|
|
/* Check whether T and its type have different names, and append "the_"
|
/* Check whether T and its type have different names, and append "the_"
|
otherwise in BUFFER. */
|
otherwise in BUFFER. */
|
|
|
static void
|
static void
|
check_name (pretty_printer *buffer, tree t)
|
check_name (pretty_printer *buffer, tree t)
|
{
|
{
|
const char *s;
|
const char *s;
|
tree tmp = TREE_TYPE (t);
|
tree tmp = TREE_TYPE (t);
|
|
|
while (TREE_CODE (tmp) == POINTER_TYPE && !TYPE_NAME (tmp))
|
while (TREE_CODE (tmp) == POINTER_TYPE && !TYPE_NAME (tmp))
|
tmp = TREE_TYPE (tmp);
|
tmp = TREE_TYPE (tmp);
|
|
|
if (TREE_CODE (tmp) != FUNCTION_TYPE)
|
if (TREE_CODE (tmp) != FUNCTION_TYPE)
|
{
|
{
|
if (TREE_CODE (tmp) == IDENTIFIER_NODE)
|
if (TREE_CODE (tmp) == IDENTIFIER_NODE)
|
s = IDENTIFIER_POINTER (tmp);
|
s = IDENTIFIER_POINTER (tmp);
|
else if (!TYPE_NAME (tmp))
|
else if (!TYPE_NAME (tmp))
|
s = "";
|
s = "";
|
else if (TREE_CODE (TYPE_NAME (tmp)) == IDENTIFIER_NODE)
|
else if (TREE_CODE (TYPE_NAME (tmp)) == IDENTIFIER_NODE)
|
s = IDENTIFIER_POINTER (TYPE_NAME (tmp));
|
s = IDENTIFIER_POINTER (TYPE_NAME (tmp));
|
else
|
else
|
s = IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp)));
|
s = IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp)));
|
|
|
if (!strcasecmp (IDENTIFIER_POINTER (DECL_NAME (t)), s))
|
if (!strcasecmp (IDENTIFIER_POINTER (DECL_NAME (t)), s))
|
pp_string (buffer, "the_");
|
pp_string (buffer, "the_");
|
}
|
}
|
}
|
}
|
|
|
/* Dump in BUFFER a function declaration FUNC with Ada syntax.
|
/* Dump in BUFFER a function declaration FUNC with Ada syntax.
|
IS_METHOD indicates whether FUNC is a C++ method.
|
IS_METHOD indicates whether FUNC is a C++ method.
|
IS_CONSTRUCTOR whether FUNC is a C++ constructor.
|
IS_CONSTRUCTOR whether FUNC is a C++ constructor.
|
IS_DESTRUCTOR whether FUNC is a C++ destructor.
|
IS_DESTRUCTOR whether FUNC is a C++ destructor.
|
SPC is the current indentation level. */
|
SPC is the current indentation level. */
|
|
|
static int
|
static int
|
dump_ada_function_declaration (pretty_printer *buffer, tree func,
|
dump_ada_function_declaration (pretty_printer *buffer, tree func,
|
int is_method, int is_constructor,
|
int is_method, int is_constructor,
|
int is_destructor, int spc)
|
int is_destructor, int spc)
|
{
|
{
|
tree arg;
|
tree arg;
|
const tree node = TREE_TYPE (func);
|
const tree node = TREE_TYPE (func);
|
char buf [16];
|
char buf [16];
|
int num = 0, num_args = 0, have_args = true, have_ellipsis = false;
|
int num = 0, num_args = 0, have_args = true, have_ellipsis = false;
|
|
|
/* Compute number of arguments. */
|
/* Compute number of arguments. */
|
arg = TYPE_ARG_TYPES (node);
|
arg = TYPE_ARG_TYPES (node);
|
|
|
if (arg)
|
if (arg)
|
{
|
{
|
while (TREE_CHAIN (arg) && arg != error_mark_node)
|
while (TREE_CHAIN (arg) && arg != error_mark_node)
|
{
|
{
|
num_args++;
|
num_args++;
|
arg = TREE_CHAIN (arg);
|
arg = TREE_CHAIN (arg);
|
}
|
}
|
|
|
if (TREE_CODE (TREE_VALUE (arg)) != VOID_TYPE)
|
if (TREE_CODE (TREE_VALUE (arg)) != VOID_TYPE)
|
{
|
{
|
num_args++;
|
num_args++;
|
have_ellipsis = true;
|
have_ellipsis = true;
|
}
|
}
|
}
|
}
|
|
|
if (is_constructor)
|
if (is_constructor)
|
num_args--;
|
num_args--;
|
|
|
if (is_destructor)
|
if (is_destructor)
|
num_args = 1;
|
num_args = 1;
|
|
|
if (num_args > 2)
|
if (num_args > 2)
|
newline_and_indent (buffer, spc + 1);
|
newline_and_indent (buffer, spc + 1);
|
|
|
if (num_args > 0)
|
if (num_args > 0)
|
{
|
{
|
pp_space (buffer);
|
pp_space (buffer);
|
pp_character (buffer, '(');
|
pp_character (buffer, '(');
|
}
|
}
|
|
|
if (TREE_CODE (func) == FUNCTION_DECL)
|
if (TREE_CODE (func) == FUNCTION_DECL)
|
arg = DECL_ARGUMENTS (func);
|
arg = DECL_ARGUMENTS (func);
|
else
|
else
|
arg = NULL_TREE;
|
arg = NULL_TREE;
|
|
|
if (arg == NULL_TREE)
|
if (arg == NULL_TREE)
|
{
|
{
|
have_args = false;
|
have_args = false;
|
arg = TYPE_ARG_TYPES (node);
|
arg = TYPE_ARG_TYPES (node);
|
|
|
if (arg && TREE_CODE (TREE_VALUE (arg)) == VOID_TYPE)
|
if (arg && TREE_CODE (TREE_VALUE (arg)) == VOID_TYPE)
|
arg = NULL_TREE;
|
arg = NULL_TREE;
|
}
|
}
|
|
|
if (is_constructor)
|
if (is_constructor)
|
arg = TREE_CHAIN (arg);
|
arg = TREE_CHAIN (arg);
|
|
|
/* Print the argument names (if available) & types. */
|
/* Print the argument names (if available) & types. */
|
|
|
for (num = 1; num <= num_args; num++)
|
for (num = 1; num <= num_args; num++)
|
{
|
{
|
if (have_args)
|
if (have_args)
|
{
|
{
|
if (DECL_NAME (arg))
|
if (DECL_NAME (arg))
|
{
|
{
|
check_name (buffer, arg);
|
check_name (buffer, arg);
|
pp_ada_tree_identifier (buffer, DECL_NAME (arg), 0, false);
|
pp_ada_tree_identifier (buffer, DECL_NAME (arg), 0, false);
|
pp_string (buffer, " : ");
|
pp_string (buffer, " : ");
|
}
|
}
|
else
|
else
|
{
|
{
|
sprintf (buf, "arg%d : ", num);
|
sprintf (buf, "arg%d : ", num);
|
pp_string (buffer, buf);
|
pp_string (buffer, buf);
|
}
|
}
|
|
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, TREE_TYPE (arg), node, NULL, spc, 0, true);
|
(buffer, TREE_TYPE (arg), node, NULL, spc, 0, true);
|
}
|
}
|
else
|
else
|
{
|
{
|
sprintf (buf, "arg%d : ", num);
|
sprintf (buf, "arg%d : ", num);
|
pp_string (buffer, buf);
|
pp_string (buffer, buf);
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, TREE_VALUE (arg), node, NULL, spc, 0, true);
|
(buffer, TREE_VALUE (arg), node, NULL, spc, 0, true);
|
}
|
}
|
|
|
if (TREE_TYPE (arg) && TREE_TYPE (TREE_TYPE (arg))
|
if (TREE_TYPE (arg) && TREE_TYPE (TREE_TYPE (arg))
|
&& is_tagged_type (TREE_TYPE (TREE_TYPE (arg))))
|
&& is_tagged_type (TREE_TYPE (TREE_TYPE (arg))))
|
{
|
{
|
if (!is_method
|
if (!is_method
|
|| (num != 1 || (!DECL_VINDEX (func) && !is_constructor)))
|
|| (num != 1 || (!DECL_VINDEX (func) && !is_constructor)))
|
pp_string (buffer, "'Class");
|
pp_string (buffer, "'Class");
|
}
|
}
|
|
|
arg = TREE_CHAIN (arg);
|
arg = TREE_CHAIN (arg);
|
|
|
if (num < num_args)
|
if (num < num_args)
|
{
|
{
|
pp_character (buffer, ';');
|
pp_character (buffer, ';');
|
|
|
if (num_args > 2)
|
if (num_args > 2)
|
newline_and_indent (buffer, spc + INDENT_INCR);
|
newline_and_indent (buffer, spc + INDENT_INCR);
|
else
|
else
|
pp_space (buffer);
|
pp_space (buffer);
|
}
|
}
|
}
|
}
|
|
|
if (have_ellipsis)
|
if (have_ellipsis)
|
{
|
{
|
pp_string (buffer, " -- , ...");
|
pp_string (buffer, " -- , ...");
|
newline_and_indent (buffer, spc + INDENT_INCR);
|
newline_and_indent (buffer, spc + INDENT_INCR);
|
}
|
}
|
|
|
if (num_args > 0)
|
if (num_args > 0)
|
pp_character (buffer, ')');
|
pp_character (buffer, ')');
|
return num_args;
|
return num_args;
|
}
|
}
|
|
|
/* Dump in BUFFER all the domains associated with an array NODE,
|
/* Dump in BUFFER all the domains associated with an array NODE,
|
using Ada syntax. SPC is the current indentation level. */
|
using Ada syntax. SPC is the current indentation level. */
|
|
|
static void
|
static void
|
dump_ada_array_domains (pretty_printer *buffer, tree node, int spc)
|
dump_ada_array_domains (pretty_printer *buffer, tree node, int spc)
|
{
|
{
|
int first = 1;
|
int first = 1;
|
pp_character (buffer, '(');
|
pp_character (buffer, '(');
|
|
|
for (; TREE_CODE (node) == ARRAY_TYPE; node = TREE_TYPE (node))
|
for (; TREE_CODE (node) == ARRAY_TYPE; node = TREE_TYPE (node))
|
{
|
{
|
tree domain = TYPE_DOMAIN (node);
|
tree domain = TYPE_DOMAIN (node);
|
|
|
if (domain)
|
if (domain)
|
{
|
{
|
tree min = TYPE_MIN_VALUE (domain);
|
tree min = TYPE_MIN_VALUE (domain);
|
tree max = TYPE_MAX_VALUE (domain);
|
tree max = TYPE_MAX_VALUE (domain);
|
|
|
if (!first)
|
if (!first)
|
pp_string (buffer, ", ");
|
pp_string (buffer, ", ");
|
first = 0;
|
first = 0;
|
|
|
if (min)
|
if (min)
|
dump_generic_ada_node (buffer, min, NULL_TREE, NULL, spc, 0, true);
|
dump_generic_ada_node (buffer, min, NULL_TREE, NULL, spc, 0, true);
|
pp_string (buffer, " .. ");
|
pp_string (buffer, " .. ");
|
|
|
/* If the upper bound is zero, gcc may generate a NULL_TREE
|
/* If the upper bound is zero, gcc may generate a NULL_TREE
|
for TYPE_MAX_VALUE rather than an integer_cst. */
|
for TYPE_MAX_VALUE rather than an integer_cst. */
|
if (max)
|
if (max)
|
dump_generic_ada_node (buffer, max, NULL_TREE, NULL, spc, 0, true);
|
dump_generic_ada_node (buffer, max, NULL_TREE, NULL, spc, 0, true);
|
else
|
else
|
pp_string (buffer, "0");
|
pp_string (buffer, "0");
|
}
|
}
|
else
|
else
|
pp_string (buffer, "size_t");
|
pp_string (buffer, "size_t");
|
}
|
}
|
pp_character (buffer, ')');
|
pp_character (buffer, ')');
|
}
|
}
|
|
|
/* Dump in BUFFER file:line information related to NODE. */
|
/* Dump in BUFFER file:line information related to NODE. */
|
|
|
static void
|
static void
|
dump_sloc (pretty_printer *buffer, tree node)
|
dump_sloc (pretty_printer *buffer, tree node)
|
{
|
{
|
expanded_location xloc;
|
expanded_location xloc;
|
|
|
xloc.file = NULL;
|
xloc.file = NULL;
|
|
|
if (TREE_CODE_CLASS (TREE_CODE (node)) == tcc_declaration)
|
if (TREE_CODE_CLASS (TREE_CODE (node)) == tcc_declaration)
|
xloc = expand_location (DECL_SOURCE_LOCATION (node));
|
xloc = expand_location (DECL_SOURCE_LOCATION (node));
|
else if (EXPR_HAS_LOCATION (node))
|
else if (EXPR_HAS_LOCATION (node))
|
xloc = expand_location (EXPR_LOCATION (node));
|
xloc = expand_location (EXPR_LOCATION (node));
|
|
|
if (xloc.file)
|
if (xloc.file)
|
{
|
{
|
pp_string (buffer, xloc.file);
|
pp_string (buffer, xloc.file);
|
pp_string (buffer, ":");
|
pp_string (buffer, ":");
|
pp_decimal_int (buffer, xloc.line);
|
pp_decimal_int (buffer, xloc.line);
|
}
|
}
|
}
|
}
|
|
|
/* Return true if T designates a one dimension array of "char". */
|
/* Return true if T designates a one dimension array of "char". */
|
|
|
static bool
|
static bool
|
is_char_array (tree t)
|
is_char_array (tree t)
|
{
|
{
|
tree tmp;
|
tree tmp;
|
int num_dim = 0;
|
int num_dim = 0;
|
|
|
/* Retrieve array's type. */
|
/* Retrieve array's type. */
|
tmp = t;
|
tmp = t;
|
while (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE)
|
while (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE)
|
{
|
{
|
num_dim++;
|
num_dim++;
|
tmp = TREE_TYPE (tmp);
|
tmp = TREE_TYPE (tmp);
|
}
|
}
|
|
|
tmp = TREE_TYPE (tmp);
|
tmp = TREE_TYPE (tmp);
|
return num_dim == 1 && TREE_CODE (tmp) == INTEGER_TYPE
|
return num_dim == 1 && TREE_CODE (tmp) == INTEGER_TYPE
|
&& !strcmp (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp))), "char");
|
&& !strcmp (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp))), "char");
|
}
|
}
|
|
|
/* Dump in BUFFER an array type T in Ada syntax. Assume that the "type"
|
/* 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
|
keyword and name have already been printed. SPC is the indentation
|
level. */
|
level. */
|
|
|
static void
|
static void
|
dump_ada_array_type (pretty_printer *buffer, tree t, int spc)
|
dump_ada_array_type (pretty_printer *buffer, tree t, int spc)
|
{
|
{
|
tree tmp;
|
tree tmp;
|
bool char_array = is_char_array (t);
|
bool char_array = is_char_array (t);
|
|
|
/* Special case char arrays. */
|
/* Special case char arrays. */
|
if (char_array)
|
if (char_array)
|
{
|
{
|
pp_string (buffer, "Interfaces.C.char_array ");
|
pp_string (buffer, "Interfaces.C.char_array ");
|
}
|
}
|
else
|
else
|
pp_string (buffer, "array ");
|
pp_string (buffer, "array ");
|
|
|
/* Print the dimensions. */
|
/* Print the dimensions. */
|
dump_ada_array_domains (buffer, TREE_TYPE (t), spc);
|
dump_ada_array_domains (buffer, TREE_TYPE (t), spc);
|
|
|
/* Retrieve array's type. */
|
/* Retrieve array's type. */
|
tmp = TREE_TYPE (t);
|
tmp = TREE_TYPE (t);
|
while (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE)
|
while (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE)
|
tmp = TREE_TYPE (tmp);
|
tmp = TREE_TYPE (tmp);
|
|
|
/* Print array's type. */
|
/* Print array's type. */
|
if (!char_array)
|
if (!char_array)
|
{
|
{
|
pp_string (buffer, " of ");
|
pp_string (buffer, " of ");
|
|
|
if (TREE_CODE (TREE_TYPE (tmp)) != POINTER_TYPE)
|
if (TREE_CODE (TREE_TYPE (tmp)) != POINTER_TYPE)
|
pp_string (buffer, "aliased ");
|
pp_string (buffer, "aliased ");
|
|
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, TREE_TYPE (tmp), TREE_TYPE (t), NULL, spc, false, true);
|
(buffer, TREE_TYPE (tmp), TREE_TYPE (t), NULL, spc, false, true);
|
}
|
}
|
}
|
}
|
|
|
/* Dump in BUFFER type names associated with a template, each prepended with
|
/* Dump in BUFFER type names associated with a template, each prepended with
|
'_'. TYPES is the TREE_PURPOSE of a DECL_TEMPLATE_INSTANTIATIONS.
|
'_'. TYPES is the TREE_PURPOSE of a DECL_TEMPLATE_INSTANTIATIONS.
|
CPP_CHECK is used to perform C++ queries on nodes.
|
CPP_CHECK is used to perform C++ queries on nodes.
|
SPC is the indentation level. */
|
SPC is the indentation level. */
|
|
|
static void
|
static void
|
dump_template_types (pretty_printer *buffer, tree types,
|
dump_template_types (pretty_printer *buffer, tree types,
|
int (*cpp_check)(tree, cpp_operation), int spc)
|
int (*cpp_check)(tree, cpp_operation), int spc)
|
{
|
{
|
size_t i;
|
size_t i;
|
size_t len = TREE_VEC_LENGTH (types);
|
size_t len = TREE_VEC_LENGTH (types);
|
|
|
for (i = 0; i < len; i++)
|
for (i = 0; i < len; i++)
|
{
|
{
|
tree elem = TREE_VEC_ELT (types, i);
|
tree elem = TREE_VEC_ELT (types, i);
|
pp_character (buffer, '_');
|
pp_character (buffer, '_');
|
if (!dump_generic_ada_node (buffer, elem, 0, cpp_check, spc, false, true))
|
if (!dump_generic_ada_node (buffer, elem, 0, cpp_check, spc, false, true))
|
{
|
{
|
pp_string (buffer, "unknown");
|
pp_string (buffer, "unknown");
|
pp_scalar (buffer, "%lu", (unsigned long) TREE_HASH (elem));
|
pp_scalar (buffer, "%lu", (unsigned long) TREE_HASH (elem));
|
}
|
}
|
}
|
}
|
}
|
}
|
|
|
/* Dump in BUFFER the contents of all class instantiations associated with
|
/* 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.
|
a given template T. CPP_CHECK is used to perform C++ queries on nodes.
|
SPC is the indentation level. */
|
SPC is the indentation level. */
|
|
|
static int
|
static int
|
dump_ada_template (pretty_printer *buffer, tree t,
|
dump_ada_template (pretty_printer *buffer, tree t,
|
int (*cpp_check)(tree, cpp_operation), int spc)
|
int (*cpp_check)(tree, cpp_operation), int spc)
|
{
|
{
|
tree inst = DECL_VINDEX (t);
|
tree inst = DECL_VINDEX (t);
|
/* DECL_VINDEX is DECL_TEMPLATE_INSTANTIATIONS in this context. */
|
/* DECL_VINDEX is DECL_TEMPLATE_INSTANTIATIONS in this context. */
|
int num_inst = 0;
|
int num_inst = 0;
|
|
|
while (inst && inst != error_mark_node)
|
while (inst && inst != error_mark_node)
|
{
|
{
|
tree types = TREE_PURPOSE (inst);
|
tree types = TREE_PURPOSE (inst);
|
tree instance = TREE_VALUE (inst);
|
tree instance = TREE_VALUE (inst);
|
|
|
if (TREE_VEC_LENGTH (types) == 0)
|
if (TREE_VEC_LENGTH (types) == 0)
|
break;
|
break;
|
|
|
if (!TYPE_P (instance) || !TYPE_METHODS (instance))
|
if (!TYPE_P (instance) || !TYPE_METHODS (instance))
|
break;
|
break;
|
|
|
num_inst++;
|
num_inst++;
|
INDENT (spc);
|
INDENT (spc);
|
pp_string (buffer, "package ");
|
pp_string (buffer, "package ");
|
package_prefix = false;
|
package_prefix = false;
|
dump_generic_ada_node (buffer, instance, t, cpp_check, spc, false, true);
|
dump_generic_ada_node (buffer, instance, t, cpp_check, spc, false, true);
|
dump_template_types (buffer, types, cpp_check, spc);
|
dump_template_types (buffer, types, cpp_check, spc);
|
pp_string (buffer, " is");
|
pp_string (buffer, " is");
|
spc += INDENT_INCR;
|
spc += INDENT_INCR;
|
newline_and_indent (buffer, spc);
|
newline_and_indent (buffer, spc);
|
|
|
TREE_VISITED (get_underlying_decl (instance)) = 1;
|
TREE_VISITED (get_underlying_decl (instance)) = 1;
|
pp_string (buffer, "type ");
|
pp_string (buffer, "type ");
|
dump_generic_ada_node (buffer, instance, t, cpp_check, spc, false, true);
|
dump_generic_ada_node (buffer, instance, t, cpp_check, spc, false, true);
|
package_prefix = true;
|
package_prefix = true;
|
|
|
if (is_tagged_type (instance))
|
if (is_tagged_type (instance))
|
pp_string (buffer, " is tagged limited ");
|
pp_string (buffer, " is tagged limited ");
|
else
|
else
|
pp_string (buffer, " is limited ");
|
pp_string (buffer, " is limited ");
|
|
|
dump_generic_ada_node (buffer, instance, t, cpp_check, spc, false, false);
|
dump_generic_ada_node (buffer, instance, t, cpp_check, spc, false, false);
|
pp_newline (buffer);
|
pp_newline (buffer);
|
spc -= INDENT_INCR;
|
spc -= INDENT_INCR;
|
newline_and_indent (buffer, spc);
|
newline_and_indent (buffer, spc);
|
|
|
pp_string (buffer, "end;");
|
pp_string (buffer, "end;");
|
newline_and_indent (buffer, spc);
|
newline_and_indent (buffer, spc);
|
pp_string (buffer, "use ");
|
pp_string (buffer, "use ");
|
package_prefix = false;
|
package_prefix = false;
|
dump_generic_ada_node (buffer, instance, t, cpp_check, spc, false, true);
|
dump_generic_ada_node (buffer, instance, t, cpp_check, spc, false, true);
|
dump_template_types (buffer, types, cpp_check, spc);
|
dump_template_types (buffer, types, cpp_check, spc);
|
package_prefix = true;
|
package_prefix = true;
|
pp_semicolon (buffer);
|
pp_semicolon (buffer);
|
pp_newline (buffer);
|
pp_newline (buffer);
|
pp_newline (buffer);
|
pp_newline (buffer);
|
|
|
inst = TREE_CHAIN (inst);
|
inst = TREE_CHAIN (inst);
|
}
|
}
|
|
|
return num_inst > 0;
|
return num_inst > 0;
|
}
|
}
|
|
|
/* Return true if NODE is a simple enum types, that can be mapped to an
|
/* Return true if NODE is a simple enum types, that can be mapped to an
|
Ada enum type directly. */
|
Ada enum type directly. */
|
|
|
static bool
|
static bool
|
is_simple_enum (tree node)
|
is_simple_enum (tree node)
|
{
|
{
|
unsigned HOST_WIDE_INT count = 0;
|
unsigned HOST_WIDE_INT count = 0;
|
tree value;
|
tree value;
|
|
|
for (value = TYPE_VALUES (node); value; value = TREE_CHAIN (value))
|
for (value = TYPE_VALUES (node); value; value = TREE_CHAIN (value))
|
{
|
{
|
tree int_val = TREE_VALUE (value);
|
tree int_val = TREE_VALUE (value);
|
|
|
if (TREE_CODE (int_val) != INTEGER_CST)
|
if (TREE_CODE (int_val) != INTEGER_CST)
|
int_val = DECL_INITIAL (int_val);
|
int_val = DECL_INITIAL (int_val);
|
|
|
if (!host_integerp (int_val, 0))
|
if (!host_integerp (int_val, 0))
|
return false;
|
return false;
|
else if (TREE_INT_CST_LOW (int_val) != count)
|
else if (TREE_INT_CST_LOW (int_val) != count)
|
return false;
|
return false;
|
|
|
count++;
|
count++;
|
}
|
}
|
|
|
return true;
|
return true;
|
}
|
}
|
|
|
static bool in_function = true;
|
static bool in_function = true;
|
static bool bitfield_used = false;
|
static bool bitfield_used = false;
|
|
|
/* Recursively dump in BUFFER Ada declarations corresponding to NODE of type
|
/* 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
|
TYPE. CPP_CHECK is used to perform C++ queries on nodes. SPC is the
|
indentation level. LIMITED_ACCESS indicates whether NODE can be referenced
|
indentation level. LIMITED_ACCESS indicates whether NODE can be referenced
|
via a "limited with" clause. NAME_ONLY indicates whether we should only
|
via a "limited with" clause. NAME_ONLY indicates whether we should only
|
dump the name of NODE, instead of its full declaration. */
|
dump the name of NODE, instead of its full declaration. */
|
|
|
static int
|
static int
|
dump_generic_ada_node (pretty_printer *buffer, tree node, tree type,
|
dump_generic_ada_node (pretty_printer *buffer, tree node, tree type,
|
int (*cpp_check)(tree, cpp_operation), int spc,
|
int (*cpp_check)(tree, cpp_operation), int spc,
|
int limited_access, bool name_only)
|
int limited_access, bool name_only)
|
{
|
{
|
if (node == NULL_TREE)
|
if (node == NULL_TREE)
|
return 0;
|
return 0;
|
|
|
switch (TREE_CODE (node))
|
switch (TREE_CODE (node))
|
{
|
{
|
case ERROR_MARK:
|
case ERROR_MARK:
|
pp_string (buffer, "<<< error >>>");
|
pp_string (buffer, "<<< error >>>");
|
return 0;
|
return 0;
|
|
|
case IDENTIFIER_NODE:
|
case IDENTIFIER_NODE:
|
pp_ada_tree_identifier (buffer, node, type, limited_access);
|
pp_ada_tree_identifier (buffer, node, type, limited_access);
|
break;
|
break;
|
|
|
case TREE_LIST:
|
case TREE_LIST:
|
pp_string (buffer, "--- unexpected node: TREE_LIST");
|
pp_string (buffer, "--- unexpected node: TREE_LIST");
|
return 0;
|
return 0;
|
|
|
case TREE_BINFO:
|
case TREE_BINFO:
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, BINFO_TYPE (node), type, cpp_check,
|
(buffer, BINFO_TYPE (node), type, cpp_check,
|
spc, limited_access, name_only);
|
spc, limited_access, name_only);
|
|
|
case TREE_VEC:
|
case TREE_VEC:
|
pp_string (buffer, "--- unexpected node: TREE_VEC");
|
pp_string (buffer, "--- unexpected node: TREE_VEC");
|
return 0;
|
return 0;
|
|
|
case VOID_TYPE:
|
case VOID_TYPE:
|
if (package_prefix)
|
if (package_prefix)
|
{
|
{
|
append_withs ("System", false);
|
append_withs ("System", false);
|
pp_string (buffer, "System.Address");
|
pp_string (buffer, "System.Address");
|
}
|
}
|
else
|
else
|
pp_string (buffer, "address");
|
pp_string (buffer, "address");
|
break;
|
break;
|
|
|
case VECTOR_TYPE:
|
case VECTOR_TYPE:
|
pp_string (buffer, "<vector>");
|
pp_string (buffer, "<vector>");
|
break;
|
break;
|
|
|
case COMPLEX_TYPE:
|
case COMPLEX_TYPE:
|
pp_string (buffer, "<complex>");
|
pp_string (buffer, "<complex>");
|
break;
|
break;
|
|
|
case ENUMERAL_TYPE:
|
case ENUMERAL_TYPE:
|
if (name_only)
|
if (name_only)
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, TYPE_NAME (node), node, cpp_check, spc, 0, true);
|
(buffer, TYPE_NAME (node), node, cpp_check, spc, 0, true);
|
else
|
else
|
{
|
{
|
tree value = TYPE_VALUES (node);
|
tree value = TYPE_VALUES (node);
|
|
|
if (is_simple_enum (node))
|
if (is_simple_enum (node))
|
{
|
{
|
bool first = true;
|
bool first = true;
|
spc += INDENT_INCR;
|
spc += INDENT_INCR;
|
newline_and_indent (buffer, spc - 1);
|
newline_and_indent (buffer, spc - 1);
|
pp_string (buffer, "(");
|
pp_string (buffer, "(");
|
for (; value; value = TREE_CHAIN (value))
|
for (; value; value = TREE_CHAIN (value))
|
{
|
{
|
if (first)
|
if (first)
|
first = false;
|
first = false;
|
else
|
else
|
{
|
{
|
pp_string (buffer, ",");
|
pp_string (buffer, ",");
|
newline_and_indent (buffer, spc);
|
newline_and_indent (buffer, spc);
|
}
|
}
|
|
|
pp_ada_tree_identifier
|
pp_ada_tree_identifier
|
(buffer, TREE_PURPOSE (value), node, false);
|
(buffer, TREE_PURPOSE (value), node, false);
|
}
|
}
|
pp_string (buffer, ");");
|
pp_string (buffer, ");");
|
spc -= INDENT_INCR;
|
spc -= INDENT_INCR;
|
newline_and_indent (buffer, spc);
|
newline_and_indent (buffer, spc);
|
pp_string (buffer, "pragma Convention (C, ");
|
pp_string (buffer, "pragma Convention (C, ");
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, DECL_NAME (type) ? type : TYPE_NAME (node), type,
|
(buffer, DECL_NAME (type) ? type : TYPE_NAME (node), type,
|
cpp_check, spc, 0, true);
|
cpp_check, spc, 0, true);
|
pp_string (buffer, ")");
|
pp_string (buffer, ")");
|
}
|
}
|
else
|
else
|
{
|
{
|
pp_string (buffer, "unsigned");
|
pp_string (buffer, "unsigned");
|
for (; value; value = TREE_CHAIN (value))
|
for (; value; value = TREE_CHAIN (value))
|
{
|
{
|
pp_semicolon (buffer);
|
pp_semicolon (buffer);
|
newline_and_indent (buffer, spc);
|
newline_and_indent (buffer, spc);
|
|
|
pp_ada_tree_identifier
|
pp_ada_tree_identifier
|
(buffer, TREE_PURPOSE (value), node, false);
|
(buffer, TREE_PURPOSE (value), node, false);
|
pp_string (buffer, " : constant ");
|
pp_string (buffer, " : constant ");
|
|
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, DECL_NAME (type) ? type : TYPE_NAME (node), type,
|
(buffer, DECL_NAME (type) ? type : TYPE_NAME (node), type,
|
cpp_check, spc, 0, true);
|
cpp_check, spc, 0, true);
|
|
|
pp_string (buffer, " := ");
|
pp_string (buffer, " := ");
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer,
|
(buffer,
|
TREE_CODE (TREE_VALUE (value)) == INTEGER_CST ?
|
TREE_CODE (TREE_VALUE (value)) == INTEGER_CST ?
|
TREE_VALUE (value) : DECL_INITIAL (TREE_VALUE (value)),
|
TREE_VALUE (value) : DECL_INITIAL (TREE_VALUE (value)),
|
node, cpp_check, spc, false, true);
|
node, cpp_check, spc, false, true);
|
}
|
}
|
}
|
}
|
}
|
}
|
break;
|
break;
|
|
|
case INTEGER_TYPE:
|
case INTEGER_TYPE:
|
case REAL_TYPE:
|
case REAL_TYPE:
|
case FIXED_POINT_TYPE:
|
case FIXED_POINT_TYPE:
|
case BOOLEAN_TYPE:
|
case BOOLEAN_TYPE:
|
{
|
{
|
enum tree_code_class tclass;
|
enum tree_code_class tclass;
|
|
|
tclass = TREE_CODE_CLASS (TREE_CODE (node));
|
tclass = TREE_CODE_CLASS (TREE_CODE (node));
|
|
|
if (tclass == tcc_declaration)
|
if (tclass == tcc_declaration)
|
{
|
{
|
if (DECL_NAME (node))
|
if (DECL_NAME (node))
|
pp_ada_tree_identifier
|
pp_ada_tree_identifier
|
(buffer, DECL_NAME (node), 0, limited_access);
|
(buffer, DECL_NAME (node), 0, limited_access);
|
else
|
else
|
pp_string (buffer, "<unnamed type decl>");
|
pp_string (buffer, "<unnamed type decl>");
|
}
|
}
|
else if (tclass == tcc_type)
|
else if (tclass == tcc_type)
|
{
|
{
|
if (TYPE_NAME (node))
|
if (TYPE_NAME (node))
|
{
|
{
|
if (TREE_CODE (TYPE_NAME (node)) == IDENTIFIER_NODE)
|
if (TREE_CODE (TYPE_NAME (node)) == IDENTIFIER_NODE)
|
pp_ada_tree_identifier (buffer, TYPE_NAME (node),
|
pp_ada_tree_identifier (buffer, TYPE_NAME (node),
|
node, limited_access);
|
node, limited_access);
|
else if (TREE_CODE (TYPE_NAME (node)) == TYPE_DECL
|
else if (TREE_CODE (TYPE_NAME (node)) == TYPE_DECL
|
&& DECL_NAME (TYPE_NAME (node)))
|
&& DECL_NAME (TYPE_NAME (node)))
|
dump_ada_decl_name (buffer, TYPE_NAME (node), limited_access);
|
dump_ada_decl_name (buffer, TYPE_NAME (node), limited_access);
|
else
|
else
|
pp_string (buffer, "<unnamed type>");
|
pp_string (buffer, "<unnamed type>");
|
}
|
}
|
else if (TREE_CODE (node) == INTEGER_TYPE)
|
else if (TREE_CODE (node) == INTEGER_TYPE)
|
{
|
{
|
append_withs ("Interfaces.C.Extensions", false);
|
append_withs ("Interfaces.C.Extensions", false);
|
bitfield_used = true;
|
bitfield_used = true;
|
|
|
if (TYPE_PRECISION (node) == 1)
|
if (TYPE_PRECISION (node) == 1)
|
pp_string (buffer, "Extensions.Unsigned_1");
|
pp_string (buffer, "Extensions.Unsigned_1");
|
else
|
else
|
{
|
{
|
pp_string (buffer, (TYPE_UNSIGNED (node)
|
pp_string (buffer, (TYPE_UNSIGNED (node)
|
? "Extensions.Unsigned_"
|
? "Extensions.Unsigned_"
|
: "Extensions.Signed_"));
|
: "Extensions.Signed_"));
|
pp_decimal_int (buffer, TYPE_PRECISION (node));
|
pp_decimal_int (buffer, TYPE_PRECISION (node));
|
}
|
}
|
}
|
}
|
else
|
else
|
pp_string (buffer, "<unnamed type>");
|
pp_string (buffer, "<unnamed type>");
|
}
|
}
|
break;
|
break;
|
}
|
}
|
|
|
case POINTER_TYPE:
|
case POINTER_TYPE:
|
case REFERENCE_TYPE:
|
case REFERENCE_TYPE:
|
if (TREE_CODE (TREE_TYPE (node)) == FUNCTION_TYPE)
|
if (TREE_CODE (TREE_TYPE (node)) == FUNCTION_TYPE)
|
{
|
{
|
tree fnode = TREE_TYPE (node);
|
tree fnode = TREE_TYPE (node);
|
bool is_function;
|
bool is_function;
|
bool prev_in_function = in_function;
|
bool prev_in_function = in_function;
|
|
|
if (VOID_TYPE_P (TREE_TYPE (fnode)))
|
if (VOID_TYPE_P (TREE_TYPE (fnode)))
|
{
|
{
|
is_function = false;
|
is_function = false;
|
pp_string (buffer, "access procedure");
|
pp_string (buffer, "access procedure");
|
}
|
}
|
else
|
else
|
{
|
{
|
is_function = true;
|
is_function = true;
|
pp_string (buffer, "access function");
|
pp_string (buffer, "access function");
|
}
|
}
|
|
|
in_function = is_function;
|
in_function = is_function;
|
dump_ada_function_declaration
|
dump_ada_function_declaration
|
(buffer, node, false, false, false, spc + INDENT_INCR);
|
(buffer, node, false, false, false, spc + INDENT_INCR);
|
in_function = prev_in_function;
|
in_function = prev_in_function;
|
|
|
if (is_function)
|
if (is_function)
|
{
|
{
|
pp_string (buffer, " return ");
|
pp_string (buffer, " return ");
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, TREE_TYPE (fnode), type, cpp_check, spc, 0, true);
|
(buffer, TREE_TYPE (fnode), type, cpp_check, spc, 0, true);
|
}
|
}
|
}
|
}
|
else
|
else
|
{
|
{
|
int is_access = false;
|
int is_access = false;
|
unsigned int quals = TYPE_QUALS (TREE_TYPE (node));
|
unsigned int quals = TYPE_QUALS (TREE_TYPE (node));
|
|
|
if (name_only && TYPE_NAME (node))
|
if (name_only && TYPE_NAME (node))
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, TYPE_NAME (node), node, cpp_check,
|
(buffer, TYPE_NAME (node), node, cpp_check,
|
spc, limited_access, true);
|
spc, limited_access, true);
|
else if (VOID_TYPE_P (TREE_TYPE (node)))
|
else if (VOID_TYPE_P (TREE_TYPE (node)))
|
{
|
{
|
if (!name_only)
|
if (!name_only)
|
pp_string (buffer, "new ");
|
pp_string (buffer, "new ");
|
if (package_prefix)
|
if (package_prefix)
|
{
|
{
|
append_withs ("System", false);
|
append_withs ("System", false);
|
pp_string (buffer, "System.Address");
|
pp_string (buffer, "System.Address");
|
}
|
}
|
else
|
else
|
pp_string (buffer, "address");
|
pp_string (buffer, "address");
|
}
|
}
|
else
|
else
|
{
|
{
|
if (TREE_CODE (node) == POINTER_TYPE
|
if (TREE_CODE (node) == POINTER_TYPE
|
&& TREE_CODE (TREE_TYPE (node)) == INTEGER_TYPE
|
&& TREE_CODE (TREE_TYPE (node)) == INTEGER_TYPE
|
&& !strcmp
|
&& !strcmp
|
(IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME
|
(IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME
|
(TREE_TYPE (node)))), "char"))
|
(TREE_TYPE (node)))), "char"))
|
{
|
{
|
if (!name_only)
|
if (!name_only)
|
pp_string (buffer, "new ");
|
pp_string (buffer, "new ");
|
|
|
if (package_prefix)
|
if (package_prefix)
|
{
|
{
|
pp_string (buffer, "Interfaces.C.Strings.chars_ptr");
|
pp_string (buffer, "Interfaces.C.Strings.chars_ptr");
|
append_withs ("Interfaces.C.Strings", false);
|
append_withs ("Interfaces.C.Strings", false);
|
}
|
}
|
else
|
else
|
pp_string (buffer, "chars_ptr");
|
pp_string (buffer, "chars_ptr");
|
}
|
}
|
else
|
else
|
{
|
{
|
/* For now, handle all access-to-access or
|
/* For now, handle all access-to-access or
|
access-to-unknown-structs as opaque system.address. */
|
access-to-unknown-structs as opaque system.address. */
|
|
|
tree type_name = TYPE_NAME (TREE_TYPE (node));
|
tree type_name = TYPE_NAME (TREE_TYPE (node));
|
const_tree typ2 = !type ||
|
const_tree typ2 = !type ||
|
DECL_P (type) ? type : TYPE_NAME (type);
|
DECL_P (type) ? type : TYPE_NAME (type);
|
const_tree underlying_type =
|
const_tree underlying_type =
|
get_underlying_decl (TREE_TYPE (node));
|
get_underlying_decl (TREE_TYPE (node));
|
|
|
if (TREE_CODE (TREE_TYPE (node)) == POINTER_TYPE
|
if (TREE_CODE (TREE_TYPE (node)) == POINTER_TYPE
|
/* Pointer to pointer. */
|
/* Pointer to pointer. */
|
|
|
|| (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node))
|
|| (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node))
|
&& (!underlying_type
|
&& (!underlying_type
|
|| !TYPE_FIELDS (TREE_TYPE (underlying_type))))
|
|| !TYPE_FIELDS (TREE_TYPE (underlying_type))))
|
/* Pointer to opaque structure. */
|
/* Pointer to opaque structure. */
|
|
|
|| underlying_type == NULL_TREE
|
|| underlying_type == NULL_TREE
|
|| (!typ2
|
|| (!typ2
|
&& !TREE_VISITED (underlying_type)
|
&& !TREE_VISITED (underlying_type)
|
&& !TREE_VISITED (type_name)
|
&& !TREE_VISITED (type_name)
|
&& !is_tagged_type (TREE_TYPE (node))
|
&& !is_tagged_type (TREE_TYPE (node))
|
&& DECL_SOURCE_FILE (underlying_type)
|
&& DECL_SOURCE_FILE (underlying_type)
|
== source_file_base)
|
== source_file_base)
|
|| (type_name && typ2
|
|| (type_name && typ2
|
&& DECL_P (underlying_type)
|
&& DECL_P (underlying_type)
|
&& DECL_P (typ2)
|
&& DECL_P (typ2)
|
&& decl_sloc (underlying_type, true)
|
&& decl_sloc (underlying_type, true)
|
> decl_sloc (typ2, true)
|
> decl_sloc (typ2, true)
|
&& DECL_SOURCE_FILE (underlying_type)
|
&& DECL_SOURCE_FILE (underlying_type)
|
== DECL_SOURCE_FILE (typ2)))
|
== DECL_SOURCE_FILE (typ2)))
|
{
|
{
|
if (package_prefix)
|
if (package_prefix)
|
{
|
{
|
append_withs ("System", false);
|
append_withs ("System", false);
|
if (!name_only)
|
if (!name_only)
|
pp_string (buffer, "new ");
|
pp_string (buffer, "new ");
|
pp_string (buffer, "System.Address");
|
pp_string (buffer, "System.Address");
|
}
|
}
|
else
|
else
|
pp_string (buffer, "address");
|
pp_string (buffer, "address");
|
return spc;
|
return spc;
|
}
|
}
|
|
|
if (!package_prefix)
|
if (!package_prefix)
|
pp_string (buffer, "access");
|
pp_string (buffer, "access");
|
else if (AGGREGATE_TYPE_P (TREE_TYPE (node)))
|
else if (AGGREGATE_TYPE_P (TREE_TYPE (node)))
|
{
|
{
|
if (!type || TREE_CODE (type) != FUNCTION_DECL)
|
if (!type || TREE_CODE (type) != FUNCTION_DECL)
|
{
|
{
|
pp_string (buffer, "access ");
|
pp_string (buffer, "access ");
|
is_access = true;
|
is_access = true;
|
|
|
if (quals & TYPE_QUAL_CONST)
|
if (quals & TYPE_QUAL_CONST)
|
pp_string (buffer, "constant ");
|
pp_string (buffer, "constant ");
|
else if (!name_only)
|
else if (!name_only)
|
pp_string (buffer, "all ");
|
pp_string (buffer, "all ");
|
}
|
}
|
else if (quals & TYPE_QUAL_CONST)
|
else if (quals & TYPE_QUAL_CONST)
|
pp_string (buffer, "in ");
|
pp_string (buffer, "in ");
|
else if (in_function)
|
else if (in_function)
|
{
|
{
|
is_access = true;
|
is_access = true;
|
pp_string (buffer, "access ");
|
pp_string (buffer, "access ");
|
}
|
}
|
else
|
else
|
{
|
{
|
is_access = true;
|
is_access = true;
|
pp_string (buffer, "access ");
|
pp_string (buffer, "access ");
|
/* ??? should be configurable: access or in out. */
|
/* ??? should be configurable: access or in out. */
|
}
|
}
|
}
|
}
|
else
|
else
|
{
|
{
|
is_access = true;
|
is_access = true;
|
pp_string (buffer, "access ");
|
pp_string (buffer, "access ");
|
|
|
if (!name_only)
|
if (!name_only)
|
pp_string (buffer, "all ");
|
pp_string (buffer, "all ");
|
}
|
}
|
|
|
if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node))
|
if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node))
|
&& type_name != NULL_TREE)
|
&& type_name != NULL_TREE)
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, type_name,
|
(buffer, type_name,
|
TREE_TYPE (node), cpp_check, spc, is_access, true);
|
TREE_TYPE (node), cpp_check, spc, is_access, true);
|
else
|
else
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, TREE_TYPE (node), TREE_TYPE (node),
|
(buffer, TREE_TYPE (node), TREE_TYPE (node),
|
cpp_check, spc, 0, true);
|
cpp_check, spc, 0, true);
|
}
|
}
|
}
|
}
|
}
|
}
|
break;
|
break;
|
|
|
case ARRAY_TYPE:
|
case ARRAY_TYPE:
|
if (name_only)
|
if (name_only)
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, TYPE_NAME (node), node, cpp_check,
|
(buffer, TYPE_NAME (node), node, cpp_check,
|
spc, limited_access, true);
|
spc, limited_access, true);
|
else
|
else
|
dump_ada_array_type (buffer, node, spc);
|
dump_ada_array_type (buffer, node, spc);
|
break;
|
break;
|
|
|
case RECORD_TYPE:
|
case RECORD_TYPE:
|
case UNION_TYPE:
|
case UNION_TYPE:
|
case QUAL_UNION_TYPE:
|
case QUAL_UNION_TYPE:
|
if (name_only)
|
if (name_only)
|
{
|
{
|
if (TYPE_NAME (node))
|
if (TYPE_NAME (node))
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, TYPE_NAME (node), node, cpp_check,
|
(buffer, TYPE_NAME (node), node, cpp_check,
|
spc, limited_access, true);
|
spc, limited_access, true);
|
else
|
else
|
{
|
{
|
pp_string (buffer, "anon_");
|
pp_string (buffer, "anon_");
|
pp_scalar (buffer, "%d", TYPE_UID (node));
|
pp_scalar (buffer, "%d", TYPE_UID (node));
|
}
|
}
|
}
|
}
|
else
|
else
|
print_ada_struct_decl
|
print_ada_struct_decl
|
(buffer, node, type, cpp_check, spc, true);
|
(buffer, node, type, cpp_check, spc, true);
|
break;
|
break;
|
|
|
case INTEGER_CST:
|
case INTEGER_CST:
|
if (TREE_CODE (TREE_TYPE (node)) == POINTER_TYPE)
|
if (TREE_CODE (TREE_TYPE (node)) == POINTER_TYPE)
|
{
|
{
|
pp_wide_integer (buffer, TREE_INT_CST_LOW (node));
|
pp_wide_integer (buffer, TREE_INT_CST_LOW (node));
|
pp_string (buffer, "B"); /* pseudo-unit */
|
pp_string (buffer, "B"); /* pseudo-unit */
|
}
|
}
|
else if (!host_integerp (node, 0))
|
else if (!host_integerp (node, 0))
|
{
|
{
|
tree val = node;
|
tree val = node;
|
unsigned HOST_WIDE_INT low = TREE_INT_CST_LOW (val);
|
unsigned HOST_WIDE_INT low = TREE_INT_CST_LOW (val);
|
HOST_WIDE_INT high = TREE_INT_CST_HIGH (val);
|
HOST_WIDE_INT high = TREE_INT_CST_HIGH (val);
|
|
|
if (tree_int_cst_sgn (val) < 0)
|
if (tree_int_cst_sgn (val) < 0)
|
{
|
{
|
pp_character (buffer, '-');
|
pp_character (buffer, '-');
|
high = ~high + !low;
|
high = ~high + !low;
|
low = -low;
|
low = -low;
|
}
|
}
|
sprintf (pp_buffer (buffer)->digit_buffer,
|
sprintf (pp_buffer (buffer)->digit_buffer,
|
HOST_WIDE_INT_PRINT_DOUBLE_HEX,
|
HOST_WIDE_INT_PRINT_DOUBLE_HEX,
|
(unsigned HOST_WIDE_INT) high, low);
|
(unsigned HOST_WIDE_INT) high, low);
|
pp_string (buffer, pp_buffer (buffer)->digit_buffer);
|
pp_string (buffer, pp_buffer (buffer)->digit_buffer);
|
}
|
}
|
else
|
else
|
pp_wide_integer (buffer, TREE_INT_CST_LOW (node));
|
pp_wide_integer (buffer, TREE_INT_CST_LOW (node));
|
break;
|
break;
|
|
|
case REAL_CST:
|
case REAL_CST:
|
case FIXED_CST:
|
case FIXED_CST:
|
case COMPLEX_CST:
|
case COMPLEX_CST:
|
case STRING_CST:
|
case STRING_CST:
|
case VECTOR_CST:
|
case VECTOR_CST:
|
return 0;
|
return 0;
|
|
|
case FUNCTION_DECL:
|
case FUNCTION_DECL:
|
case CONST_DECL:
|
case CONST_DECL:
|
dump_ada_decl_name (buffer, node, limited_access);
|
dump_ada_decl_name (buffer, node, limited_access);
|
break;
|
break;
|
|
|
case TYPE_DECL:
|
case TYPE_DECL:
|
if (DECL_IS_BUILTIN (node))
|
if (DECL_IS_BUILTIN (node))
|
{
|
{
|
/* Don't print the declaration of built-in types. */
|
/* Don't print the declaration of built-in types. */
|
|
|
if (name_only)
|
if (name_only)
|
{
|
{
|
/* If we're in the middle of a declaration, defaults to
|
/* If we're in the middle of a declaration, defaults to
|
System.Address. */
|
System.Address. */
|
if (package_prefix)
|
if (package_prefix)
|
{
|
{
|
append_withs ("System", false);
|
append_withs ("System", false);
|
pp_string (buffer, "System.Address");
|
pp_string (buffer, "System.Address");
|
}
|
}
|
else
|
else
|
pp_string (buffer, "address");
|
pp_string (buffer, "address");
|
}
|
}
|
break;
|
break;
|
}
|
}
|
|
|
if (name_only)
|
if (name_only)
|
dump_ada_decl_name (buffer, node, limited_access);
|
dump_ada_decl_name (buffer, node, limited_access);
|
else
|
else
|
{
|
{
|
if (is_tagged_type (TREE_TYPE (node)))
|
if (is_tagged_type (TREE_TYPE (node)))
|
{
|
{
|
tree tmp = TYPE_FIELDS (TREE_TYPE (node));
|
tree tmp = TYPE_FIELDS (TREE_TYPE (node));
|
int first = 1;
|
int first = 1;
|
|
|
/* Look for ancestors. */
|
/* Look for ancestors. */
|
for (; tmp; tmp = TREE_CHAIN (tmp))
|
for (; tmp; tmp = TREE_CHAIN (tmp))
|
{
|
{
|
if (!DECL_NAME (tmp) && is_tagged_type (TREE_TYPE (tmp)))
|
if (!DECL_NAME (tmp) && is_tagged_type (TREE_TYPE (tmp)))
|
{
|
{
|
if (first)
|
if (first)
|
{
|
{
|
pp_string (buffer, "limited new ");
|
pp_string (buffer, "limited new ");
|
first = 0;
|
first = 0;
|
}
|
}
|
else
|
else
|
pp_string (buffer, " and ");
|
pp_string (buffer, " and ");
|
|
|
dump_ada_decl_name
|
dump_ada_decl_name
|
(buffer, TYPE_NAME (TREE_TYPE (tmp)), false);
|
(buffer, TYPE_NAME (TREE_TYPE (tmp)), false);
|
}
|
}
|
}
|
}
|
|
|
pp_string (buffer, first ? "tagged limited " : " with ");
|
pp_string (buffer, first ? "tagged limited " : " with ");
|
}
|
}
|
else if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node))
|
else if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node))
|
&& TYPE_METHODS (TREE_TYPE (node)))
|
&& TYPE_METHODS (TREE_TYPE (node)))
|
pp_string (buffer, "limited ");
|
pp_string (buffer, "limited ");
|
|
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, TREE_TYPE (node), type, cpp_check, spc, false, false);
|
(buffer, TREE_TYPE (node), type, cpp_check, spc, false, false);
|
}
|
}
|
break;
|
break;
|
|
|
case VAR_DECL:
|
case VAR_DECL:
|
case PARM_DECL:
|
case PARM_DECL:
|
case FIELD_DECL:
|
case FIELD_DECL:
|
case NAMESPACE_DECL:
|
case NAMESPACE_DECL:
|
dump_ada_decl_name (buffer, node, false);
|
dump_ada_decl_name (buffer, node, false);
|
break;
|
break;
|
|
|
default:
|
default:
|
/* Ignore other nodes (e.g. expressions). */
|
/* Ignore other nodes (e.g. expressions). */
|
return 0;
|
return 0;
|
}
|
}
|
|
|
return 1;
|
return 1;
|
}
|
}
|
|
|
/* Dump in BUFFER NODE's methods. CPP_CHECK is used to perform C++ queries on
|
/* Dump in BUFFER NODE's methods. CPP_CHECK is used to perform C++ queries on
|
nodes. SPC is the indentation level. */
|
nodes. SPC is the indentation level. */
|
|
|
static void
|
static void
|
print_ada_methods (pretty_printer *buffer, tree node,
|
print_ada_methods (pretty_printer *buffer, tree node,
|
int (*cpp_check)(tree, cpp_operation), int spc)
|
int (*cpp_check)(tree, cpp_operation), int spc)
|
{
|
{
|
tree tmp = TYPE_METHODS (node);
|
tree tmp = TYPE_METHODS (node);
|
int res = 1;
|
int res = 1;
|
|
|
if (tmp)
|
if (tmp)
|
{
|
{
|
pp_semicolon (buffer);
|
pp_semicolon (buffer);
|
|
|
for (; tmp; tmp = TREE_CHAIN (tmp))
|
for (; tmp; tmp = TREE_CHAIN (tmp))
|
{
|
{
|
if (res)
|
if (res)
|
{
|
{
|
pp_newline (buffer);
|
pp_newline (buffer);
|
pp_newline (buffer);
|
pp_newline (buffer);
|
}
|
}
|
res = print_ada_declaration (buffer, tmp, node, cpp_check, spc);
|
res = print_ada_declaration (buffer, tmp, node, cpp_check, spc);
|
}
|
}
|
}
|
}
|
}
|
}
|
|
|
/* Dump in BUFFER anonymous types nested inside T's definition.
|
/* Dump in BUFFER anonymous types nested inside T's definition.
|
PARENT is the parent node of T.
|
PARENT is the parent node of T.
|
FORWARD indicates whether a forward declaration of T should be generated.
|
FORWARD indicates whether a forward declaration of T should be generated.
|
CPP_CHECK is used to perform C++ queries on
|
CPP_CHECK is used to perform C++ queries on
|
nodes. SPC is the indentation level. */
|
nodes. SPC is the indentation level. */
|
|
|
static void
|
static void
|
dump_nested_types (pretty_printer *buffer, tree t, tree parent, bool forward,
|
dump_nested_types (pretty_printer *buffer, tree t, tree parent, bool forward,
|
int (*cpp_check)(tree, cpp_operation), int spc)
|
int (*cpp_check)(tree, cpp_operation), int spc)
|
{
|
{
|
tree field, outer, decl;
|
tree field, outer, decl;
|
|
|
/* Avoid recursing over the same tree. */
|
/* Avoid recursing over the same tree. */
|
if (TREE_VISITED (t))
|
if (TREE_VISITED (t))
|
return;
|
return;
|
|
|
/* Find possible anonymous arrays/unions/structs recursively. */
|
/* Find possible anonymous arrays/unions/structs recursively. */
|
|
|
outer = TREE_TYPE (t);
|
outer = TREE_TYPE (t);
|
|
|
if (outer == NULL_TREE)
|
if (outer == NULL_TREE)
|
return;
|
return;
|
|
|
if (forward)
|
if (forward)
|
{
|
{
|
pp_string (buffer, "type ");
|
pp_string (buffer, "type ");
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, t, t, cpp_check, spc, false, true);
|
(buffer, t, t, cpp_check, spc, false, true);
|
pp_semicolon (buffer);
|
pp_semicolon (buffer);
|
newline_and_indent (buffer, spc);
|
newline_and_indent (buffer, spc);
|
TREE_VISITED (t) = 1;
|
TREE_VISITED (t) = 1;
|
}
|
}
|
|
|
field = TYPE_FIELDS (outer);
|
field = TYPE_FIELDS (outer);
|
while (field)
|
while (field)
|
{
|
{
|
if ((TREE_TYPE (field) != outer
|
if ((TREE_TYPE (field) != outer
|
|| (TREE_CODE (TREE_TYPE (field)) == POINTER_TYPE
|
|| (TREE_CODE (TREE_TYPE (field)) == POINTER_TYPE
|
&& TREE_TYPE (TREE_TYPE (field)) != outer))
|
&& TREE_TYPE (TREE_TYPE (field)) != outer))
|
&& (!TYPE_NAME (TREE_TYPE (field))
|
&& (!TYPE_NAME (TREE_TYPE (field))
|
|| (TREE_CODE (field) == TYPE_DECL
|
|| (TREE_CODE (field) == TYPE_DECL
|
&& DECL_NAME (field) != DECL_NAME (t)
|
&& DECL_NAME (field) != DECL_NAME (t)
|
&& TYPE_NAME (TREE_TYPE (field)) != TYPE_NAME (outer))))
|
&& TYPE_NAME (TREE_TYPE (field)) != TYPE_NAME (outer))))
|
{
|
{
|
switch (TREE_CODE (TREE_TYPE (field)))
|
switch (TREE_CODE (TREE_TYPE (field)))
|
{
|
{
|
case POINTER_TYPE:
|
case POINTER_TYPE:
|
decl = TREE_TYPE (TREE_TYPE (field));
|
decl = TREE_TYPE (TREE_TYPE (field));
|
|
|
if (TREE_CODE (decl) == FUNCTION_TYPE)
|
if (TREE_CODE (decl) == FUNCTION_TYPE)
|
for (decl = TREE_TYPE (decl);
|
for (decl = TREE_TYPE (decl);
|
decl && TREE_CODE (decl) == POINTER_TYPE;
|
decl && TREE_CODE (decl) == POINTER_TYPE;
|
decl = TREE_TYPE (decl))
|
decl = TREE_TYPE (decl))
|
;
|
;
|
|
|
decl = get_underlying_decl (decl);
|
decl = get_underlying_decl (decl);
|
|
|
if (decl
|
if (decl
|
&& DECL_P (decl)
|
&& DECL_P (decl)
|
&& decl_sloc (decl, true) > decl_sloc (t, true)
|
&& decl_sloc (decl, true) > decl_sloc (t, true)
|
&& DECL_SOURCE_FILE (decl) == DECL_SOURCE_FILE (t)
|
&& DECL_SOURCE_FILE (decl) == DECL_SOURCE_FILE (t)
|
&& !TREE_VISITED (decl)
|
&& !TREE_VISITED (decl)
|
&& !DECL_IS_BUILTIN (decl)
|
&& !DECL_IS_BUILTIN (decl)
|
&& (!RECORD_OR_UNION_TYPE_P (TREE_TYPE (decl))
|
&& (!RECORD_OR_UNION_TYPE_P (TREE_TYPE (decl))
|
|| TYPE_FIELDS (TREE_TYPE (decl))))
|
|| TYPE_FIELDS (TREE_TYPE (decl))))
|
{
|
{
|
/* Generate forward declaration. */
|
/* Generate forward declaration. */
|
|
|
pp_string (buffer, "type ");
|
pp_string (buffer, "type ");
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, decl, 0, cpp_check, spc, false, true);
|
(buffer, decl, 0, cpp_check, spc, false, true);
|
pp_semicolon (buffer);
|
pp_semicolon (buffer);
|
newline_and_indent (buffer, spc);
|
newline_and_indent (buffer, spc);
|
|
|
/* Ensure we do not generate duplicate forward
|
/* Ensure we do not generate duplicate forward
|
declarations for this type. */
|
declarations for this type. */
|
TREE_VISITED (decl) = 1;
|
TREE_VISITED (decl) = 1;
|
}
|
}
|
break;
|
break;
|
|
|
case ARRAY_TYPE:
|
case ARRAY_TYPE:
|
/* Special case char arrays. */
|
/* Special case char arrays. */
|
if (is_char_array (field))
|
if (is_char_array (field))
|
pp_string (buffer, "sub");
|
pp_string (buffer, "sub");
|
|
|
pp_string (buffer, "type ");
|
pp_string (buffer, "type ");
|
dump_ada_double_name (buffer, parent, field, "_array is ");
|
dump_ada_double_name (buffer, parent, field, "_array is ");
|
dump_ada_array_type (buffer, field, spc);
|
dump_ada_array_type (buffer, field, spc);
|
pp_semicolon (buffer);
|
pp_semicolon (buffer);
|
newline_and_indent (buffer, spc);
|
newline_and_indent (buffer, spc);
|
break;
|
break;
|
|
|
case UNION_TYPE:
|
case UNION_TYPE:
|
TREE_VISITED (t) = 1;
|
TREE_VISITED (t) = 1;
|
dump_nested_types (buffer, field, t, false, cpp_check, spc);
|
dump_nested_types (buffer, field, t, false, cpp_check, spc);
|
|
|
pp_string (buffer, "type ");
|
pp_string (buffer, "type ");
|
|
|
if (TYPE_NAME (TREE_TYPE (field)))
|
if (TYPE_NAME (TREE_TYPE (field)))
|
{
|
{
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, TYPE_NAME (TREE_TYPE (field)), 0, cpp_check,
|
(buffer, TYPE_NAME (TREE_TYPE (field)), 0, cpp_check,
|
spc, false, true);
|
spc, false, true);
|
pp_string (buffer, " (discr : unsigned := 0) is ");
|
pp_string (buffer, " (discr : unsigned := 0) is ");
|
print_ada_struct_decl
|
print_ada_struct_decl
|
(buffer, TREE_TYPE (field), t, cpp_check, spc, false);
|
(buffer, TREE_TYPE (field), t, cpp_check, spc, false);
|
|
|
pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
|
pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, TREE_TYPE (field), 0, cpp_check,
|
(buffer, TREE_TYPE (field), 0, cpp_check,
|
spc, false, true);
|
spc, false, true);
|
pp_string (buffer, ");");
|
pp_string (buffer, ");");
|
newline_and_indent (buffer, spc);
|
newline_and_indent (buffer, spc);
|
|
|
pp_string (buffer, "pragma Unchecked_Union (");
|
pp_string (buffer, "pragma Unchecked_Union (");
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, TREE_TYPE (field), 0, cpp_check,
|
(buffer, TREE_TYPE (field), 0, cpp_check,
|
spc, false, true);
|
spc, false, true);
|
pp_string (buffer, ");");
|
pp_string (buffer, ");");
|
}
|
}
|
else
|
else
|
{
|
{
|
dump_ada_double_name
|
dump_ada_double_name
|
(buffer, parent, field,
|
(buffer, parent, field,
|
"_union (discr : unsigned := 0) is ");
|
"_union (discr : unsigned := 0) is ");
|
print_ada_struct_decl
|
print_ada_struct_decl
|
(buffer, TREE_TYPE (field), t, cpp_check, spc, false);
|
(buffer, TREE_TYPE (field), t, cpp_check, spc, false);
|
pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
|
pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
|
dump_ada_double_name (buffer, parent, field, "_union);");
|
dump_ada_double_name (buffer, parent, field, "_union);");
|
newline_and_indent (buffer, spc);
|
newline_and_indent (buffer, spc);
|
|
|
pp_string (buffer, "pragma Unchecked_Union (");
|
pp_string (buffer, "pragma Unchecked_Union (");
|
dump_ada_double_name (buffer, parent, field, "_union);");
|
dump_ada_double_name (buffer, parent, field, "_union);");
|
}
|
}
|
|
|
newline_and_indent (buffer, spc);
|
newline_and_indent (buffer, spc);
|
break;
|
break;
|
|
|
case RECORD_TYPE:
|
case RECORD_TYPE:
|
if (TYPE_NAME (TREE_TYPE (t)) && !TREE_VISITED (t))
|
if (TYPE_NAME (TREE_TYPE (t)) && !TREE_VISITED (t))
|
{
|
{
|
pp_string (buffer, "type ");
|
pp_string (buffer, "type ");
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, t, parent, 0, spc, false, true);
|
(buffer, t, parent, 0, spc, false, true);
|
pp_semicolon (buffer);
|
pp_semicolon (buffer);
|
newline_and_indent (buffer, spc);
|
newline_and_indent (buffer, spc);
|
}
|
}
|
|
|
TREE_VISITED (t) = 1;
|
TREE_VISITED (t) = 1;
|
dump_nested_types (buffer, field, t, false, cpp_check, spc);
|
dump_nested_types (buffer, field, t, false, cpp_check, spc);
|
pp_string (buffer, "type ");
|
pp_string (buffer, "type ");
|
|
|
if (TYPE_NAME (TREE_TYPE (field)))
|
if (TYPE_NAME (TREE_TYPE (field)))
|
{
|
{
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, TREE_TYPE (field), 0, cpp_check,
|
(buffer, TREE_TYPE (field), 0, cpp_check,
|
spc, false, true);
|
spc, false, true);
|
pp_string (buffer, " is ");
|
pp_string (buffer, " is ");
|
print_ada_struct_decl
|
print_ada_struct_decl
|
(buffer, TREE_TYPE (field), t, cpp_check, spc, false);
|
(buffer, TREE_TYPE (field), t, cpp_check, spc, false);
|
pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
|
pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, TREE_TYPE (field), 0, cpp_check,
|
(buffer, TREE_TYPE (field), 0, cpp_check,
|
spc, false, true);
|
spc, false, true);
|
pp_string (buffer, ");");
|
pp_string (buffer, ");");
|
}
|
}
|
else
|
else
|
{
|
{
|
dump_ada_double_name
|
dump_ada_double_name
|
(buffer, parent, field, "_struct is ");
|
(buffer, parent, field, "_struct is ");
|
print_ada_struct_decl
|
print_ada_struct_decl
|
(buffer, TREE_TYPE (field), t, cpp_check, spc, false);
|
(buffer, TREE_TYPE (field), t, cpp_check, spc, false);
|
pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
|
pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
|
dump_ada_double_name (buffer, parent, field, "_struct);");
|
dump_ada_double_name (buffer, parent, field, "_struct);");
|
}
|
}
|
|
|
newline_and_indent (buffer, spc);
|
newline_and_indent (buffer, spc);
|
break;
|
break;
|
|
|
default:
|
default:
|
break;
|
break;
|
}
|
}
|
}
|
}
|
field = TREE_CHAIN (field);
|
field = TREE_CHAIN (field);
|
}
|
}
|
|
|
TREE_VISITED (t) = 1;
|
TREE_VISITED (t) = 1;
|
}
|
}
|
|
|
/* Dump in BUFFER destructor spec corresponding to T. */
|
/* Dump in BUFFER destructor spec corresponding to T. */
|
|
|
static void
|
static void
|
print_destructor (pretty_printer *buffer, tree t)
|
print_destructor (pretty_printer *buffer, tree t)
|
{
|
{
|
const char *s = IDENTIFIER_POINTER (DECL_NAME (t));
|
const char *s = IDENTIFIER_POINTER (DECL_NAME (t));
|
|
|
if (*s == '_')
|
if (*s == '_')
|
for (s += 2; *s != ' '; s++)
|
for (s += 2; *s != ' '; s++)
|
pp_character (buffer, *s);
|
pp_character (buffer, *s);
|
else
|
else
|
{
|
{
|
pp_string (buffer, "Delete_");
|
pp_string (buffer, "Delete_");
|
pp_ada_tree_identifier (buffer, DECL_NAME (t), t, false);
|
pp_ada_tree_identifier (buffer, DECL_NAME (t), t, false);
|
}
|
}
|
}
|
}
|
|
|
/* Return the name of type T. */
|
/* Return the name of type T. */
|
|
|
static const char *
|
static const char *
|
type_name (tree t)
|
type_name (tree t)
|
{
|
{
|
tree n = TYPE_NAME (t);
|
tree n = TYPE_NAME (t);
|
|
|
if (TREE_CODE (n) == IDENTIFIER_NODE)
|
if (TREE_CODE (n) == IDENTIFIER_NODE)
|
return IDENTIFIER_POINTER (n);
|
return IDENTIFIER_POINTER (n);
|
else
|
else
|
return IDENTIFIER_POINTER (DECL_NAME (n));
|
return IDENTIFIER_POINTER (DECL_NAME (n));
|
}
|
}
|
|
|
/* Print in BUFFER the declaration of a variable T of type TYPE in Ada syntax.
|
/* 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
|
CPP_CHECK is used to perform C++ queries on nodes. SPC is the indentation
|
level. Return 1 if a declaration was printed, 0 otherwise. */
|
level. Return 1 if a declaration was printed, 0 otherwise. */
|
|
|
static int
|
static int
|
print_ada_declaration (pretty_printer *buffer, tree t, tree type,
|
print_ada_declaration (pretty_printer *buffer, tree t, tree type,
|
int (*cpp_check)(tree, cpp_operation), int spc)
|
int (*cpp_check)(tree, cpp_operation), int spc)
|
{
|
{
|
int is_var = 0, need_indent = 0;
|
int is_var = 0, need_indent = 0;
|
int is_class = false;
|
int is_class = false;
|
tree name = TYPE_NAME (TREE_TYPE (t));
|
tree name = TYPE_NAME (TREE_TYPE (t));
|
tree decl_name = DECL_NAME (t);
|
tree decl_name = DECL_NAME (t);
|
bool dump_internal = get_dump_file_info (TDI_ada)->flags & TDF_RAW;
|
bool dump_internal = get_dump_file_info (TDI_ada)->flags & TDF_RAW;
|
tree orig = NULL_TREE;
|
tree orig = NULL_TREE;
|
|
|
if (cpp_check && cpp_check (t, IS_TEMPLATE))
|
if (cpp_check && cpp_check (t, IS_TEMPLATE))
|
return dump_ada_template (buffer, t, cpp_check, spc);
|
return dump_ada_template (buffer, t, cpp_check, spc);
|
|
|
if (TREE_CODE (t) == CONST_DECL && TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE)
|
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. */
|
/* Skip enumeral values: will be handled as part of the type itself. */
|
return 0;
|
return 0;
|
|
|
if (TREE_CODE (t) == TYPE_DECL)
|
if (TREE_CODE (t) == TYPE_DECL)
|
{
|
{
|
orig = DECL_ORIGINAL_TYPE (t);
|
orig = DECL_ORIGINAL_TYPE (t);
|
|
|
if (orig && TYPE_STUB_DECL (orig))
|
if (orig && TYPE_STUB_DECL (orig))
|
{
|
{
|
tree stub = TYPE_STUB_DECL (orig);
|
tree stub = TYPE_STUB_DECL (orig);
|
tree typ = TREE_TYPE (stub);
|
tree typ = TREE_TYPE (stub);
|
|
|
if (TYPE_NAME (typ))
|
if (TYPE_NAME (typ))
|
{
|
{
|
/* If types have same representation, and same name (ignoring
|
/* If types have same representation, and same name (ignoring
|
casing), then ignore the second type. */
|
casing), then ignore the second type. */
|
if (type_name (typ) == type_name (TREE_TYPE (t))
|
if (type_name (typ) == type_name (TREE_TYPE (t))
|
|| !strcasecmp (type_name (typ), type_name (TREE_TYPE (t))))
|
|| !strcasecmp (type_name (typ), type_name (TREE_TYPE (t))))
|
return 0;
|
return 0;
|
|
|
INDENT (spc);
|
INDENT (spc);
|
|
|
if (RECORD_OR_UNION_TYPE_P (typ) && !TYPE_FIELDS (typ))
|
if (RECORD_OR_UNION_TYPE_P (typ) && !TYPE_FIELDS (typ))
|
{
|
{
|
pp_string (buffer, "-- skipped empty struct ");
|
pp_string (buffer, "-- skipped empty struct ");
|
dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
|
dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
|
}
|
}
|
else
|
else
|
{
|
{
|
if (!TREE_VISITED (stub)
|
if (!TREE_VISITED (stub)
|
&& DECL_SOURCE_FILE (stub) == source_file_base)
|
&& DECL_SOURCE_FILE (stub) == source_file_base)
|
dump_nested_types
|
dump_nested_types
|
(buffer, stub, stub, true, cpp_check, spc);
|
(buffer, stub, stub, true, cpp_check, spc);
|
|
|
pp_string (buffer, "subtype ");
|
pp_string (buffer, "subtype ");
|
dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
|
dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
|
pp_string (buffer, " is ");
|
pp_string (buffer, " is ");
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, typ, type, 0, spc, false, true);
|
(buffer, typ, type, 0, spc, false, true);
|
pp_semicolon (buffer);
|
pp_semicolon (buffer);
|
}
|
}
|
return 1;
|
return 1;
|
}
|
}
|
}
|
}
|
|
|
/* Skip unnamed or anonymous structs/unions/enum types. */
|
/* Skip unnamed or anonymous structs/unions/enum types. */
|
if (!orig && !decl_name && !name)
|
if (!orig && !decl_name && !name)
|
{
|
{
|
tree tmp;
|
tree tmp;
|
location_t sloc;
|
location_t sloc;
|
|
|
if (cpp_check || TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE)
|
if (cpp_check || TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE)
|
return 0;
|
return 0;
|
|
|
if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t)))
|
if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t)))
|
{
|
{
|
/* Search next items until finding a named type decl. */
|
/* Search next items until finding a named type decl. */
|
sloc = decl_sloc_common (t, true, true);
|
sloc = decl_sloc_common (t, true, true);
|
|
|
for (tmp = TREE_CHAIN (t); tmp; tmp = TREE_CHAIN (tmp))
|
for (tmp = TREE_CHAIN (t); tmp; tmp = TREE_CHAIN (tmp))
|
{
|
{
|
if (TREE_CODE (tmp) == TYPE_DECL
|
if (TREE_CODE (tmp) == TYPE_DECL
|
&& (DECL_NAME (tmp) || TYPE_NAME (TREE_TYPE (tmp))))
|
&& (DECL_NAME (tmp) || TYPE_NAME (TREE_TYPE (tmp))))
|
{
|
{
|
/* If same sloc, it means we can ignore the anonymous
|
/* If same sloc, it means we can ignore the anonymous
|
struct. */
|
struct. */
|
if (decl_sloc_common (tmp, true, true) == sloc)
|
if (decl_sloc_common (tmp, true, true) == sloc)
|
return 0;
|
return 0;
|
else
|
else
|
break;
|
break;
|
}
|
}
|
}
|
}
|
if (tmp == NULL)
|
if (tmp == NULL)
|
return 0;
|
return 0;
|
}
|
}
|
}
|
}
|
|
|
if (!orig
|
if (!orig
|
&& TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE
|
&& TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE
|
&& decl_name
|
&& decl_name
|
&& (*IDENTIFIER_POINTER (decl_name) == '.'
|
&& (*IDENTIFIER_POINTER (decl_name) == '.'
|
|| *IDENTIFIER_POINTER (decl_name) == '$'))
|
|| *IDENTIFIER_POINTER (decl_name) == '$'))
|
/* Skip anonymous enum types (duplicates of real types). */
|
/* Skip anonymous enum types (duplicates of real types). */
|
return 0;
|
return 0;
|
|
|
INDENT (spc);
|
INDENT (spc);
|
|
|
switch (TREE_CODE (TREE_TYPE (t)))
|
switch (TREE_CODE (TREE_TYPE (t)))
|
{
|
{
|
case RECORD_TYPE:
|
case RECORD_TYPE:
|
case UNION_TYPE:
|
case UNION_TYPE:
|
case QUAL_UNION_TYPE:
|
case QUAL_UNION_TYPE:
|
/* Skip empty structs (typically forward references to real
|
/* Skip empty structs (typically forward references to real
|
structs). */
|
structs). */
|
if (!TYPE_FIELDS (TREE_TYPE (t)))
|
if (!TYPE_FIELDS (TREE_TYPE (t)))
|
{
|
{
|
pp_string (buffer, "-- skipped empty struct ");
|
pp_string (buffer, "-- skipped empty struct ");
|
dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
|
dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
|
return 1;
|
return 1;
|
}
|
}
|
|
|
if (decl_name
|
if (decl_name
|
&& (*IDENTIFIER_POINTER (decl_name) == '.'
|
&& (*IDENTIFIER_POINTER (decl_name) == '.'
|
|| *IDENTIFIER_POINTER (decl_name) == '$'))
|
|| *IDENTIFIER_POINTER (decl_name) == '$'))
|
{
|
{
|
pp_string (buffer, "-- skipped anonymous struct ");
|
pp_string (buffer, "-- skipped anonymous struct ");
|
dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
|
dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
|
TREE_VISITED (t) = 1;
|
TREE_VISITED (t) = 1;
|
return 1;
|
return 1;
|
}
|
}
|
|
|
if (orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
|
if (orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
|
pp_string (buffer, "subtype ");
|
pp_string (buffer, "subtype ");
|
else
|
else
|
{
|
{
|
dump_nested_types (buffer, t, t, false, cpp_check, spc);
|
dump_nested_types (buffer, t, t, false, cpp_check, spc);
|
|
|
if (separate_class_package (t))
|
if (separate_class_package (t))
|
{
|
{
|
is_class = true;
|
is_class = true;
|
pp_string (buffer, "package Class_");
|
pp_string (buffer, "package Class_");
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, t, type, 0, spc, false, true);
|
(buffer, t, type, 0, spc, false, true);
|
pp_string (buffer, " is");
|
pp_string (buffer, " is");
|
spc += INDENT_INCR;
|
spc += INDENT_INCR;
|
newline_and_indent (buffer, spc);
|
newline_and_indent (buffer, spc);
|
}
|
}
|
|
|
pp_string (buffer, "type ");
|
pp_string (buffer, "type ");
|
}
|
}
|
break;
|
break;
|
|
|
case ARRAY_TYPE:
|
case ARRAY_TYPE:
|
case POINTER_TYPE:
|
case POINTER_TYPE:
|
case REFERENCE_TYPE:
|
case REFERENCE_TYPE:
|
if ((orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
|
if ((orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
|
|| is_char_array (t))
|
|| is_char_array (t))
|
pp_string (buffer, "subtype ");
|
pp_string (buffer, "subtype ");
|
else
|
else
|
pp_string (buffer, "type ");
|
pp_string (buffer, "type ");
|
break;
|
break;
|
|
|
case FUNCTION_TYPE:
|
case FUNCTION_TYPE:
|
pp_string (buffer, "-- skipped 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, 0, spc, false, true);
|
return 1;
|
return 1;
|
break;
|
break;
|
|
|
case ENUMERAL_TYPE:
|
case ENUMERAL_TYPE:
|
if ((orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
|
if ((orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
|
|| !is_simple_enum (TREE_TYPE (t)))
|
|| !is_simple_enum (TREE_TYPE (t)))
|
pp_string (buffer, "subtype ");
|
pp_string (buffer, "subtype ");
|
else
|
else
|
pp_string (buffer, "type ");
|
pp_string (buffer, "type ");
|
break;
|
break;
|
|
|
default:
|
default:
|
pp_string (buffer, "subtype ");
|
pp_string (buffer, "subtype ");
|
}
|
}
|
TREE_VISITED (t) = 1;
|
TREE_VISITED (t) = 1;
|
}
|
}
|
else
|
else
|
{
|
{
|
if (!dump_internal
|
if (!dump_internal
|
&& TREE_CODE (t) == VAR_DECL
|
&& TREE_CODE (t) == VAR_DECL
|
&& decl_name
|
&& decl_name
|
&& *IDENTIFIER_POINTER (decl_name) == '_')
|
&& *IDENTIFIER_POINTER (decl_name) == '_')
|
return 0;
|
return 0;
|
|
|
need_indent = 1;
|
need_indent = 1;
|
}
|
}
|
|
|
/* Print the type and name. */
|
/* Print the type and name. */
|
if (TREE_CODE (TREE_TYPE (t)) == ARRAY_TYPE)
|
if (TREE_CODE (TREE_TYPE (t)) == ARRAY_TYPE)
|
{
|
{
|
if (need_indent)
|
if (need_indent)
|
INDENT (spc);
|
INDENT (spc);
|
|
|
/* Print variable's name. */
|
/* Print variable's name. */
|
dump_generic_ada_node (buffer, t, type, cpp_check, spc, false, true);
|
dump_generic_ada_node (buffer, t, type, cpp_check, spc, false, true);
|
|
|
if (TREE_CODE (t) == TYPE_DECL)
|
if (TREE_CODE (t) == TYPE_DECL)
|
{
|
{
|
pp_string (buffer, " is ");
|
pp_string (buffer, " is ");
|
|
|
if (orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
|
if (orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, TYPE_NAME (orig), type,
|
(buffer, TYPE_NAME (orig), type,
|
cpp_check, spc, false, true);
|
cpp_check, spc, false, true);
|
else
|
else
|
dump_ada_array_type (buffer, t, spc);
|
dump_ada_array_type (buffer, t, spc);
|
}
|
}
|
else
|
else
|
{
|
{
|
tree tmp = TYPE_NAME (TREE_TYPE (t));
|
tree tmp = TYPE_NAME (TREE_TYPE (t));
|
|
|
if (spc == INDENT_INCR || TREE_STATIC (t))
|
if (spc == INDENT_INCR || TREE_STATIC (t))
|
is_var = 1;
|
is_var = 1;
|
|
|
pp_string (buffer, " : ");
|
pp_string (buffer, " : ");
|
|
|
if (tmp)
|
if (tmp)
|
{
|
{
|
if (TREE_CODE (TREE_TYPE (tmp)) != POINTER_TYPE
|
if (TREE_CODE (TREE_TYPE (tmp)) != POINTER_TYPE
|
&& TREE_CODE (tmp) != INTEGER_TYPE)
|
&& TREE_CODE (tmp) != INTEGER_TYPE)
|
pp_string (buffer, "aliased ");
|
pp_string (buffer, "aliased ");
|
|
|
dump_generic_ada_node (buffer, tmp, type, 0, spc, false, true);
|
dump_generic_ada_node (buffer, tmp, type, 0, spc, false, true);
|
}
|
}
|
else
|
else
|
{
|
{
|
pp_string (buffer, "aliased ");
|
pp_string (buffer, "aliased ");
|
|
|
if (!type)
|
if (!type)
|
dump_ada_array_type (buffer, t, spc);
|
dump_ada_array_type (buffer, t, spc);
|
else
|
else
|
dump_ada_double_name (buffer, type, t, "_array");
|
dump_ada_double_name (buffer, type, t, "_array");
|
}
|
}
|
}
|
}
|
}
|
}
|
else if (TREE_CODE (t) == FUNCTION_DECL)
|
else if (TREE_CODE (t) == FUNCTION_DECL)
|
{
|
{
|
bool is_function = true, is_method, is_abstract_class = false;
|
bool is_function = true, is_method, is_abstract_class = false;
|
tree decl_name = DECL_NAME (t);
|
tree decl_name = DECL_NAME (t);
|
int prev_in_function = in_function;
|
int prev_in_function = in_function;
|
bool is_abstract = false;
|
bool is_abstract = false;
|
bool is_constructor = false;
|
bool is_constructor = false;
|
bool is_destructor = false;
|
bool is_destructor = false;
|
bool is_copy_constructor = false;
|
bool is_copy_constructor = false;
|
|
|
if (!decl_name)
|
if (!decl_name)
|
return 0;
|
return 0;
|
|
|
if (cpp_check)
|
if (cpp_check)
|
{
|
{
|
is_abstract = cpp_check (t, IS_ABSTRACT);
|
is_abstract = cpp_check (t, IS_ABSTRACT);
|
is_constructor = cpp_check (t, IS_CONSTRUCTOR);
|
is_constructor = cpp_check (t, IS_CONSTRUCTOR);
|
is_destructor = cpp_check (t, IS_DESTRUCTOR);
|
is_destructor = cpp_check (t, IS_DESTRUCTOR);
|
is_copy_constructor = cpp_check (t, IS_COPY_CONSTRUCTOR);
|
is_copy_constructor = cpp_check (t, IS_COPY_CONSTRUCTOR);
|
}
|
}
|
|
|
/* Skip __comp_dtor destructor which is redundant with the '~class()'
|
/* Skip __comp_dtor destructor which is redundant with the '~class()'
|
destructor. */
|
destructor. */
|
if (is_destructor
|
if (is_destructor
|
&& !strncmp (IDENTIFIER_POINTER (decl_name), "__comp", 6))
|
&& !strncmp (IDENTIFIER_POINTER (decl_name), "__comp", 6))
|
return 0;
|
return 0;
|
|
|
/* Skip copy constructors: some are internal only, and those that are
|
/* Skip copy constructors: some are internal only, and those that are
|
not cannot be called easily from Ada anyway. */
|
not cannot be called easily from Ada anyway. */
|
if (is_copy_constructor)
|
if (is_copy_constructor)
|
return 0;
|
return 0;
|
|
|
/* If this function has an entry in the dispatch table, we cannot
|
/* If this function has an entry in the dispatch table, we cannot
|
omit it. */
|
omit it. */
|
if (!dump_internal && !DECL_VINDEX (t)
|
if (!dump_internal && !DECL_VINDEX (t)
|
&& *IDENTIFIER_POINTER (decl_name) == '_')
|
&& *IDENTIFIER_POINTER (decl_name) == '_')
|
{
|
{
|
if (IDENTIFIER_POINTER (decl_name)[1] == '_')
|
if (IDENTIFIER_POINTER (decl_name)[1] == '_')
|
return 0;
|
return 0;
|
|
|
INDENT (spc);
|
INDENT (spc);
|
pp_string (buffer, "-- skipped func ");
|
pp_string (buffer, "-- skipped func ");
|
pp_string (buffer, IDENTIFIER_POINTER (decl_name));
|
pp_string (buffer, IDENTIFIER_POINTER (decl_name));
|
return 1;
|
return 1;
|
}
|
}
|
|
|
if (need_indent)
|
if (need_indent)
|
INDENT (spc);
|
INDENT (spc);
|
|
|
if (is_constructor)
|
if (is_constructor)
|
pp_string (buffer, "function New_");
|
pp_string (buffer, "function New_");
|
else if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t))))
|
else if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t))))
|
{
|
{
|
is_function = false;
|
is_function = false;
|
pp_string (buffer, "procedure ");
|
pp_string (buffer, "procedure ");
|
}
|
}
|
else
|
else
|
pp_string (buffer, "function ");
|
pp_string (buffer, "function ");
|
|
|
in_function = is_function;
|
in_function = is_function;
|
is_method = TREE_CODE (TREE_TYPE (t)) == METHOD_TYPE;
|
is_method = TREE_CODE (TREE_TYPE (t)) == METHOD_TYPE;
|
|
|
if (is_destructor)
|
if (is_destructor)
|
print_destructor (buffer, t);
|
print_destructor (buffer, t);
|
else
|
else
|
dump_ada_decl_name (buffer, t, false);
|
dump_ada_decl_name (buffer, t, false);
|
|
|
dump_ada_function_declaration
|
dump_ada_function_declaration
|
(buffer, t, is_method, is_constructor, is_destructor, spc);
|
(buffer, t, is_method, is_constructor, is_destructor, spc);
|
in_function = prev_in_function;
|
in_function = prev_in_function;
|
|
|
if (is_function)
|
if (is_function)
|
{
|
{
|
pp_string (buffer, " return ");
|
pp_string (buffer, " return ");
|
|
|
if (is_constructor)
|
if (is_constructor)
|
{
|
{
|
dump_ada_decl_name (buffer, t, false);
|
dump_ada_decl_name (buffer, t, false);
|
}
|
}
|
else
|
else
|
{
|
{
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, TREE_TYPE (TREE_TYPE (t)), type, cpp_check,
|
(buffer, TREE_TYPE (TREE_TYPE (t)), type, cpp_check,
|
spc, false, true);
|
spc, false, true);
|
}
|
}
|
}
|
}
|
|
|
if (is_constructor && cpp_check && type
|
if (is_constructor && cpp_check && type
|
&& AGGREGATE_TYPE_P (type)
|
&& AGGREGATE_TYPE_P (type)
|
&& TYPE_METHODS (type))
|
&& TYPE_METHODS (type))
|
{
|
{
|
tree tmp = TYPE_METHODS (type);
|
tree tmp = TYPE_METHODS (type);
|
|
|
for (; tmp; tmp = TREE_CHAIN (tmp))
|
for (; tmp; tmp = TREE_CHAIN (tmp))
|
if (cpp_check (tmp, IS_ABSTRACT))
|
if (cpp_check (tmp, IS_ABSTRACT))
|
{
|
{
|
is_abstract_class = 1;
|
is_abstract_class = 1;
|
break;
|
break;
|
}
|
}
|
}
|
}
|
|
|
if (is_abstract || is_abstract_class)
|
if (is_abstract || is_abstract_class)
|
pp_string (buffer, " is abstract");
|
pp_string (buffer, " is abstract");
|
|
|
pp_semicolon (buffer);
|
pp_semicolon (buffer);
|
pp_string (buffer, " -- ");
|
pp_string (buffer, " -- ");
|
dump_sloc (buffer, t);
|
dump_sloc (buffer, t);
|
|
|
if (is_abstract)
|
if (is_abstract)
|
return 1;
|
return 1;
|
|
|
newline_and_indent (buffer, spc);
|
newline_and_indent (buffer, spc);
|
|
|
if (is_constructor)
|
if (is_constructor)
|
{
|
{
|
pp_string (buffer, "pragma CPP_Constructor (New_");
|
pp_string (buffer, "pragma CPP_Constructor (New_");
|
dump_ada_decl_name (buffer, t, false);
|
dump_ada_decl_name (buffer, t, false);
|
pp_string (buffer, ", \"");
|
pp_string (buffer, ", \"");
|
pp_asm_name (buffer, t);
|
pp_asm_name (buffer, t);
|
pp_string (buffer, "\");");
|
pp_string (buffer, "\");");
|
}
|
}
|
else if (is_destructor)
|
else if (is_destructor)
|
{
|
{
|
pp_string (buffer, "pragma Import (CPP, ");
|
pp_string (buffer, "pragma Import (CPP, ");
|
print_destructor (buffer, t);
|
print_destructor (buffer, t);
|
pp_string (buffer, ", \"");
|
pp_string (buffer, ", \"");
|
pp_asm_name (buffer, t);
|
pp_asm_name (buffer, t);
|
pp_string (buffer, "\");");
|
pp_string (buffer, "\");");
|
}
|
}
|
else
|
else
|
{
|
{
|
dump_ada_import (buffer, t);
|
dump_ada_import (buffer, t);
|
}
|
}
|
|
|
return 1;
|
return 1;
|
}
|
}
|
else if (TREE_CODE (t) == TYPE_DECL && !DECL_ORIGINAL_TYPE (t))
|
else if (TREE_CODE (t) == TYPE_DECL && !DECL_ORIGINAL_TYPE (t))
|
{
|
{
|
int is_interface = 0;
|
int is_interface = 0;
|
int is_abstract_record = 0;
|
int is_abstract_record = 0;
|
|
|
if (need_indent)
|
if (need_indent)
|
INDENT (spc);
|
INDENT (spc);
|
|
|
/* Anonymous structs/unions */
|
/* Anonymous structs/unions */
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, TREE_TYPE (t), t, cpp_check, spc, false, true);
|
(buffer, TREE_TYPE (t), t, cpp_check, spc, false, true);
|
|
|
if (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE
|
if (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE
|
|| TREE_CODE (TREE_TYPE (t)) == QUAL_UNION_TYPE)
|
|| TREE_CODE (TREE_TYPE (t)) == QUAL_UNION_TYPE)
|
{
|
{
|
pp_string (buffer, " (discr : unsigned := 0)");
|
pp_string (buffer, " (discr : unsigned := 0)");
|
}
|
}
|
|
|
pp_string (buffer, " is ");
|
pp_string (buffer, " is ");
|
|
|
/* Check whether we have an Ada interface compatible class. */
|
/* Check whether we have an Ada interface compatible class. */
|
if (cpp_check && AGGREGATE_TYPE_P (TREE_TYPE (t))
|
if (cpp_check && AGGREGATE_TYPE_P (TREE_TYPE (t))
|
&& TYPE_METHODS (TREE_TYPE (t)))
|
&& TYPE_METHODS (TREE_TYPE (t)))
|
{
|
{
|
int num_fields = 0;
|
int num_fields = 0;
|
tree tmp = TYPE_FIELDS (TREE_TYPE (t));
|
tree tmp = TYPE_FIELDS (TREE_TYPE (t));
|
|
|
/* Check that there are no fields other than the virtual table. */
|
/* Check that there are no fields other than the virtual table. */
|
for (; tmp; tmp = TREE_CHAIN (tmp))
|
for (; tmp; tmp = TREE_CHAIN (tmp))
|
{
|
{
|
if (TREE_CODE (tmp) == TYPE_DECL)
|
if (TREE_CODE (tmp) == TYPE_DECL)
|
continue;
|
continue;
|
num_fields++;
|
num_fields++;
|
}
|
}
|
|
|
if (num_fields == 1)
|
if (num_fields == 1)
|
is_interface = 1;
|
is_interface = 1;
|
|
|
/* Also check that there are only virtual methods. */
|
/* Also check that there are only virtual methods. */
|
for (tmp = TYPE_METHODS (TREE_TYPE (t)); tmp; tmp = TREE_CHAIN (tmp))
|
for (tmp = TYPE_METHODS (TREE_TYPE (t)); tmp; tmp = TREE_CHAIN (tmp))
|
{
|
{
|
if (cpp_check (tmp, IS_ABSTRACT))
|
if (cpp_check (tmp, IS_ABSTRACT))
|
is_abstract_record = 1;
|
is_abstract_record = 1;
|
else
|
else
|
is_interface = 0;
|
is_interface = 0;
|
}
|
}
|
}
|
}
|
|
|
TREE_VISITED (t) = 1;
|
TREE_VISITED (t) = 1;
|
if (is_interface)
|
if (is_interface)
|
{
|
{
|
pp_string (buffer, "limited interface; -- ");
|
pp_string (buffer, "limited interface; -- ");
|
dump_sloc (buffer, t);
|
dump_sloc (buffer, t);
|
newline_and_indent (buffer, spc);
|
newline_and_indent (buffer, spc);
|
pp_string (buffer, "pragma Import (CPP, ");
|
pp_string (buffer, "pragma Import (CPP, ");
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, TYPE_NAME (TREE_TYPE (t)), type, cpp_check,
|
(buffer, TYPE_NAME (TREE_TYPE (t)), type, cpp_check,
|
spc, false, true);
|
spc, false, true);
|
pp_character (buffer, ')');
|
pp_character (buffer, ')');
|
|
|
print_ada_methods (buffer, TREE_TYPE (t), cpp_check, spc);
|
print_ada_methods (buffer, TREE_TYPE (t), cpp_check, spc);
|
}
|
}
|
else
|
else
|
{
|
{
|
if (is_abstract_record)
|
if (is_abstract_record)
|
pp_string (buffer, "abstract ");
|
pp_string (buffer, "abstract ");
|
dump_generic_ada_node (buffer, t, t, cpp_check, spc, false, false);
|
dump_generic_ada_node (buffer, t, t, cpp_check, spc, false, false);
|
}
|
}
|
}
|
}
|
else
|
else
|
{
|
{
|
if (need_indent)
|
if (need_indent)
|
INDENT (spc);
|
INDENT (spc);
|
|
|
if (TREE_CODE (t) == FIELD_DECL && DECL_NAME (t))
|
if (TREE_CODE (t) == FIELD_DECL && DECL_NAME (t))
|
check_name (buffer, t);
|
check_name (buffer, t);
|
|
|
/* Print variable/type's name. */
|
/* Print variable/type's name. */
|
dump_generic_ada_node (buffer, t, t, cpp_check, spc, false, true);
|
dump_generic_ada_node (buffer, t, t, cpp_check, spc, false, true);
|
|
|
if (TREE_CODE (t) == TYPE_DECL)
|
if (TREE_CODE (t) == TYPE_DECL)
|
{
|
{
|
tree orig = DECL_ORIGINAL_TYPE (t);
|
tree orig = DECL_ORIGINAL_TYPE (t);
|
int is_subtype = orig && TYPE_NAME (orig) && orig != TREE_TYPE (t);
|
int is_subtype = orig && TYPE_NAME (orig) && orig != TREE_TYPE (t);
|
|
|
if (!is_subtype
|
if (!is_subtype
|
&& (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE
|
&& (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE
|
|| TREE_CODE (TREE_TYPE (t)) == QUAL_UNION_TYPE))
|
|| TREE_CODE (TREE_TYPE (t)) == QUAL_UNION_TYPE))
|
pp_string (buffer, " (discr : unsigned := 0)");
|
pp_string (buffer, " (discr : unsigned := 0)");
|
|
|
pp_string (buffer, " is ");
|
pp_string (buffer, " is ");
|
|
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, orig, t, cpp_check, spc, false, is_subtype);
|
(buffer, orig, t, cpp_check, spc, false, is_subtype);
|
}
|
}
|
else
|
else
|
{
|
{
|
if (spc == INDENT_INCR || TREE_STATIC (t))
|
if (spc == INDENT_INCR || TREE_STATIC (t))
|
is_var = 1;
|
is_var = 1;
|
|
|
pp_string (buffer, " : ");
|
pp_string (buffer, " : ");
|
|
|
/* Print type declaration. */
|
/* Print type declaration. */
|
|
|
if (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE
|
if (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE
|
&& !TYPE_NAME (TREE_TYPE (t)))
|
&& !TYPE_NAME (TREE_TYPE (t)))
|
{
|
{
|
dump_ada_double_name (buffer, type, t, "_union");
|
dump_ada_double_name (buffer, type, t, "_union");
|
}
|
}
|
else if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t)))
|
else if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t)))
|
{
|
{
|
if (TREE_CODE (TREE_TYPE (t)) == RECORD_TYPE)
|
if (TREE_CODE (TREE_TYPE (t)) == RECORD_TYPE)
|
pp_string (buffer, "aliased ");
|
pp_string (buffer, "aliased ");
|
|
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, TREE_TYPE (t), t, cpp_check, spc, false, true);
|
(buffer, TREE_TYPE (t), t, cpp_check, spc, false, true);
|
}
|
}
|
else
|
else
|
{
|
{
|
if (TREE_CODE (TREE_TYPE (t)) != POINTER_TYPE
|
if (TREE_CODE (TREE_TYPE (t)) != POINTER_TYPE
|
&& (TYPE_NAME (TREE_TYPE (t))
|
&& (TYPE_NAME (TREE_TYPE (t))
|
|| TREE_CODE (TREE_TYPE (t)) != INTEGER_TYPE))
|
|| TREE_CODE (TREE_TYPE (t)) != INTEGER_TYPE))
|
pp_string (buffer, "aliased ");
|
pp_string (buffer, "aliased ");
|
|
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, TREE_TYPE (t), TREE_TYPE (t), cpp_check,
|
(buffer, TREE_TYPE (t), TREE_TYPE (t), cpp_check,
|
spc, false, true);
|
spc, false, true);
|
}
|
}
|
}
|
}
|
}
|
}
|
|
|
if (is_class)
|
if (is_class)
|
{
|
{
|
spc -= 3;
|
spc -= 3;
|
newline_and_indent (buffer, spc);
|
newline_and_indent (buffer, spc);
|
pp_string (buffer, "end;");
|
pp_string (buffer, "end;");
|
newline_and_indent (buffer, spc);
|
newline_and_indent (buffer, spc);
|
pp_string (buffer, "use Class_");
|
pp_string (buffer, "use Class_");
|
dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
|
dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
|
pp_semicolon (buffer);
|
pp_semicolon (buffer);
|
pp_newline (buffer);
|
pp_newline (buffer);
|
|
|
/* All needed indentation/newline performed already, so return 0. */
|
/* All needed indentation/newline performed already, so return 0. */
|
return 0;
|
return 0;
|
}
|
}
|
else
|
else
|
{
|
{
|
pp_string (buffer, "; -- ");
|
pp_string (buffer, "; -- ");
|
dump_sloc (buffer, t);
|
dump_sloc (buffer, t);
|
}
|
}
|
|
|
if (is_var)
|
if (is_var)
|
{
|
{
|
newline_and_indent (buffer, spc);
|
newline_and_indent (buffer, spc);
|
dump_ada_import (buffer, t);
|
dump_ada_import (buffer, t);
|
}
|
}
|
|
|
return 1;
|
return 1;
|
}
|
}
|
|
|
/* Prints in BUFFER a structure NODE of type TYPE: name, fields, and methods
|
/* 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
|
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
|
is the indentation level. If DISPLAY_CONVENTION is true, also print the
|
pragma Convention for NODE. */
|
pragma Convention for NODE. */
|
|
|
static void
|
static void
|
print_ada_struct_decl (pretty_printer *buffer, tree node, tree type,
|
print_ada_struct_decl (pretty_printer *buffer, tree node, tree type,
|
int (*cpp_check)(tree, cpp_operation), int spc,
|
int (*cpp_check)(tree, cpp_operation), int spc,
|
bool display_convention)
|
bool display_convention)
|
{
|
{
|
tree tmp;
|
tree tmp;
|
int is_union =
|
int is_union =
|
TREE_CODE (node) == UNION_TYPE || TREE_CODE (node) == QUAL_UNION_TYPE;
|
TREE_CODE (node) == UNION_TYPE || TREE_CODE (node) == QUAL_UNION_TYPE;
|
char buf [16];
|
char buf [16];
|
int field_num = 0;
|
int field_num = 0;
|
int field_spc = spc + INDENT_INCR;
|
int field_spc = spc + INDENT_INCR;
|
int need_semicolon;
|
int need_semicolon;
|
|
|
bitfield_used = false;
|
bitfield_used = false;
|
|
|
if (!TYPE_FIELDS (node))
|
if (!TYPE_FIELDS (node))
|
pp_string (buffer, "null record;");
|
pp_string (buffer, "null record;");
|
else
|
else
|
{
|
{
|
pp_string (buffer, "record");
|
pp_string (buffer, "record");
|
|
|
/* Print the contents of the structure. */
|
/* Print the contents of the structure. */
|
|
|
if (is_union)
|
if (is_union)
|
{
|
{
|
newline_and_indent (buffer, spc + INDENT_INCR);
|
newline_and_indent (buffer, spc + INDENT_INCR);
|
pp_string (buffer, "case discr is");
|
pp_string (buffer, "case discr is");
|
field_spc = spc + INDENT_INCR * 3;
|
field_spc = spc + INDENT_INCR * 3;
|
}
|
}
|
|
|
pp_newline (buffer);
|
pp_newline (buffer);
|
|
|
/* Print the non-static fields of the structure. */
|
/* Print the non-static fields of the structure. */
|
for (tmp = TYPE_FIELDS (node); tmp; tmp = TREE_CHAIN (tmp))
|
for (tmp = TYPE_FIELDS (node); tmp; tmp = TREE_CHAIN (tmp))
|
{
|
{
|
/* Add parent field if needed. */
|
/* Add parent field if needed. */
|
if (!DECL_NAME (tmp))
|
if (!DECL_NAME (tmp))
|
{
|
{
|
if (!is_tagged_type (TREE_TYPE (tmp)))
|
if (!is_tagged_type (TREE_TYPE (tmp)))
|
{
|
{
|
if (!TYPE_NAME (TREE_TYPE (tmp)))
|
if (!TYPE_NAME (TREE_TYPE (tmp)))
|
print_ada_declaration
|
print_ada_declaration
|
(buffer, tmp, type, cpp_check, field_spc);
|
(buffer, tmp, type, cpp_check, field_spc);
|
else
|
else
|
{
|
{
|
INDENT (field_spc);
|
INDENT (field_spc);
|
|
|
if (field_num == 0)
|
if (field_num == 0)
|
pp_string (buffer, "parent : ");
|
pp_string (buffer, "parent : ");
|
else
|
else
|
{
|
{
|
sprintf (buf, "field_%d : ", field_num + 1);
|
sprintf (buf, "field_%d : ", field_num + 1);
|
pp_string (buffer, buf);
|
pp_string (buffer, buf);
|
}
|
}
|
dump_ada_decl_name
|
dump_ada_decl_name
|
(buffer, TYPE_NAME (TREE_TYPE (tmp)), false);
|
(buffer, TYPE_NAME (TREE_TYPE (tmp)), false);
|
pp_semicolon (buffer);
|
pp_semicolon (buffer);
|
}
|
}
|
pp_newline (buffer);
|
pp_newline (buffer);
|
field_num++;
|
field_num++;
|
}
|
}
|
}
|
}
|
/* Avoid printing the structure recursively. */
|
/* Avoid printing the structure recursively. */
|
else if ((TREE_TYPE (tmp) != node
|
else if ((TREE_TYPE (tmp) != node
|
|| (TREE_CODE (TREE_TYPE (tmp)) == POINTER_TYPE
|
|| (TREE_CODE (TREE_TYPE (tmp)) == POINTER_TYPE
|
&& TREE_TYPE (TREE_TYPE (tmp)) != node))
|
&& TREE_TYPE (TREE_TYPE (tmp)) != node))
|
&& TREE_CODE (tmp) != TYPE_DECL
|
&& TREE_CODE (tmp) != TYPE_DECL
|
&& !TREE_STATIC (tmp))
|
&& !TREE_STATIC (tmp))
|
{
|
{
|
/* Skip internal virtual table field. */
|
/* Skip internal virtual table field. */
|
if (strncmp (IDENTIFIER_POINTER (DECL_NAME (tmp)), "_vptr", 5))
|
if (strncmp (IDENTIFIER_POINTER (DECL_NAME (tmp)), "_vptr", 5))
|
{
|
{
|
if (is_union)
|
if (is_union)
|
{
|
{
|
if (TREE_CHAIN (tmp)
|
if (TREE_CHAIN (tmp)
|
&& TREE_TYPE (TREE_CHAIN (tmp)) != node
|
&& TREE_TYPE (TREE_CHAIN (tmp)) != node
|
&& TREE_CODE (TREE_CHAIN (tmp)) != TYPE_DECL)
|
&& TREE_CODE (TREE_CHAIN (tmp)) != TYPE_DECL)
|
sprintf (buf, "when %d =>", field_num);
|
sprintf (buf, "when %d =>", field_num);
|
else
|
else
|
sprintf (buf, "when others =>");
|
sprintf (buf, "when others =>");
|
|
|
INDENT (spc + INDENT_INCR * 2);
|
INDENT (spc + INDENT_INCR * 2);
|
pp_string (buffer, buf);
|
pp_string (buffer, buf);
|
pp_newline (buffer);
|
pp_newline (buffer);
|
}
|
}
|
|
|
if (print_ada_declaration (buffer,
|
if (print_ada_declaration (buffer,
|
tmp, type, cpp_check, field_spc))
|
tmp, type, cpp_check, field_spc))
|
{
|
{
|
pp_newline (buffer);
|
pp_newline (buffer);
|
field_num++;
|
field_num++;
|
}
|
}
|
}
|
}
|
}
|
}
|
}
|
}
|
|
|
if (is_union)
|
if (is_union)
|
{
|
{
|
INDENT (spc + INDENT_INCR);
|
INDENT (spc + INDENT_INCR);
|
pp_string (buffer, "end case;");
|
pp_string (buffer, "end case;");
|
pp_newline (buffer);
|
pp_newline (buffer);
|
}
|
}
|
|
|
if (field_num == 0)
|
if (field_num == 0)
|
{
|
{
|
INDENT (spc + INDENT_INCR);
|
INDENT (spc + INDENT_INCR);
|
pp_string (buffer, "null;");
|
pp_string (buffer, "null;");
|
pp_newline (buffer);
|
pp_newline (buffer);
|
}
|
}
|
|
|
INDENT (spc);
|
INDENT (spc);
|
pp_string (buffer, "end record;");
|
pp_string (buffer, "end record;");
|
}
|
}
|
|
|
newline_and_indent (buffer, spc);
|
newline_and_indent (buffer, spc);
|
|
|
if (!display_convention)
|
if (!display_convention)
|
return;
|
return;
|
|
|
if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (type)))
|
if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (type)))
|
{
|
{
|
if (TYPE_METHODS (TREE_TYPE (type)))
|
if (TYPE_METHODS (TREE_TYPE (type)))
|
pp_string (buffer, "pragma Import (CPP, ");
|
pp_string (buffer, "pragma Import (CPP, ");
|
else
|
else
|
pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
|
pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
|
}
|
}
|
else
|
else
|
pp_string (buffer, "pragma Convention (C, ");
|
pp_string (buffer, "pragma Convention (C, ");
|
|
|
package_prefix = false;
|
package_prefix = false;
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, TREE_TYPE (type), type, cpp_check, spc, false, true);
|
(buffer, TREE_TYPE (type), type, cpp_check, spc, false, true);
|
package_prefix = true;
|
package_prefix = true;
|
pp_character (buffer, ')');
|
pp_character (buffer, ')');
|
|
|
if (is_union)
|
if (is_union)
|
{
|
{
|
pp_semicolon (buffer);
|
pp_semicolon (buffer);
|
newline_and_indent (buffer, spc);
|
newline_and_indent (buffer, spc);
|
pp_string (buffer, "pragma Unchecked_Union (");
|
pp_string (buffer, "pragma Unchecked_Union (");
|
|
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, TREE_TYPE (type), type, cpp_check, spc, false, true);
|
(buffer, TREE_TYPE (type), type, cpp_check, spc, false, true);
|
pp_character (buffer, ')');
|
pp_character (buffer, ')');
|
}
|
}
|
|
|
if (bitfield_used)
|
if (bitfield_used)
|
{
|
{
|
pp_semicolon (buffer);
|
pp_semicolon (buffer);
|
newline_and_indent (buffer, spc);
|
newline_and_indent (buffer, spc);
|
pp_string (buffer, "pragma Pack (");
|
pp_string (buffer, "pragma Pack (");
|
dump_generic_ada_node
|
dump_generic_ada_node
|
(buffer, TREE_TYPE (type), type, cpp_check, spc, false, true);
|
(buffer, TREE_TYPE (type), type, cpp_check, spc, false, true);
|
pp_character (buffer, ')');
|
pp_character (buffer, ')');
|
bitfield_used = false;
|
bitfield_used = false;
|
}
|
}
|
|
|
print_ada_methods (buffer, node, cpp_check, spc);
|
print_ada_methods (buffer, node, cpp_check, spc);
|
|
|
/* Print the static fields of the structure, if any. */
|
/* Print the static fields of the structure, if any. */
|
need_semicolon = TYPE_METHODS (node) == NULL_TREE;
|
need_semicolon = TYPE_METHODS (node) == NULL_TREE;
|
for (tmp = TYPE_FIELDS (node); tmp; tmp = TREE_CHAIN (tmp))
|
for (tmp = TYPE_FIELDS (node); tmp; tmp = TREE_CHAIN (tmp))
|
{
|
{
|
if (DECL_NAME (tmp) && TREE_STATIC (tmp))
|
if (DECL_NAME (tmp) && TREE_STATIC (tmp))
|
{
|
{
|
if (need_semicolon)
|
if (need_semicolon)
|
{
|
{
|
need_semicolon = false;
|
need_semicolon = false;
|
pp_semicolon (buffer);
|
pp_semicolon (buffer);
|
}
|
}
|
pp_newline (buffer);
|
pp_newline (buffer);
|
pp_newline (buffer);
|
pp_newline (buffer);
|
print_ada_declaration (buffer, tmp, type, cpp_check, spc);
|
print_ada_declaration (buffer, tmp, type, cpp_check, spc);
|
}
|
}
|
}
|
}
|
}
|
}
|
|
|
/* Dump all the declarations in SOURCE_FILE to an Ada spec.
|
/* Dump all the declarations in SOURCE_FILE to an Ada spec.
|
COLLECT_ALL_REFS is a front-end callback used to collect all relevant
|
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 for SOURCE_FILE. CPP_CHECK is used to perform C++ queries on
|
nodes. */
|
nodes. */
|
|
|
static void
|
static void
|
dump_ads (const char *source_file,
|
dump_ads (const char *source_file,
|
void (*collect_all_refs)(const char *),
|
void (*collect_all_refs)(const char *),
|
int (*cpp_check)(tree, cpp_operation))
|
int (*cpp_check)(tree, cpp_operation))
|
{
|
{
|
char *ads_name;
|
char *ads_name;
|
char *pkg_name;
|
char *pkg_name;
|
char *s;
|
char *s;
|
FILE *f;
|
FILE *f;
|
|
|
pkg_name = get_ada_package (source_file);
|
pkg_name = get_ada_package (source_file);
|
|
|
/* Construct the .ads filename and package name. */
|
/* Construct the .ads filename and package name. */
|
ads_name = xstrdup (pkg_name);
|
ads_name = xstrdup (pkg_name);
|
|
|
for (s = ads_name; *s; s++)
|
for (s = ads_name; *s; s++)
|
*s = TOLOWER (*s);
|
*s = TOLOWER (*s);
|
|
|
ads_name = reconcat (ads_name, ads_name, ".ads", NULL);
|
ads_name = reconcat (ads_name, ads_name, ".ads", NULL);
|
|
|
/* Write out the .ads file. */
|
/* Write out the .ads file. */
|
f = fopen (ads_name, "w");
|
f = fopen (ads_name, "w");
|
if (f)
|
if (f)
|
{
|
{
|
pretty_printer pp;
|
pretty_printer pp;
|
|
|
pp_construct (&pp, NULL, 0);
|
pp_construct (&pp, NULL, 0);
|
pp_needs_newline (&pp) = true;
|
pp_needs_newline (&pp) = true;
|
pp.buffer->stream = f;
|
pp.buffer->stream = f;
|
|
|
/* Dump all relevant macros. */
|
/* Dump all relevant macros. */
|
dump_ada_macros (&pp, source_file);
|
dump_ada_macros (&pp, source_file);
|
|
|
/* Reset the table of withs for this file. */
|
/* Reset the table of withs for this file. */
|
reset_ada_withs ();
|
reset_ada_withs ();
|
|
|
(*collect_all_refs) (source_file);
|
(*collect_all_refs) (source_file);
|
|
|
/* Dump all references. */
|
/* Dump all references. */
|
dump_ada_nodes (&pp, source_file, cpp_check);
|
dump_ada_nodes (&pp, source_file, cpp_check);
|
|
|
/* Dump withs. */
|
/* Dump withs. */
|
dump_ada_withs (f);
|
dump_ada_withs (f);
|
|
|
fprintf (f, "\npackage %s is\n\n", pkg_name);
|
fprintf (f, "\npackage %s is\n\n", pkg_name);
|
pp_write_text_to_stream (&pp);
|
pp_write_text_to_stream (&pp);
|
/* ??? need to free pp */
|
/* ??? need to free pp */
|
fprintf (f, "end %s;\n", pkg_name);
|
fprintf (f, "end %s;\n", pkg_name);
|
fclose (f);
|
fclose (f);
|
}
|
}
|
|
|
free (ads_name);
|
free (ads_name);
|
free (pkg_name);
|
free (pkg_name);
|
}
|
}
|
|
|
static const char **source_refs = NULL;
|
static const char **source_refs = NULL;
|
static int source_refs_used = 0;
|
static int source_refs_used = 0;
|
static int source_refs_allocd = 0;
|
static int source_refs_allocd = 0;
|
|
|
/* Add an entry for FILENAME to the table SOURCE_REFS. */
|
/* Add an entry for FILENAME to the table SOURCE_REFS. */
|
|
|
void
|
void
|
collect_source_ref (const char *filename)
|
collect_source_ref (const char *filename)
|
{
|
{
|
int i;
|
int i;
|
|
|
if (!filename)
|
if (!filename)
|
return;
|
return;
|
|
|
if (source_refs_allocd == 0)
|
if (source_refs_allocd == 0)
|
{
|
{
|
source_refs_allocd = 1024;
|
source_refs_allocd = 1024;
|
source_refs = XNEWVEC (const char *, source_refs_allocd);
|
source_refs = XNEWVEC (const char *, source_refs_allocd);
|
}
|
}
|
|
|
for (i = 0; i < source_refs_used; i++)
|
for (i = 0; i < source_refs_used; i++)
|
if (filename == source_refs [i])
|
if (filename == source_refs [i])
|
return;
|
return;
|
|
|
if (source_refs_used == source_refs_allocd)
|
if (source_refs_used == source_refs_allocd)
|
{
|
{
|
source_refs_allocd *= 2;
|
source_refs_allocd *= 2;
|
source_refs = XRESIZEVEC (const char *, source_refs, source_refs_allocd);
|
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
|
/* 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 CPP_CHECK.
|
COLLECT_ALL_REFS is a front-end callback used to collect all relevant
|
COLLECT_ALL_REFS is a front-end callback used to collect all relevant
|
nodes for a given source file.
|
nodes for a given source file.
|
CPP_CHECK is used to perform C++ queries on nodes, or NULL for the C
|
CPP_CHECK is used to perform C++ queries on nodes, or NULL for the C
|
front-end. */
|
front-end. */
|
|
|
void
|
void
|
dump_ada_specs (void (*collect_all_refs)(const char *),
|
dump_ada_specs (void (*collect_all_refs)(const char *),
|
int (*cpp_check)(tree, cpp_operation))
|
int (*cpp_check)(tree, cpp_operation))
|
{
|
{
|
int i;
|
int i;
|
|
|
/* Iterate over the list of files to dump specs for */
|
/* Iterate over the list of files to dump specs for */
|
for (i = 0; i < source_refs_used; i++)
|
for (i = 0; i < source_refs_used; i++)
|
dump_ads (source_refs [i], collect_all_refs, cpp_check);
|
dump_ads (source_refs [i], collect_all_refs, cpp_check);
|
|
|
/* Free files table. */
|
/* Free files table. */
|
free (source_refs);
|
free (source_refs);
|
}
|
}
|
|
|
