2013-02-06 Janus Weil <janus@gcc.gnu.org>

[official-gcc.git] / gcc / c-family / c-ada-spec.c

/* Print GENERIC declaration (functions, variables, types) trees coming from
   the C and C++ front-ends as well as macros in Ada syntax.
   Copyright (C) 2010-2013 Free Software Foundation, Inc.
   Adapted from tree-pretty-print.c by Arnaud Charlet  <charlet@adacore.com>

This file is part of GCC.

GCC is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free
Software Foundation; either version 3, or (at your option) any later
version.

GCC is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
for more details.

You should have received a copy of the GNU General Public License
along with GCC; see the file COPYING3.  If not see
<http://www.gnu.org/licenses/>.  */

#include "config.h"
#include "system.h"
#include "coretypes.h"
#include "tm.h"
#include "tree.h"
#include "dumpfile.h"
#include "c-ada-spec.h"
#include "cpplib.h"
#include "c-pragma.h"
#include "cpp-id-data.h"

/* Adapted from hwint.h to use the Ada prefix.  */
#if HOST_BITS_PER_WIDE_INT == HOST_BITS_PER_LONG
# if HOST_BITS_PER_WIDE_INT == 64
#  define ADA_HOST_WIDE_INT_PRINT_DOUBLE_HEX \
     "16#%" HOST_LONG_FORMAT "x%016" HOST_LONG_FORMAT "x#"
# else
#  define ADA_HOST_WIDE_INT_PRINT_DOUBLE_HEX \
     "16#%" HOST_LONG_FORMAT "x%08" HOST_LONG_FORMAT "x#"
# endif
#else
  /* We can assume that 'long long' is at least 64 bits.  */
# define ADA_HOST_WIDE_INT_PRINT_DOUBLE_HEX \
    "16#%" HOST_LONG_LONG_FORMAT "x%016" HOST_LONG_LONG_FORMAT "x#"
#endif /* HOST_BITS_PER_WIDE_INT == HOST_BITS_PER_LONG */

/* Local functions, macros and variables.  */
static int dump_generic_ada_node (pretty_printer *, tree, tree,
                                  int (*)(tree, cpp_operation), int, int, bool);
static int print_ada_declaration (pretty_printer *, tree, tree,
                                  int (*cpp_check)(tree, cpp_operation), int);
static void print_ada_struct_decl (pretty_printer *, tree, tree,
                                   int (*cpp_check)(tree, cpp_operation), int,
                                   bool);
static void dump_sloc (pretty_printer *buffer, tree node);
static void print_comment (pretty_printer *, const char *);
static void print_generic_ada_decl (pretty_printer *, tree,
                                    int (*)(tree, cpp_operation), const char *);
static char *get_ada_package (const char *);
static void dump_ada_nodes (pretty_printer *, const char *,
                            int (*)(tree, cpp_operation));
static void reset_ada_withs (void);
static void dump_ada_withs (FILE *);
static void dump_ads (const char *, void (*)(const char *),
                      int (*)(tree, cpp_operation));
static char *to_ada_name (const char *, int *);
static bool separate_class_package (tree);

#define INDENT(SPACE) do { \
  int i; for (i = 0; i<SPACE; i++) pp_space (buffer); } while (0)

#define INDENT_INCR 3

/* Given a cpp MACRO, compute the max length BUFFER_LEN of the macro, as well
   as max length PARAM_LEN of arguments for fun_like macros, and also set
   SUPPORTED to 0 if the macro cannot be mapped to an Ada construct.  */

static void
macro_length (const cpp_macro *macro, int *supported, int *buffer_len,
              int *param_len)
{
  int i;
  unsigned j;

  *supported = 1;
  *buffer_len = 0;
  *param_len = 0;

  if (macro->fun_like)
    {
      param_len++;
      for (i = 0; i < macro->paramc; i++)
        {
          cpp_hashnode *param = macro->params[i];

          *param_len += NODE_LEN (param);

          if (i + 1 < macro->paramc)
            {
              *param_len += 2;  /* ", " */
            }
          else if (macro->variadic)
            {
              *supported = 0;
              return;
            }
        }
      *param_len += 2;  /* ")\0" */
    }

  for (j = 0; j < macro->count; j++)
    {
      cpp_token *token = &macro->exp.tokens[j];

      if (token->flags & PREV_WHITE)
        (*buffer_len)++;

      if (token->flags & STRINGIFY_ARG || token->flags & PASTE_LEFT)
        {
          *supported = 0;
          return;
        }

      if (token->type == CPP_MACRO_ARG)
        *buffer_len +=
          NODE_LEN (macro->params[token->val.macro_arg.arg_no - 1]);
      else
        /* Include enough extra space to handle e.g. special characters.  */
        *buffer_len += (cpp_token_len (token) + 1) * 8;
    }

  (*buffer_len)++;
}

/* Dump into PP a set of MAX_ADA_MACROS MACROS (C/C++) as Ada constants when
   possible.  */

static void
print_ada_macros (pretty_printer *pp, cpp_hashnode **macros, int max_ada_macros)
{
  int j, num_macros = 0, prev_line = -1;

  for (j = 0; j < max_ada_macros; j++)
    {
      cpp_hashnode *node = macros[j];
      const cpp_macro *macro = node->value.macro;
      unsigned i;
      int supported = 1, prev_is_one = 0, buffer_len, param_len;
      int is_string = 0, is_char = 0;
      char *ada_name;
      unsigned char *s, *params, *buffer, *buf_param, *char_one = NULL;

      macro_length (macro, &supported, &buffer_len, &param_len);
      s = buffer = XALLOCAVEC (unsigned char, buffer_len);
      params = buf_param = XALLOCAVEC (unsigned char, param_len);

      if (supported)
        {
          if (macro->fun_like)
            {
              *buf_param++ = '(';
              for (i = 0; i < macro->paramc; i++)
                {
                  cpp_hashnode *param = macro->params[i];

                  memcpy (buf_param, NODE_NAME (param), NODE_LEN (param));
                  buf_param += NODE_LEN (param);

                  if (i + 1 < macro->paramc)
                    {
                      *buf_param++ = ',';
                      *buf_param++ = ' ';
                    }
                  else if (macro->variadic)
                    {
                      supported = 0;
                      break;
                    }
                }
              *buf_param++ = ')';
              *buf_param = '\0';
            }

          for (i = 0; supported && i < macro->count; i++)
            {
              cpp_token *token = &macro->exp.tokens[i];
              int is_one = 0;

              if (token->flags & PREV_WHITE)
                *buffer++ = ' ';

              if (token->flags & STRINGIFY_ARG || token->flags & PASTE_LEFT)
                {
                  supported = 0;
                  break;
                }

              switch (token->type)
                {
                  case CPP_MACRO_ARG:
                    {
                      cpp_hashnode *param =
                        macro->params[token->val.macro_arg.arg_no - 1];
                      memcpy (buffer, NODE_NAME (param), NODE_LEN (param));
                      buffer += NODE_LEN (param);
                    }
                    break;

                  case CPP_EQ_EQ:       *buffer++ = '='; break;
                  case CPP_GREATER:     *buffer++ = '>'; break;
                  case CPP_LESS:        *buffer++ = '<'; break;
                  case CPP_PLUS:        *buffer++ = '+'; break;
                  case CPP_MINUS:       *buffer++ = '-'; break;
                  case CPP_MULT:        *buffer++ = '*'; break;
                  case CPP_DIV:         *buffer++ = '/'; break;
                  case CPP_COMMA:       *buffer++ = ','; break;
                  case CPP_OPEN_SQUARE:
                  case CPP_OPEN_PAREN:  *buffer++ = '('; break;
                  case CPP_CLOSE_SQUARE: /* fallthrough */
                  case CPP_CLOSE_PAREN: *buffer++ = ')'; break;
                  case CPP_DEREF:       /* fallthrough */
                  case CPP_SCOPE:       /* fallthrough */
                  case CPP_DOT:         *buffer++ = '.'; break;

                  case CPP_EQ:          *buffer++ = ':'; *buffer++ = '='; break;
                  case CPP_NOT_EQ:      *buffer++ = '/'; *buffer++ = '='; break;
                  case CPP_GREATER_EQ:  *buffer++ = '>'; *buffer++ = '='; break;
                  case CPP_LESS_EQ:     *buffer++ = '<'; *buffer++ = '='; break;

                  case CPP_NOT:
                    *buffer++ = 'n'; *buffer++ = 'o'; *buffer++ = 't'; break;
                  case CPP_MOD:
                    *buffer++ = 'm'; *buffer++ = 'o'; *buffer++ = 'd'; break;
                  case CPP_AND:
                    *buffer++ = 'a'; *buffer++ = 'n'; *buffer++ = 'd'; break;
                  case CPP_OR:
                    *buffer++ = 'o'; *buffer++ = 'r'; break;
                  case CPP_XOR:
                    *buffer++ = 'x'; *buffer++ = 'o'; *buffer++ = 'r'; break;
                  case CPP_AND_AND:
                    strcpy ((char *) buffer, " and then ");
                    buffer += 10;
                    break;
                  case CPP_OR_OR:
                    strcpy ((char *) buffer, " or else ");
                    buffer += 9;
                    break;

                  case CPP_PADDING:
                    *buffer++ = ' ';
                    is_one = prev_is_one;
                    break;

                  case CPP_COMMENT: break;

                  case CPP_WSTRING:
                  case CPP_STRING16:
                  case CPP_STRING32:
                  case CPP_UTF8STRING:
                  case CPP_WCHAR:
                  case CPP_CHAR16:
                  case CPP_CHAR32:
                  case CPP_NAME:
                  case CPP_STRING:
                  case CPP_NUMBER:
                    if (!macro->fun_like)
                      supported = 0;
                    else
                      buffer = cpp_spell_token (parse_in, token, buffer, false);
                    break;

                  case CPP_CHAR:
                    is_char = 1;
                    {
                      unsigned chars_seen;
                      int ignored;
                      cppchar_t c;

                      c = cpp_interpret_charconst (parse_in, token,
                                                   &chars_seen, &ignored);
                      if (c >= 32 && c <= 126)
                        {
                          *buffer++ = '\'';
                          *buffer++ = (char) c;
                          *buffer++ = '\'';
                        }
                      else
                        {
                          chars_seen = sprintf
                            ((char *) buffer, "Character'Val (%d)", (int) c);
                          buffer += chars_seen;
                        }
                    }
                    break;

                  case CPP_LSHIFT:
                    if (prev_is_one)
                      {
                        /* Replace "1 << N" by "2 ** N" */
                        *char_one = '2';
                        *buffer++ = '*';
                        *buffer++ = '*';
                        break;
                      }
                    /* fallthrough */

                  case CPP_RSHIFT:
                  case CPP_COMPL:
                  case CPP_QUERY:
                  case CPP_EOF:
                  case CPP_PLUS_EQ:
                  case CPP_MINUS_EQ:
                  case CPP_MULT_EQ:
                  case CPP_DIV_EQ:
                  case CPP_MOD_EQ:
                  case CPP_AND_EQ:
                  case CPP_OR_EQ:
                  case CPP_XOR_EQ:
                  case CPP_RSHIFT_EQ:
                  case CPP_LSHIFT_EQ:
                  case CPP_PRAGMA:
                  case CPP_PRAGMA_EOL:
                  case CPP_HASH:
                  case CPP_PASTE:
                  case CPP_OPEN_BRACE:
                  case CPP_CLOSE_BRACE:
                  case CPP_SEMICOLON:
                  case CPP_ELLIPSIS:
                  case CPP_PLUS_PLUS:
                  case CPP_MINUS_MINUS:
                  case CPP_DEREF_STAR:
                  case CPP_DOT_STAR:
                  case CPP_ATSIGN:
                  case CPP_HEADER_NAME:
                  case CPP_AT_NAME:
                  case CPP_OTHER:
                  case CPP_OBJC_STRING:
                  default:
                    if (!macro->fun_like)
                      supported = 0;
                    else
                      buffer = cpp_spell_token (parse_in, token, buffer, false);
                    break;
                }

              prev_is_one = is_one;
            }

          if (supported)
            *buffer = '\0';
        }

      if (macro->fun_like && supported)
        {
          char *start = (char *) s;
          int is_function = 0;

          pp_string (pp, "   --  arg-macro: ");

          if (*start == '(' && buffer[-1] == ')')
            {
              start++;
              buffer[-1] = '\0';
              is_function = 1;
              pp_string (pp, "function ");
            }
          else
            {
              pp_string (pp, "procedure ");
            }

          pp_string (pp, (const char *) NODE_NAME (node));
          pp_space (pp);
          pp_string (pp, (char *) params);
          pp_newline (pp);
          pp_string (pp, "   --    ");

          if (is_function)
            {
              pp_string (pp, "return ");
              pp_string (pp, start);
              pp_semicolon (pp);
            }
          else
            pp_string (pp, start);

          pp_newline (pp);
        }
      else if (supported)
        {
          expanded_location sloc = expand_location (macro->line);

          if (sloc.line != prev_line + 1)
            pp_newline (pp);

          num_macros++;
          prev_line = sloc.line;

          pp_string (pp, "   ");
          ada_name = to_ada_name ((const char *) NODE_NAME (node), NULL);
          pp_string (pp, ada_name);
          free (ada_name);
          pp_string (pp, " : ");

          if (is_string)
            pp_string (pp, "aliased constant String");
          else if (is_char)
            pp_string (pp, "aliased constant Character");
          else
            pp_string (pp, "constant");

          pp_string (pp, " := ");
          pp_string (pp, (char *) s);

          if (is_string)
            pp_string (pp, " & ASCII.NUL");

          pp_string (pp, ";  --  ");
          pp_string (pp, sloc.file);
          pp_character (pp, ':');
          pp_scalar (pp, "%d", sloc.line);
          pp_newline (pp);
        }
      else
        {
          pp_string (pp, "   --  unsupported macro: ");
          pp_string (pp, (const char *) cpp_macro_definition (parse_in, node));
          pp_newline (pp);
        }
    }

  if (num_macros > 0)
    pp_newline (pp);
}

static const char *source_file;
static int max_ada_macros;

/* Callback used to count the number of relevant macros from
   cpp_forall_identifiers. PFILE and V are not used. NODE is the current macro
   to consider.  */

static int
count_ada_macro (cpp_reader *pfile ATTRIBUTE_UNUSED, cpp_hashnode *node,
                 void *v ATTRIBUTE_UNUSED)
{
  const cpp_macro *macro = node->value.macro;

  if (node->type == NT_MACRO && !(node->flags & NODE_BUILTIN)
      && macro->count
      && *NODE_NAME (node) != '_'
      && LOCATION_FILE (macro->line) == source_file)
    max_ada_macros++;

  return 1;
}

static int store_ada_macro_index;

/* Callback used to store relevant macros from cpp_forall_identifiers.
   PFILE is not used. NODE is the current macro to store if relevant.
   MACROS is an array of cpp_hashnode* used to store NODE.  */

static int
store_ada_macro (cpp_reader *pfile ATTRIBUTE_UNUSED,
                 cpp_hashnode *node, void *macros)
{
  const cpp_macro *macro = node->value.macro;

  if (node->type == NT_MACRO && !(node->flags & NODE_BUILTIN)
      && macro->count
      && *NODE_NAME (node) != '_'
      && LOCATION_FILE (macro->line) == source_file)
    ((cpp_hashnode **) macros)[store_ada_macro_index++] = node;

  return 1;
}

/* Callback used to compare (during qsort) macros.  NODE1 and NODE2 are the
   two macro nodes to compare.  */

static int
compare_macro (const void *node1, const void *node2)
{
  typedef const cpp_hashnode *const_hnode;

  const_hnode n1 = *(const const_hnode *) node1;
  const_hnode n2 = *(const const_hnode *) node2;

  return n1->value.macro->line - n2->value.macro->line;
}

/* Dump in PP all relevant macros appearing in FILE.  */

static void
dump_ada_macros (pretty_printer *pp, const char* file)
{
  cpp_hashnode **macros;

  /* Initialize file-scope variables.  */
  max_ada_macros = 0;
  store_ada_macro_index = 0;
  source_file = file;

  /* Count all potentially relevant macros, and then sort them by sloc.  */
  cpp_forall_identifiers (parse_in, count_ada_macro, NULL);
  macros = XALLOCAVEC (cpp_hashnode *, max_ada_macros);
  cpp_forall_identifiers (parse_in, store_ada_macro, macros);
  qsort (macros, max_ada_macros, sizeof (cpp_hashnode *), compare_macro);

  print_ada_macros (pp, macros, max_ada_macros);
}

/* Current source file being handled.  */

static const char *source_file_base;

/* Compare the declaration (DECL) of struct-like types based on the sloc of
   their last field (if LAST is true), so that more nested types collate before
   less nested ones.
   If ORIG_TYPE is true, also consider struct with a DECL_ORIGINAL_TYPE.  */

static location_t
decl_sloc_common (const_tree decl, bool last, bool orig_type)
{
  tree type = TREE_TYPE (decl);

  if (TREE_CODE (decl) == TYPE_DECL
      && (orig_type || !DECL_ORIGINAL_TYPE (decl))
      && RECORD_OR_UNION_TYPE_P (type)
      && TYPE_FIELDS (type))
    {
      tree f = TYPE_FIELDS (type);

      if (last)
        while (TREE_CHAIN (f))
          f = TREE_CHAIN (f);

      return DECL_SOURCE_LOCATION (f);
    }
  else
    return DECL_SOURCE_LOCATION (decl);
}

/* Return sloc of DECL, using sloc of last field if LAST is true.  */

location_t
decl_sloc (const_tree decl, bool last)
{
  return decl_sloc_common (decl, last, false);
}

/* Compare two locations LHS and RHS.  */

static int
compare_location (location_t lhs, location_t rhs)
{
  expanded_location xlhs = expand_location (lhs);
  expanded_location xrhs = expand_location (rhs);

  if (xlhs.file != xrhs.file)
    return filename_cmp (xlhs.file, xrhs.file);

  if (xlhs.line != xrhs.line)
    return xlhs.line - xrhs.line;

  if (xlhs.column != xrhs.column)
    return xlhs.column - xrhs.column;

  return 0;
}

/* Compare two declarations (LP and RP) by their source location.  */

static int
compare_node (const void *lp, const void *rp)
{
  const_tree lhs = *((const tree *) lp);
  const_tree rhs = *((const tree *) rp);

  return compare_location (decl_sloc (lhs, true), decl_sloc (rhs, true));
}

/* Compare two comments (LP and RP) by their source location.  */

static int
compare_comment (const void *lp, const void *rp)
{
  const cpp_comment *lhs = (const cpp_comment *) lp;
  const cpp_comment *rhs = (const cpp_comment *) rp;

  return compare_location (lhs->sloc, rhs->sloc);
}

static tree *to_dump = NULL;
static int to_dump_count = 0;

/* Collect a list of declarations from T relevant to SOURCE_FILE to be dumped
   by a subsequent call to dump_ada_nodes.  */

void
collect_ada_nodes (tree t, const char *source_file)
{
  tree n;
  int i = to_dump_count;

  /* Count the likely relevant nodes.  */
  for (n = t; n; n = TREE_CHAIN (n))
    if (!DECL_IS_BUILTIN (n)
        && LOCATION_FILE (decl_sloc (n, false)) == source_file)
      to_dump_count++;

  /* Allocate sufficient storage for all nodes.  */
  to_dump = XRESIZEVEC (tree, to_dump, to_dump_count);

  /* Store the relevant nodes.  */
  for (n = t; n; n = TREE_CHAIN (n))
    if (!DECL_IS_BUILTIN (n)
        && LOCATION_FILE (decl_sloc (n, false)) == source_file)
      to_dump[i++] = n;
}

/* Call back for walk_tree to clear the TREE_VISITED flag of TP.  */

static tree
unmark_visited_r (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED,
                  void *data ATTRIBUTE_UNUSED)
{
  if (TREE_VISITED (*tp))
    TREE_VISITED (*tp) = 0;
  else
    *walk_subtrees = 0;

  return NULL_TREE;
}

/* Dump nodes into PP relevant to SOURCE_FILE, as collected by previous calls
   to collect_ada_nodes.  CPP_CHECK is used to perform C++ queries on nodes.  */

static void
dump_ada_nodes (pretty_printer *pp, const char *source_file,
                int (*cpp_check)(tree, cpp_operation))
{
  int i, j;
  cpp_comment_table *comments;

  /* Sort the table of declarations to dump by sloc.  */
  qsort (to_dump, to_dump_count, sizeof (tree), compare_node);

  /* Fetch the table of comments.  */
  comments = cpp_get_comments (parse_in);

  /* Sort the comments table by sloc.  */
  qsort (comments->entries, comments->count, sizeof (cpp_comment),
         compare_comment);

  /* Interleave comments and declarations in line number order.  */
  i = j = 0;
  do
    {
      /* Advance j until comment j is in this file.  */
      while (j != comments->count
             && LOCATION_FILE (comments->entries[j].sloc) != source_file)
        j++;

      /* Advance j until comment j is not a duplicate.  */
      while (j < comments->count - 1
             && !compare_comment (&comments->entries[j],
                                  &comments->entries[j + 1]))
        j++;

      /* Write decls until decl i collates after comment j.  */
      while (i != to_dump_count)
        {
          if (j == comments->count
              || LOCATION_LINE (decl_sloc (to_dump[i], false))
              <  LOCATION_LINE (comments->entries[j].sloc))
            print_generic_ada_decl (pp, to_dump[i++], cpp_check, source_file);
          else
            break;
        }

      /* Write comment j, if there is one.  */
      if (j != comments->count)
        print_comment (pp, comments->entries[j++].comment);

    } while (i != to_dump_count || j != comments->count);

  /* Clear the TREE_VISITED flag over each subtree we've dumped.  */
  for (i = 0; i < to_dump_count; i++)
    walk_tree (&to_dump[i], unmark_visited_r, NULL, NULL);

  /* Finalize the to_dump table.  */
  if (to_dump)
    {
      free (to_dump);
      to_dump = NULL;
      to_dump_count = 0;
    }
}

/* Print a COMMENT to the output stream PP.  */

static void
print_comment (pretty_printer *pp, const char *comment)
{
  int len = strlen (comment);
  char *str = XALLOCAVEC (char, len + 1);
  char *tok;
  bool extra_newline = false;

  memcpy (str, comment, len + 1);

  /* Trim C/C++ comment indicators.  */
  if (str[len - 2] == '*' && str[len - 1] == '/')
    {
      str[len - 2] = ' ';
      str[len - 1] = '\0';
    }
  str += 2;

  tok = strtok (str, "\n");
  while (tok) {
    pp_string (pp, "  --");
    pp_string (pp, tok);
    pp_newline (pp);
    tok = strtok (NULL, "\n");

    /* Leave a blank line after multi-line comments.  */
    if (tok)
      extra_newline = true;
  }

  if (extra_newline)
    pp_newline (pp);
}

/* Prints declaration DECL to PP in Ada syntax. The current source file being
   handled is SOURCE_FILE, and CPP_CHECK is used to perform C++ queries on
   nodes.  */

static void
print_generic_ada_decl (pretty_printer *pp, tree decl,
                        int (*cpp_check)(tree, cpp_operation),
                        const char* source_file)
{
  source_file_base = source_file;

  if (print_ada_declaration (pp, decl, 0, cpp_check, INDENT_INCR))
    {
      pp_newline (pp);
      pp_newline (pp);
    }
}

/* Dump a newline and indent BUFFER by SPC chars.  */

static void
newline_and_indent (pretty_printer *buffer, int spc)
{
  pp_newline (buffer);
  INDENT (spc);
}

struct with { char *s; const char *in_file; int limited; };
static struct with *withs = NULL;
static int withs_max = 4096;
static int with_len = 0;

/* Record a "with" clause on package S (a limited with if LIMITED_ACCESS is
   true), if not already done.  */

static void
append_withs (const char *s, int limited_access)
{
  int i;

  if (withs == NULL)
    withs = XNEWVEC (struct with, withs_max);

  if (with_len == withs_max)
    {
      withs_max *= 2;
      withs = XRESIZEVEC (struct with, withs, withs_max);
    }

  for (i = 0; i < with_len; i++)
    if (!strcmp (s, withs[i].s)
        && source_file_base == withs[i].in_file)
      {
        withs[i].limited &= limited_access;
        return;
      }

  withs[with_len].s = xstrdup (s);
  withs[with_len].in_file = source_file_base;
  withs[with_len].limited = limited_access;
  with_len++;
}

/* Reset "with" clauses.  */

static void
reset_ada_withs (void)
{
  int i;

  if (!withs)
    return;

  for (i = 0; i < with_len; i++)
    free (withs[i].s);
  free (withs);
  withs = NULL;
  withs_max = 4096;
  with_len = 0;
}

/* Dump "with" clauses in F.  */

static void
dump_ada_withs (FILE *f)
{
  int i;

  fprintf (f, "with Interfaces.C; use Interfaces.C;\n");

  for (i = 0; i < with_len; i++)
    fprintf
      (f, "%swith %s;\n", withs[i].limited ? "limited " : "", withs[i].s);
}

/* Return suitable Ada package name from FILE.  */

static char *
get_ada_package (const char *file)
{
  const char *base;
  char *res;
  const char *s;
  int i;
  size_t plen;

  s = strstr (file, "/include/");
  if (s)
    base = s + 9;
  else
    base = lbasename (file);

  if (ada_specs_parent == NULL)
    plen = 0;
  else
    plen = strlen (ada_specs_parent) + 1;

  res = XNEWVEC (char, plen + strlen (base) + 1);
  if (ada_specs_parent != NULL) {
    strcpy (res, ada_specs_parent);
    res[plen - 1] = '.';
  }

  for (i = plen; *base; base++, i++)
    switch (*base)
      {
        case '+':
          res[i] = 'p';
          break;

        case '.':
        case '-':
        case '_':
        case '/':
        case '\\':
          res[i] = (i == 0 || res[i - 1] == '.' || res[i - 1] == '_') ? 'u' : '_';
          break;

        default:
          res[i] = *base;
          break;
      }
  res[i] = '\0';

  return res;
}

static const char *ada_reserved[] = {
  "abort", "abs", "abstract", "accept", "access", "aliased", "all", "and",
  "array", "at", "begin", "body", "case", "constant", "declare", "delay",
  "delta", "digits", "do", "else", "elsif", "end", "entry", "exception",
  "exit", "for", "function", "generic", "goto", "if", "in", "interface", "is",
  "limited", "loop", "mod", "new", "not", "null", "others", "out", "of", "or",
  "overriding", "package", "pragma", "private", "procedure", "protected",
  "raise", "range", "record", "rem", "renames", "requeue", "return", "reverse",
  "select", "separate", "subtype", "synchronized", "tagged", "task",
  "terminate", "then", "type", "until", "use", "when", "while", "with", "xor",
  NULL};

/* ??? would be nice to specify this list via a config file, so that users
   can create their own dictionary of conflicts.  */
static const char *c_duplicates[] = {
  /* system will cause troubles with System.Address.  */
  "system",

  /* The following values have other definitions with same name/other
     casing.  */
  "funmap",
  "rl_vi_fWord",
  "rl_vi_bWord",
  "rl_vi_eWord",
  "rl_readline_version",
  "_Vx_ushort",
  "USHORT",
  "XLookupKeysym",
  NULL};

/* Return a declaration tree corresponding to TYPE.  */

static tree
get_underlying_decl (tree type)
{
  tree decl = NULL_TREE;

  if (type == NULL_TREE)
    return NULL_TREE;

  /* type is a declaration.  */
  if (DECL_P (type))
    decl = type;

  /* type is a typedef.  */
  if (TYPE_P (type) && TYPE_NAME (type) && DECL_P (TYPE_NAME (type)))
    decl = TYPE_NAME (type);

  /* TYPE_STUB_DECL has been set for type.  */
  if (TYPE_P (type) && TYPE_STUB_DECL (type) &&
      DECL_P (TYPE_STUB_DECL (type)))
    decl = TYPE_STUB_DECL (type);

  return decl;
}

/* Return whether TYPE has static fields.  */

static int
has_static_fields (const_tree type)
{
  tree tmp;

  for (tmp = TYPE_FIELDS (type); tmp; tmp = TREE_CHAIN (tmp))
    {
      if (DECL_NAME (tmp) && TREE_STATIC (tmp))
        return true;
    }
  return false;
}

/* Return whether TYPE corresponds to an Ada tagged type (has a dispatch
   table).  */

static int
is_tagged_type (const_tree type)
{
  tree tmp;

  if (!type || !RECORD_OR_UNION_TYPE_P (type))
    return false;

  for (tmp = TYPE_METHODS (type); tmp; tmp = TREE_CHAIN (tmp))
    if (DECL_VINDEX (tmp))
      return true;

  return false;
}

/* Generate a legal Ada name from a C NAME, returning a malloc'd string.
   SPACE_FOUND, if not NULL, is used to indicate whether a space was found in
   NAME.  */

static char *
to_ada_name (const char *name, int *space_found)
{
  const char **names;
  int len = strlen (name);
  int j, len2 = 0;
  int found = false;
  char *s = XNEWVEC (char, len * 2 + 5);
  char c;

  if (space_found)
    *space_found = false;

  /* Add trailing "c_" if name is an Ada reserved word.  */
  for (names = ada_reserved; *names; names++)
    if (!strcasecmp (name, *names))
      {
        s[len2++] = 'c';
        s[len2++] = '_';
        found = true;
        break;
      }

  if (!found)
    /* Add trailing "c_" if name is an potential case sensitive duplicate.  */
    for (names = c_duplicates; *names; names++)
      if (!strcmp (name, *names))
        {
          s[len2++] = 'c';
          s[len2++] = '_';
          found = true;
          break;
        }

  for (j = 0; name[j] == '_'; j++)
    s[len2++] = 'u';

  if (j > 0)
    s[len2++] = '_';
  else if (*name == '.' || *name == '$')
    {
      s[0] = 'a';
      s[1] = 'n';
      s[2] = 'o';
      s[3] = 'n';
      len2 = 4;
      j++;
    }

  /* Replace unsuitable characters for Ada identifiers.  */

  for (; j < len; j++)
    switch (name[j])
      {
        case ' ':
          if (space_found)
            *space_found = true;
          s[len2++] = '_';
          break;

        /* ??? missing some C++ operators.  */
        case '=':
          s[len2++] = '_';

          if (name[j + 1] == '=')
            {
              j++;
              s[len2++] = 'e';
              s[len2++] = 'q';
            }
          else
            {
              s[len2++] = 'a';
              s[len2++] = 's';
            }
          break;

        case '!':
          s[len2++] = '_';
          if (name[j + 1] == '=')
            {
              j++;
              s[len2++] = 'n';
              s[len2++] = 'e';
            }
          break;

        case '~':
          s[len2++] = '_';
          s[len2++] = 't';
          s[len2++] = 'i';
          break;

        case '&':
        case '|':
        case '^':
          s[len2++] = '_';
          s[len2++] = name[j] == '&' ? 'a' : name[j] == '|' ? 'o' : 'x';

          if (name[j + 1] == '=')
            {
              j++;
              s[len2++] = 'e';
            }
          break;

        case '+':
        case '-':
        case '*':
        case '/':
        case '(':
        case '[':
          if (s[len2 - 1] != '_')
            s[len2++] = '_';

          switch (name[j + 1]) {
            case '\0':
              j++;
              switch (name[j - 1]) {
                case '+': s[len2++] = 'p'; break;  /* + */
                case '-': s[len2++] = 'm'; break;  /* - */
                case '*': s[len2++] = 't'; break;  /* * */
                case '/': s[len2++] = 'd'; break;  /* / */
              }
              break;

            case '=':
              j++;
              switch (name[j - 1]) {
                case '+': s[len2++] = 'p'; break;  /* += */
                case '-': s[len2++] = 'm'; break;  /* -= */
                case '*': s[len2++] = 't'; break;  /* *= */
                case '/': s[len2++] = 'd'; break;  /* /= */
              }
              s[len2++] = 'a';
              break;

            case '-':  /* -- */
              j++;
              s[len2++] = 'm';
              s[len2++] = 'm';
              break;

            case '+':  /* ++ */
              j++;
              s[len2++] = 'p';
              s[len2++] = 'p';
              break;

            case ')':  /* () */
              j++;
              s[len2++] = 'o';
              s[len2++] = 'p';
              break;

            case ']':  /* [] */
              j++;
              s[len2++] = 'o';
              s[len2++] = 'b';
              break;
          }

          break;

        case '<':
        case '>':
          c = name[j] == '<' ? 'l' : 'g';
          s[len2++] = '_';

          switch (name[j + 1]) {
            case '\0':
              s[len2++] = c;
              s[len2++] = 't';
              break;
            case '=':
              j++;
              s[len2++] = c;
              s[len2++] = 'e';
              break;
            case '>':
              j++;
              s[len2++] = 's';
              s[len2++] = 'r';
              break;
            case '<':
              j++;
              s[len2++] = 's';
              s[len2++] = 'l';
              break;
            default:
              break;
          }
          break;

        case '_':
          if (len2 && s[len2 - 1] == '_')
            s[len2++] = 'u';
          /* fall through */

        default:
          s[len2++] = name[j];
      }

  if (s[len2 - 1] == '_')
    s[len2++] = 'u';

  s[len2] = '\0';

  return s;
}

/* Return true if DECL refers to a C++ class type for which a
   separate enclosing package has been or should be generated.  */

static bool
separate_class_package (tree decl)
{
  if (decl) 
    {
      tree type = TREE_TYPE (decl);
      return type
        && TREE_CODE (type) == RECORD_TYPE
        && (TYPE_METHODS (type) || has_static_fields (type));
    }
  else
    return false;
}

static bool package_prefix = true;

/* Dump in BUFFER the name of an identifier NODE of type TYPE, following Ada
   syntax.  LIMITED_ACCESS indicates whether NODE can be accessed via a limited
   'with' clause rather than a regular 'with' clause.  */

static void
pp_ada_tree_identifier (pretty_printer *buffer, tree node, tree type,
                        int limited_access)
{
  const char *name = IDENTIFIER_POINTER (node);
  int space_found = false;
  char *s = to_ada_name (name, &space_found);
  tree decl;

  /* If the entity is a type and comes from another file, generate "package"
     prefix.  */

  decl = get_underlying_decl (type);

  if (decl)
    {
      expanded_location xloc = expand_location (decl_sloc (decl, false));

      if (xloc.file && xloc.line)
        {
          if (xloc.file != source_file_base)
            {
              switch (TREE_CODE (type))
                {
                  case ENUMERAL_TYPE:
                  case INTEGER_TYPE:
                  case REAL_TYPE:
                  case FIXED_POINT_TYPE:
                  case BOOLEAN_TYPE:
                  case REFERENCE_TYPE:
                  case POINTER_TYPE:
                  case ARRAY_TYPE:
                  case RECORD_TYPE:
                  case UNION_TYPE:
                  case QUAL_UNION_TYPE:
                  case TYPE_DECL:
                    {
                      char *s1 = get_ada_package (xloc.file);

                      if (package_prefix)
                        {
                          append_withs (s1, limited_access);
                          pp_string (buffer, s1);
                          pp_character (buffer, '.');
                        }
                      free (s1);
                    }
                    break;
                  default:
                    break;
                }
              
              if (separate_class_package (decl))
                {
                  pp_string (buffer, "Class_");
                  pp_string (buffer, s);
                  pp_string (buffer, ".");
                }

            }
        }
    }

  if (space_found)
    if (!strcmp (s, "short_int"))
      pp_string (buffer, "short");
    else if (!strcmp (s, "short_unsigned_int"))
      pp_string (buffer, "unsigned_short");
    else if (!strcmp (s, "unsigned_int"))
      pp_string (buffer, "unsigned");
    else if (!strcmp (s, "long_int"))
      pp_string (buffer, "long");
    else if (!strcmp (s, "long_unsigned_int"))
      pp_string (buffer, "unsigned_long");
    else if (!strcmp (s, "long_long_int"))
      pp_string (buffer, "Long_Long_Integer");
    else if (!strcmp (s, "long_long_unsigned_int"))
      {
        if (package_prefix)
          {
            append_withs ("Interfaces.C.Extensions", false);
            pp_string (buffer, "Extensions.unsigned_long_long");
          }
        else
          pp_string (buffer, "unsigned_long_long");
      }
    else
      pp_string(buffer, s);
  else
    if (!strcmp (s, "bool"))
      {
        if (package_prefix)
          {
            append_withs ("Interfaces.C.Extensions", false);
            pp_string (buffer, "Extensions.bool");
          }
        else
          pp_string (buffer, "bool");
      }
    else
      pp_string(buffer, s);

  free (s);
}

/* Dump in BUFFER the assembly name of T.  */

static void
pp_asm_name (pretty_printer *buffer, tree t)
{
  tree name = DECL_ASSEMBLER_NAME (t);
  char *ada_name = XALLOCAVEC (char, IDENTIFIER_LENGTH (name) + 1), *s;
  const char *ident = IDENTIFIER_POINTER (name);

  for (s = ada_name; *ident; ident++)
    {
      if (*ident == ' ')
        break;
      else if (*ident != '*')
        *s++ = *ident;
    }

  *s = '\0';
  pp_string (buffer, ada_name);
}

/* Dump in BUFFER the name of a DECL node if set, following Ada syntax.
   LIMITED_ACCESS indicates whether NODE can be accessed via a limited
   'with' clause rather than a regular 'with' clause.  */

static void
dump_ada_decl_name (pretty_printer *buffer, tree decl, int limited_access)
{
  if (DECL_NAME (decl))
    pp_ada_tree_identifier (buffer, DECL_NAME (decl), decl, limited_access);
  else
    {
      tree type_name = TYPE_NAME (TREE_TYPE (decl));

      if (!type_name)
        {
          pp_string (buffer, "anon");
          if (TREE_CODE (decl) == FIELD_DECL)
            pp_scalar (buffer, "%d", DECL_UID (decl));
          else
            pp_scalar (buffer, "%d", TYPE_UID (TREE_TYPE (decl)));
        }
      else if (TREE_CODE (type_name) == IDENTIFIER_NODE)
        pp_ada_tree_identifier (buffer, type_name, decl, limited_access);
    }
}

/* Dump in BUFFER a name based on both T1 and T2, followed by S.  */

static void
dump_ada_double_name (pretty_printer *buffer, tree t1, tree t2, const char *s)
{
  if (DECL_NAME (t1))
    pp_ada_tree_identifier (buffer, DECL_NAME (t1), t1, false);
  else
    {
      pp_string (buffer, "anon");
      pp_scalar (buffer, "%d", TYPE_UID (TREE_TYPE (t1)));
    }

  pp_character (buffer, '_');

  if (DECL_NAME (t1))
    pp_ada_tree_identifier (buffer, DECL_NAME (t2), t2, false);
  else
    {
      pp_string (buffer, "anon");
      pp_scalar (buffer, "%d", TYPE_UID (TREE_TYPE (t2)));
    }

  pp_string (buffer, s);
}

/* Dump in BUFFER pragma Import C/CPP on a given node T.  */

static void
dump_ada_import (pretty_printer *buffer, tree t)
{
  const char *name = IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (t));
  int is_stdcall = TREE_CODE (t) == FUNCTION_DECL &&
    lookup_attribute ("stdcall", TYPE_ATTRIBUTES (TREE_TYPE (t)));

  if (is_stdcall)
    pp_string (buffer, "pragma Import (Stdcall, ");
  else if (name[0] == '_' && name[1] == 'Z')
    pp_string (buffer, "pragma Import (CPP, ");
  else
    pp_string (buffer, "pragma Import (C, ");

  dump_ada_decl_name (buffer, t, false);
  pp_string (buffer, ", \"");

  if (is_stdcall)
    pp_string (buffer, IDENTIFIER_POINTER (DECL_NAME (t)));
  else
    pp_asm_name (buffer, t);

  pp_string (buffer, "\");");
}

/* Check whether T and its type have different names, and append "the_"
   otherwise in BUFFER.  */

static void
check_name (pretty_printer *buffer, tree t)
{
  const char *s;
  tree tmp = TREE_TYPE (t);

  while (TREE_CODE (tmp) == POINTER_TYPE && !TYPE_NAME (tmp))
    tmp = TREE_TYPE (tmp);

  if (TREE_CODE (tmp) != FUNCTION_TYPE)
    {
      if (TREE_CODE (tmp) == IDENTIFIER_NODE)
        s = IDENTIFIER_POINTER (tmp);
      else if (!TYPE_NAME (tmp))
        s = "";
      else if (TREE_CODE (TYPE_NAME (tmp)) == IDENTIFIER_NODE)
        s = IDENTIFIER_POINTER (TYPE_NAME (tmp));
      else
        s = IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp)));

      if (!strcasecmp (IDENTIFIER_POINTER (DECL_NAME (t)), s))
        pp_string (buffer, "the_");
    }
}

/* Dump in BUFFER a function declaration FUNC with Ada syntax.
   IS_METHOD indicates whether FUNC is a C++ method.
   IS_CONSTRUCTOR whether FUNC is a C++ constructor.
   IS_DESTRUCTOR whether FUNC is a C++ destructor.
   SPC is the current indentation level.  */

static int
dump_ada_function_declaration (pretty_printer *buffer, tree func,
                               int is_method, int is_constructor,
                               int is_destructor, int spc)
{
  tree arg;
  const tree node = TREE_TYPE (func);
  char buf[16];
  int num = 0, num_args = 0, have_args = true, have_ellipsis = false;

  /* Compute number of arguments.  */
  arg = TYPE_ARG_TYPES (node);

  if (arg)
    {
      while (TREE_CHAIN (arg) && arg != error_mark_node)
        {
          num_args++;
          arg = TREE_CHAIN (arg);
        }

      if (TREE_CODE (TREE_VALUE (arg)) != VOID_TYPE)
        {
          num_args++;
          have_ellipsis = true;
        }
    }

  if (is_constructor)
    num_args--;

  if (is_destructor)
    num_args = 1;

  if (num_args > 2)
    newline_and_indent (buffer, spc + 1);

  if (num_args > 0)
    {
      pp_space (buffer);
      pp_character (buffer, '(');
    }

  if (TREE_CODE (func) == FUNCTION_DECL)
    arg = DECL_ARGUMENTS (func);
  else
    arg = NULL_TREE;

  if (arg == NULL_TREE)
    {
      have_args = false;
      arg = TYPE_ARG_TYPES (node);

      if (arg && TREE_CODE (TREE_VALUE (arg)) == VOID_TYPE)
        arg = NULL_TREE;
    }

  if (is_constructor)
    arg = TREE_CHAIN (arg);

  /* Print the argument names (if available) & types.  */

  for (num = 1; num <= num_args; num++)
    {
      if (have_args)
        {
          if (DECL_NAME (arg))
            {
              check_name (buffer, arg);
              pp_ada_tree_identifier (buffer, DECL_NAME (arg), 0, false);
              pp_string (buffer, " : ");
            }
          else
            {
              sprintf (buf, "arg%d : ", num);
              pp_string (buffer, buf);
            }

          dump_generic_ada_node
            (buffer, TREE_TYPE (arg), node, NULL, spc, 0, true);
        }
      else
        {
          sprintf (buf, "arg%d : ", num);
          pp_string (buffer, buf);
          dump_generic_ada_node
            (buffer, TREE_VALUE (arg), node, NULL, spc, 0, true);
        }

      if (TREE_TYPE (arg) && TREE_TYPE (TREE_TYPE (arg))
          && is_tagged_type (TREE_TYPE (TREE_TYPE (arg))))
        {
          if (!is_method
              || (num != 1 || (!DECL_VINDEX (func) && !is_constructor)))
            pp_string (buffer, "'Class");
        }

      arg = TREE_CHAIN (arg);

      if (num < num_args)
        {
          pp_character (buffer, ';');

          if (num_args > 2)
            newline_and_indent (buffer, spc + INDENT_INCR);
          else
            pp_space (buffer);
        }
    }

  if (have_ellipsis)
    {
      pp_string (buffer, "  -- , ...");
      newline_and_indent (buffer, spc + INDENT_INCR);
    }

  if (num_args > 0)
    pp_character (buffer, ')');
  return num_args;
}

/* Dump in BUFFER all the domains associated with an array NODE,
   using Ada syntax.  SPC is the current indentation level.  */

static void
dump_ada_array_domains (pretty_printer *buffer, tree node, int spc)
{
  int first = 1;
  pp_character (buffer, '(');

  for (; TREE_CODE (node) == ARRAY_TYPE; node = TREE_TYPE (node))
    {
      tree domain = TYPE_DOMAIN (node);

      if (domain)
        {
          tree min = TYPE_MIN_VALUE (domain);
          tree max = TYPE_MAX_VALUE (domain);

          if (!first)
            pp_string (buffer, ", ");
          first = 0;

          if (min)
            dump_generic_ada_node (buffer, min, NULL_TREE, NULL, spc, 0, true);
          pp_string (buffer, " .. ");

          /* If the upper bound is zero, gcc may generate a NULL_TREE
             for TYPE_MAX_VALUE rather than an integer_cst.  */
          if (max)
            dump_generic_ada_node (buffer, max, NULL_TREE, NULL, spc, 0, true);
          else
            pp_string (buffer, "0");
        }
      else
        pp_string (buffer, "size_t");
    }
  pp_character (buffer, ')');
}

/* Dump in BUFFER file:line information related to NODE.  */

static void
dump_sloc (pretty_printer *buffer, tree node)
{
  expanded_location xloc;

  xloc.file = NULL;

  if (TREE_CODE_CLASS (TREE_CODE (node)) == tcc_declaration)
    xloc = expand_location (DECL_SOURCE_LOCATION (node));
  else if (EXPR_HAS_LOCATION (node))
    xloc = expand_location (EXPR_LOCATION (node));

  if (xloc.file)
    {
      pp_string (buffer, xloc.file);
      pp_string (buffer, ":");
      pp_decimal_int (buffer, xloc.line);
    }
}

/* Return true if T designates a one dimension array of "char".  */

static bool
is_char_array (tree t)
{
  tree tmp;
  int num_dim = 0;

  /* Retrieve array's type.  */
  tmp = t;
  while (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE)
    {
      num_dim++;
      tmp = TREE_TYPE (tmp);
    }

  tmp = TREE_TYPE (tmp);
  return num_dim == 1 && TREE_CODE (tmp) == INTEGER_TYPE
    && !strcmp (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp))), "char");
}

/* Dump in BUFFER an array type T in Ada syntax.  Assume that the "type"
   keyword and name have already been printed.  SPC is the indentation
   level.  */

static void
dump_ada_array_type (pretty_printer *buffer, tree t, int spc)
{
  tree tmp;
  bool char_array = is_char_array (t);

  /* Special case char arrays.  */
  if (char_array)
    {
      pp_string (buffer, "Interfaces.C.char_array ");
    }
  else
    pp_string (buffer, "array ");

  /* Print the dimensions.  */
  dump_ada_array_domains (buffer, TREE_TYPE (t), spc);

  /* Retrieve array's type.  */
  tmp = TREE_TYPE (t);
  while (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE)
    tmp = TREE_TYPE (tmp);

  /* Print array's type.  */
  if (!char_array)
    {
      pp_string (buffer, " of ");

      if (TREE_CODE (TREE_TYPE (tmp)) != POINTER_TYPE)
        pp_string (buffer, "aliased ");

      dump_generic_ada_node
        (buffer, TREE_TYPE (tmp), TREE_TYPE (t), NULL, spc, false, true);
    }
}

/* Dump in BUFFER type names associated with a template, each prepended with
   '_'.  TYPES is the TREE_PURPOSE of a DECL_TEMPLATE_INSTANTIATIONS.
   CPP_CHECK is used to perform C++ queries on nodes.
   SPC is the indentation level.  */

static void
dump_template_types (pretty_printer *buffer, tree types,
                     int (*cpp_check)(tree, cpp_operation), int spc)
{
  size_t i;
  size_t len = TREE_VEC_LENGTH (types);

  for (i = 0; i < len; i++)
    {
      tree elem = TREE_VEC_ELT (types, i);
      pp_character (buffer, '_');
      if (!dump_generic_ada_node (buffer, elem, 0, cpp_check, spc, false, true))
        {
          pp_string (buffer, "unknown");
          pp_scalar (buffer, "%lu", (unsigned long) TREE_HASH (elem));
        }
    }
}

/* Dump in BUFFER the contents of all class instantiations associated with
   a given template T.  CPP_CHECK is used to perform C++ queries on nodes.
   SPC is the indentation level. */

static int
dump_ada_template (pretty_printer *buffer, tree t,
                   int (*cpp_check)(tree, cpp_operation), int spc)
{
  /* DECL_VINDEX is DECL_TEMPLATE_INSTANTIATIONS in this context.  */
  tree inst = DECL_VINDEX (t);
  /* DECL_RESULT_FLD is DECL_TEMPLATE_RESULT in this context.  */
  tree result = DECL_RESULT_FLD (t);
  int num_inst = 0;

  /* Don't look at template declarations declaring something coming from
     another file.  This can occur for template friend declarations.  */
  if (LOCATION_FILE (decl_sloc (result, false))
      != LOCATION_FILE (decl_sloc (t, false)))
    return 0;

  while (inst && inst != error_mark_node)
    {
      tree types = TREE_PURPOSE (inst);
      tree instance = TREE_VALUE (inst);

      if (TREE_VEC_LENGTH (types) == 0)
        break;

      if (!TYPE_P (instance) || !TYPE_METHODS (instance))
        break;

      num_inst++;
      INDENT (spc);
      pp_string (buffer, "package ");
      package_prefix = false;
      dump_generic_ada_node (buffer, instance, t, cpp_check, spc, false, true);
      dump_template_types (buffer, types, cpp_check, spc);
      pp_string (buffer, " is");
      spc += INDENT_INCR;
      newline_and_indent (buffer, spc);

      TREE_VISITED (get_underlying_decl (instance)) = 1;
      pp_string (buffer, "type ");
      dump_generic_ada_node (buffer, instance, t, cpp_check, spc, false, true);
      package_prefix = true;

      if (is_tagged_type (instance))
        pp_string (buffer, " is tagged limited ");
      else
        pp_string (buffer, " is limited ");

      dump_generic_ada_node (buffer, instance, t, cpp_check, spc, false, false);
      pp_newline (buffer);
      spc -= INDENT_INCR;
      newline_and_indent (buffer, spc);

      pp_string (buffer, "end;");
      newline_and_indent (buffer, spc);
      pp_string (buffer, "use ");
      package_prefix = false;
      dump_generic_ada_node (buffer, instance, t, cpp_check, spc, false, true);
      dump_template_types (buffer, types, cpp_check, spc);
      package_prefix = true;
      pp_semicolon (buffer);
      pp_newline (buffer);
      pp_newline (buffer);

      inst = TREE_CHAIN (inst);
    }

  return num_inst > 0;
}

/* Return true if NODE is a simple enum types, that can be mapped to an
   Ada enum type directly.  */

static bool
is_simple_enum (tree node)
{
  unsigned HOST_WIDE_INT count = 0;
  tree value;

  for (value = TYPE_VALUES (node); value; value = TREE_CHAIN (value))
    {
      tree int_val = TREE_VALUE (value);

      if (TREE_CODE (int_val) != INTEGER_CST)
        int_val = DECL_INITIAL (int_val);

      if (!host_integerp (int_val, 0))
        return false;
      else if (TREE_INT_CST_LOW (int_val) != count)
        return false;

      count++;
    }

  return true;
}

static bool in_function = true;
static bool bitfield_used = false;

/* Recursively dump in BUFFER Ada declarations corresponding to NODE of type
   TYPE.  CPP_CHECK is used to perform C++ queries on nodes.  SPC is the
   indentation level.  LIMITED_ACCESS indicates whether NODE can be referenced
   via a "limited with" clause.  NAME_ONLY indicates whether we should only
   dump the name of NODE, instead of its full declaration.  */

static int
dump_generic_ada_node (pretty_printer *buffer, tree node, tree type,
                       int (*cpp_check)(tree, cpp_operation), int spc,
                       int limited_access, bool name_only)
{
  if (node == NULL_TREE)
    return 0;

  switch (TREE_CODE (node))
    {
    case ERROR_MARK:
      pp_string (buffer, "<<< error >>>");
      return 0;

    case IDENTIFIER_NODE:
      pp_ada_tree_identifier (buffer, node, type, limited_access);
      break;

    case TREE_LIST:
      pp_string (buffer, "--- unexpected node: TREE_LIST");
      return 0;

    case TREE_BINFO:
      dump_generic_ada_node
        (buffer, BINFO_TYPE (node), type, cpp_check,
         spc, limited_access, name_only);

    case TREE_VEC:
      pp_string (buffer, "--- unexpected node: TREE_VEC");
      return 0;

    case VOID_TYPE:
      if (package_prefix)
        {
          append_withs ("System", false);
          pp_string (buffer, "System.Address");
        }
      else
        pp_string (buffer, "address");
      break;

    case VECTOR_TYPE:
      pp_string (buffer, "<vector>");
      break;

    case COMPLEX_TYPE:
      pp_string (buffer, "<complex>");
      break;

    case ENUMERAL_TYPE:
      if (name_only)
        dump_generic_ada_node
          (buffer, TYPE_NAME (node), node, cpp_check, spc, 0, true);
      else
        {
          tree value = TYPE_VALUES (node);

          if (is_simple_enum (node))
            {
              bool first = true;
              spc += INDENT_INCR;
              newline_and_indent (buffer, spc - 1);
              pp_string (buffer, "(");
              for (; value; value = TREE_CHAIN (value))
                {
                  if (first)
                    first = false;
                  else
                    {
                      pp_string (buffer, ",");
                      newline_and_indent (buffer, spc);
                    }

                  pp_ada_tree_identifier
                    (buffer, TREE_PURPOSE (value), node, false);
                }
              pp_string (buffer, ");");
              spc -= INDENT_INCR;
              newline_and_indent (buffer, spc);
              pp_string (buffer, "pragma Convention (C, ");
              dump_generic_ada_node
                (buffer, DECL_NAME (type) ? type : TYPE_NAME (node), type,
                 cpp_check, spc, 0, true);
              pp_string (buffer, ")");
            }
          else
            {
              pp_string (buffer, "unsigned");
              for (; value; value = TREE_CHAIN (value))
                {
                  pp_semicolon (buffer);
                  newline_and_indent (buffer, spc);

                  pp_ada_tree_identifier
                    (buffer, TREE_PURPOSE (value), node, false);
                  pp_string (buffer, " : constant ");

                  dump_generic_ada_node
                    (buffer, DECL_NAME (type) ? type : TYPE_NAME (node), type,
                     cpp_check, spc, 0, true);

                  pp_string (buffer, " := ");
                  dump_generic_ada_node
                    (buffer,
                     TREE_CODE (TREE_VALUE (value)) == INTEGER_CST ?
                       TREE_VALUE (value) : DECL_INITIAL (TREE_VALUE (value)),
                     node, cpp_check, spc, false, true);
                }
            }
        }
      break;

    case INTEGER_TYPE:
    case REAL_TYPE:
    case FIXED_POINT_TYPE:
    case BOOLEAN_TYPE:
      {
        enum tree_code_class tclass;

        tclass = TREE_CODE_CLASS (TREE_CODE (node));

        if (tclass == tcc_declaration)
          {
            if (DECL_NAME (node))
              pp_ada_tree_identifier
                (buffer, DECL_NAME (node), 0, limited_access);
            else
              pp_string (buffer, "<unnamed type decl>");
          }
        else if (tclass == tcc_type)
          {
            if (TYPE_NAME (node))
              {
                if (TREE_CODE (TYPE_NAME (node)) == IDENTIFIER_NODE)
                  pp_ada_tree_identifier (buffer, TYPE_NAME (node),
                                          node, limited_access);
                else if (TREE_CODE (TYPE_NAME (node)) == TYPE_DECL
                         && DECL_NAME (TYPE_NAME (node)))
                  dump_ada_decl_name (buffer, TYPE_NAME (node), limited_access);
                else
                  pp_string (buffer, "<unnamed type>");
              }
            else if (TREE_CODE (node) == INTEGER_TYPE)
              {
                append_withs ("Interfaces.C.Extensions", false);
                bitfield_used = true;

                if (TYPE_PRECISION (node) == 1)
                  pp_string (buffer, "Extensions.Unsigned_1");
                else
                  {
                    pp_string (buffer, (TYPE_UNSIGNED (node)
                                        ? "Extensions.Unsigned_"
                                        : "Extensions.Signed_"));
                    pp_decimal_int (buffer, TYPE_PRECISION (node));
                  }
              }
            else
              pp_string (buffer, "<unnamed type>");
          }
        break;
      }

    case POINTER_TYPE:
    case REFERENCE_TYPE:
      if (name_only && TYPE_NAME (node))
        dump_generic_ada_node
          (buffer, TYPE_NAME (node), node, cpp_check,
           spc, limited_access, true);

      else if (TREE_CODE (TREE_TYPE (node)) == FUNCTION_TYPE)
        {
          tree fnode = TREE_TYPE (node);
          bool is_function;
          bool prev_in_function = in_function;

          if (VOID_TYPE_P (TREE_TYPE (fnode)))
            {
              is_function = false;
              pp_string (buffer, "access procedure");
            }
          else
            {
              is_function = true;
              pp_string (buffer, "access function");
            }

          in_function = is_function;
          dump_ada_function_declaration
            (buffer, node, false, false, false, spc + INDENT_INCR);
          in_function = prev_in_function;

          if (is_function)
            {
              pp_string (buffer, " return ");
              dump_generic_ada_node
                (buffer, TREE_TYPE (fnode), type, cpp_check, spc, 0, true);
            }

            /* If we are dumping the full type, it means we are part of a
               type definition and need also a Convention C pragma.  */
            if (!name_only)
              {
                pp_semicolon (buffer);
                newline_and_indent (buffer, spc);
                pp_string (buffer, "pragma Convention (C, ");
                dump_generic_ada_node
                  (buffer, type, 0, cpp_check, spc, false, true);
                pp_string (buffer, ")");
              }
        }
      else
        {
          int is_access = false;
          unsigned int quals = TYPE_QUALS (TREE_TYPE (node));

          if (VOID_TYPE_P (TREE_TYPE (node)))
            {
              if (!name_only)
                pp_string (buffer, "new ");
              if (package_prefix)
                {
                  append_withs ("System", false);
                  pp_string (buffer, "System.Address");
                }
              else
                pp_string (buffer, "address");
            }
          else
            {
              if (TREE_CODE (node) == POINTER_TYPE
                  && TREE_CODE (TREE_TYPE (node)) == INTEGER_TYPE
                  && !strcmp
                        (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME
                          (TREE_TYPE (node)))), "char"))
                {
                  if (!name_only)
                    pp_string (buffer, "new ");

                  if (package_prefix)
                    {
                      pp_string (buffer, "Interfaces.C.Strings.chars_ptr");
                      append_withs ("Interfaces.C.Strings", false);
                    }
                  else
                    pp_string (buffer, "chars_ptr");
                }
              else
                {
                  /* For now, handle all access-to-access or
                     access-to-unknown-structs as opaque system.address.  */

                  tree type_name = TYPE_NAME (TREE_TYPE (node));
                  const_tree typ2 = !type ||
                    DECL_P (type) ? type : TYPE_NAME (type);
                  const_tree underlying_type =
                    get_underlying_decl (TREE_TYPE (node));

                  if (TREE_CODE (TREE_TYPE (node)) == POINTER_TYPE
                      /* Pointer to pointer.  */

                      || (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node))
                          && (!underlying_type
                              || !TYPE_FIELDS (TREE_TYPE (underlying_type))))
                      /* Pointer to opaque structure.  */

                      || underlying_type == NULL_TREE
                      || (!typ2
                          && !TREE_VISITED (underlying_type)
                          && !TREE_VISITED (type_name)
                          && !is_tagged_type (TREE_TYPE (node))
                          && DECL_SOURCE_FILE (underlying_type)
                               == source_file_base)
                      || (type_name && typ2
                          && DECL_P (underlying_type)
                          && DECL_P (typ2)
                          && decl_sloc (underlying_type, true)
                               > decl_sloc (typ2, true)
                          && DECL_SOURCE_FILE (underlying_type)
                               == DECL_SOURCE_FILE (typ2)))
                    {
                      if (package_prefix)
                        {
                          append_withs ("System", false);
                          if (!name_only)
                            pp_string (buffer, "new ");
                          pp_string (buffer, "System.Address");
                        }
                      else
                        pp_string (buffer, "address");
                      return spc;
                    }

                  if (!package_prefix)
                    pp_string (buffer, "access");
                  else if (AGGREGATE_TYPE_P (TREE_TYPE (node)))
                    {
                      if (!type || TREE_CODE (type) != FUNCTION_DECL)
                        {
                          pp_string (buffer, "access ");
                          is_access = true;

                          if (quals & TYPE_QUAL_CONST)
                            pp_string (buffer, "constant ");
                          else if (!name_only)
                            pp_string (buffer, "all ");
                        }
                      else if (quals & TYPE_QUAL_CONST)
                        pp_string (buffer, "in ");
                      else if (in_function)
                        {
                          is_access = true;
                          pp_string (buffer, "access ");
                        }
                      else
                        {
                          is_access = true;
                          pp_string (buffer, "access ");
                          /* ??? should be configurable: access or in out.  */
                        }
                    }
                  else
                    {
                      is_access = true;
                      pp_string (buffer, "access ");

                      if (!name_only)
                        pp_string (buffer, "all ");
                    }

                  if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node))
                      && type_name != NULL_TREE)
                    dump_generic_ada_node
                      (buffer, type_name,
                       TREE_TYPE (node), cpp_check, spc, is_access, true);
                  else
                    dump_generic_ada_node
                      (buffer, TREE_TYPE (node), TREE_TYPE (node),
                       cpp_check, spc, 0, true);
                }
            }
        }
      break;

    case ARRAY_TYPE:
      if (name_only)
        dump_generic_ada_node
          (buffer, TYPE_NAME (node), node, cpp_check,
           spc, limited_access, true);
      else
        dump_ada_array_type (buffer, node, spc);
      break;

    case RECORD_TYPE:
    case UNION_TYPE:
    case QUAL_UNION_TYPE:
      if (name_only)
        {
          if (TYPE_NAME (node))
            dump_generic_ada_node
              (buffer, TYPE_NAME (node), node, cpp_check,
               spc, limited_access, true);
          else
            {
              pp_string (buffer, "anon_");
              pp_scalar (buffer, "%d", TYPE_UID (node));
            }
        }
      else
        print_ada_struct_decl
          (buffer, node, type, cpp_check, spc, true);
      break;

    case INTEGER_CST:
      /* We treat the upper half of the sizetype range as negative.  This
         is consistent with the internal treatment and makes it possible
         to generate the (0 .. -1) range for flexible array members.  */
      if (TREE_TYPE (node) == sizetype)
        node = fold_convert (ssizetype, node);
      if (host_integerp (node, 0))
        pp_wide_integer (buffer, TREE_INT_CST_LOW (node));
      else if (host_integerp (node, 1))
        pp_unsigned_wide_integer (buffer, TREE_INT_CST_LOW (node));
      else
        {
          tree val = node;
          unsigned HOST_WIDE_INT low = TREE_INT_CST_LOW (val);
          HOST_WIDE_INT high = TREE_INT_CST_HIGH (val);

          if (tree_int_cst_sgn (val) < 0)
            {
              pp_character (buffer, '-');
              high = ~high + !low;
              low = -low;
            }
          sprintf (pp_buffer (buffer)->digit_buffer,
                   ADA_HOST_WIDE_INT_PRINT_DOUBLE_HEX,
                   (unsigned HOST_WIDE_INT) high, low);
          pp_string (buffer, pp_buffer (buffer)->digit_buffer);
        }
      break;

    case REAL_CST:
    case FIXED_CST:
    case COMPLEX_CST:
    case STRING_CST:
    case VECTOR_CST:
      return 0;

    case FUNCTION_DECL:
    case CONST_DECL:
      dump_ada_decl_name (buffer, node, limited_access);
      break;

    case TYPE_DECL:
      if (DECL_IS_BUILTIN (node))
        {
          /* Don't print the declaration of built-in types.  */

          if (name_only)
            {
              /* If we're in the middle of a declaration, defaults to
                 System.Address.  */
              if (package_prefix)
                {
                  append_withs ("System", false);
                  pp_string (buffer, "System.Address");
                }
              else
                pp_string (buffer, "address");
            }
          break;
        }

      if (name_only)
        dump_ada_decl_name (buffer, node, limited_access);
      else
        {
          if (is_tagged_type (TREE_TYPE (node)))
            {
              tree tmp = TYPE_FIELDS (TREE_TYPE (node));
              int first = 1;

              /* Look for ancestors.  */
              for (; tmp; tmp = TREE_CHAIN (tmp))
                {
                  if (!DECL_NAME (tmp) && is_tagged_type (TREE_TYPE (tmp)))
                    {
                      if (first)
                        {
                          pp_string (buffer, "limited new ");
                          first = 0;
                        }
                      else
                        pp_string (buffer, " and ");

                      dump_ada_decl_name
                        (buffer, TYPE_NAME (TREE_TYPE (tmp)), false);
                    }
                }

              pp_string (buffer, first ? "tagged limited " : " with ");
            }
          else if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node))
                   && TYPE_METHODS (TREE_TYPE (node)))
            pp_string (buffer, "limited ");

          dump_generic_ada_node
            (buffer, TREE_TYPE (node), type, cpp_check, spc, false, false);
        }
      break;

    case VAR_DECL:
    case PARM_DECL:
    case FIELD_DECL:
    case NAMESPACE_DECL:
      dump_ada_decl_name (buffer, node, false);
      break;

    default:
      /* Ignore other nodes (e.g. expressions).  */
      return 0;
    }

  return 1;
}

/* Dump in BUFFER NODE's methods.  CPP_CHECK is used to perform C++ queries on
   nodes.  SPC is the indentation level.  */

static void
print_ada_methods (pretty_printer *buffer, tree node,
                   int (*cpp_check)(tree, cpp_operation), int spc)
{
  tree tmp = TYPE_METHODS (node);
  int res = 1;

  if (tmp)
    {
      pp_semicolon (buffer);

      for (; tmp; tmp = TREE_CHAIN (tmp))
        {
          if (res)
            {
              pp_newline (buffer);
              pp_newline (buffer);
            }
          res = print_ada_declaration (buffer, tmp, node, cpp_check, spc);
        }
    }
}

/* Dump in BUFFER anonymous types nested inside T's definition.
   PARENT is the parent node of T.
   FORWARD indicates whether a forward declaration of T should be generated.
   CPP_CHECK is used to perform C++ queries on
   nodes.  SPC is the indentation level.  */

static void
dump_nested_types (pretty_printer *buffer, tree t, tree parent, bool forward,
                   int (*cpp_check)(tree, cpp_operation), int spc)
{
  tree field, outer, decl;

  /* Avoid recursing over the same tree.  */
  if (TREE_VISITED (t))
    return;

  /* Find possible anonymous arrays/unions/structs recursively.  */

  outer = TREE_TYPE (t);

  if (outer == NULL_TREE)
    return;

  if (forward)
    {
      pp_string (buffer, "type ");
      dump_generic_ada_node
        (buffer, t, t, cpp_check, spc, false, true);
      pp_semicolon (buffer);
      newline_and_indent (buffer, spc);
      TREE_VISITED (t) = 1;
    }

  field = TYPE_FIELDS (outer);
  while (field)
    {
      if ((TREE_TYPE (field) != outer
           || (TREE_CODE (TREE_TYPE (field)) == POINTER_TYPE
               && TREE_TYPE (TREE_TYPE (field)) != outer))
           && (!TYPE_NAME (TREE_TYPE (field))
              || (TREE_CODE (field) == TYPE_DECL
                  && DECL_NAME (field) != DECL_NAME (t)
                  && TYPE_NAME (TREE_TYPE (field)) != TYPE_NAME (outer))))
        {
          switch (TREE_CODE (TREE_TYPE (field)))
            {
              case POINTER_TYPE:
                decl = TREE_TYPE (TREE_TYPE (field));

                if (TREE_CODE (decl) == FUNCTION_TYPE)
                  for (decl = TREE_TYPE (decl);
                       decl && TREE_CODE (decl) == POINTER_TYPE;
                       decl = TREE_TYPE (decl))
                    ;

                decl = get_underlying_decl (decl);

                if (decl
                    && DECL_P (decl)
                    && decl_sloc (decl, true) > decl_sloc (t, true)
                    && DECL_SOURCE_FILE (decl) == DECL_SOURCE_FILE (t)
                    && !TREE_VISITED (decl)
                    && !DECL_IS_BUILTIN (decl)
                    && (!RECORD_OR_UNION_TYPE_P (TREE_TYPE (decl))
                        || TYPE_FIELDS (TREE_TYPE (decl))))
                  {
                    /* Generate forward declaration.  */

                    pp_string (buffer, "type ");
                    dump_generic_ada_node
                      (buffer, decl, 0, cpp_check, spc, false, true);
                    pp_semicolon (buffer);
                    newline_and_indent (buffer, spc);

                    /* Ensure we do not generate duplicate forward
                       declarations for this type.  */
                    TREE_VISITED (decl) = 1;
                  }
                break;

              case ARRAY_TYPE:
                /* Special case char arrays.  */
                if (is_char_array (field))
                  pp_string (buffer, "sub");

                pp_string (buffer, "type ");
                dump_ada_double_name (buffer, parent, field, "_array is ");
                dump_ada_array_type (buffer, field, spc);
                pp_semicolon (buffer);
                newline_and_indent (buffer, spc);
                break;

              case UNION_TYPE:
                TREE_VISITED (t) = 1;
                dump_nested_types (buffer, field, t, false, cpp_check, spc);

                pp_string (buffer, "type ");

                if (TYPE_NAME (TREE_TYPE (field)))
                  {
                    dump_generic_ada_node
                      (buffer, TYPE_NAME (TREE_TYPE (field)), 0, cpp_check,
                       spc, false, true);
                    pp_string (buffer, " (discr : unsigned := 0) is ");
                    print_ada_struct_decl
                      (buffer, TREE_TYPE (field), t, cpp_check, spc, false);

                    pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
                    dump_generic_ada_node
                      (buffer, TREE_TYPE (field), 0, cpp_check,
                       spc, false, true);
                    pp_string (buffer, ");");
                    newline_and_indent (buffer, spc);

                    pp_string (buffer, "pragma Unchecked_Union (");
                    dump_generic_ada_node
                      (buffer, TREE_TYPE (field), 0, cpp_check,
                       spc, false, true);
                    pp_string (buffer, ");");
                  }
                else
                  {
                    dump_ada_double_name
                      (buffer, parent, field,
                        "_union (discr : unsigned := 0) is ");
                    print_ada_struct_decl
                      (buffer, TREE_TYPE (field), t, cpp_check, spc, false);
                    pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
                    dump_ada_double_name (buffer, parent, field, "_union);");
                    newline_and_indent (buffer, spc);

                    pp_string (buffer, "pragma Unchecked_Union (");
                    dump_ada_double_name (buffer, parent, field, "_union);");
                  }

                newline_and_indent (buffer, spc);
                break;

              case RECORD_TYPE:
                if (TYPE_NAME (TREE_TYPE (t)) && !TREE_VISITED (t))
                  {
                    pp_string (buffer, "type ");
                    dump_generic_ada_node
                      (buffer, t, parent, 0, spc, false, true);
                    pp_semicolon (buffer);
                    newline_and_indent (buffer, spc);
                  }

                TREE_VISITED (t) = 1;
                dump_nested_types (buffer, field, t, false, cpp_check, spc);
                pp_string (buffer, "type ");

                if (TYPE_NAME (TREE_TYPE (field)))
                  {
                    dump_generic_ada_node
                      (buffer, TREE_TYPE (field), 0, cpp_check,
                       spc, false, true);
                    pp_string (buffer, " is ");
                    print_ada_struct_decl
                      (buffer, TREE_TYPE (field), t, cpp_check, spc, false);
                    pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
                    dump_generic_ada_node
                      (buffer, TREE_TYPE (field), 0, cpp_check,
                       spc, false, true);
                    pp_string (buffer, ");");
                  }
                else
                  {
                    dump_ada_double_name
                      (buffer, parent, field, "_struct is ");
                    print_ada_struct_decl
                      (buffer, TREE_TYPE (field), t, cpp_check, spc, false);
                    pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
                    dump_ada_double_name (buffer, parent, field, "_struct);");
                  }

                newline_and_indent (buffer, spc);
                break;

              default:
                break;
            }
        }
      field = TREE_CHAIN (field);
    }

  TREE_VISITED (t) = 1;
}

/* Dump in BUFFER destructor spec corresponding to T.  */

static void
print_destructor (pretty_printer *buffer, tree t)
{
  const char *s = IDENTIFIER_POINTER (DECL_NAME (t));

  if (*s == '_')
    for (s += 2; *s != ' '; s++)
      pp_character (buffer, *s);
  else
    {
      pp_string (buffer, "Delete_");
      pp_ada_tree_identifier (buffer, DECL_NAME (t), t, false);
    }
}

/* Return the name of type T.  */

static const char *
type_name (tree t)
{
  tree n = TYPE_NAME (t);

  if (TREE_CODE (n) == IDENTIFIER_NODE)
    return IDENTIFIER_POINTER (n);
  else
    return IDENTIFIER_POINTER (DECL_NAME (n));
}

/* Print in BUFFER the declaration of a variable T of type TYPE in Ada syntax.
   CPP_CHECK is used to perform C++ queries on nodes.  SPC is the indentation
   level.  Return 1 if a declaration was printed, 0 otherwise.  */

static int
print_ada_declaration (pretty_printer *buffer, tree t, tree type,
                       int (*cpp_check)(tree, cpp_operation), int spc)
{
  int is_var = 0, need_indent = 0;
  int is_class = false;
  tree name = TYPE_NAME (TREE_TYPE (t));
  tree decl_name = DECL_NAME (t);
  tree orig = NULL_TREE;

  if (cpp_check && cpp_check (t, IS_TEMPLATE))
    return dump_ada_template (buffer, t, cpp_check, spc);

  if (TREE_CODE (t) == CONST_DECL && TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE)
    /* Skip enumeral values: will be handled as part of the type itself.  */
    return 0;

  if (TREE_CODE (t) == TYPE_DECL)
    {
      orig = DECL_ORIGINAL_TYPE (t);

      if (orig && TYPE_STUB_DECL (orig))
        {
          tree stub = TYPE_STUB_DECL (orig);
          tree typ = TREE_TYPE (stub);

          if (TYPE_NAME (typ))
            {
              /* If types have same representation, and same name (ignoring
                 casing), then ignore the second type.  */
              if (type_name (typ) == type_name (TREE_TYPE (t))
                  || !strcasecmp (type_name (typ), type_name (TREE_TYPE (t))))
                return 0;

              INDENT (spc);

              if (RECORD_OR_UNION_TYPE_P (typ) && !TYPE_FIELDS (typ))
                {
                  pp_string (buffer, "--  skipped empty struct ");
                  dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
                }
              else
                {
                  if (!TREE_VISITED (stub)
                      && DECL_SOURCE_FILE (stub) == source_file_base)
                    dump_nested_types
                      (buffer, stub, stub, true, cpp_check, spc);

                  pp_string (buffer, "subtype ");
                  dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
                  pp_string (buffer, " is ");
                  dump_generic_ada_node
                    (buffer, typ, type, 0, spc, false, true);
                  pp_semicolon (buffer);
                }
              return 1;
            }
        }

      /* Skip unnamed or anonymous structs/unions/enum types.  */
      if (!orig && !decl_name && !name)
        {
          tree tmp;
          location_t sloc;

          if (cpp_check || TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE)
            return 0;

          if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t)))
            {
              /* Search next items until finding a named type decl.  */
              sloc = decl_sloc_common (t, true, true);

              for (tmp = TREE_CHAIN (t); tmp; tmp = TREE_CHAIN (tmp))
                {
                  if (TREE_CODE (tmp) == TYPE_DECL
                      && (DECL_NAME (tmp) || TYPE_NAME (TREE_TYPE (tmp))))
                    {
                      /* If same sloc, it means we can ignore the anonymous
                         struct.  */
                      if (decl_sloc_common (tmp, true, true) == sloc)
                        return 0;
                      else
                        break;
                    }
                }
              if (tmp == NULL)
                return 0;
            }
        }

      if (!orig
          && TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE
          && decl_name
          && (*IDENTIFIER_POINTER (decl_name) == '.'
              || *IDENTIFIER_POINTER (decl_name) == '$'))
        /* Skip anonymous enum types (duplicates of real types).  */
        return 0;

      INDENT (spc);

      switch (TREE_CODE (TREE_TYPE (t)))
        {
          case RECORD_TYPE:
          case UNION_TYPE:
          case QUAL_UNION_TYPE:
            /* Skip empty structs (typically forward references to real
               structs).  */
            if (!TYPE_FIELDS (TREE_TYPE (t)))
              {
                pp_string (buffer, "--  skipped empty struct ");
                dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
                return 1;
              }

            if (decl_name
                && (*IDENTIFIER_POINTER (decl_name) == '.'
                    || *IDENTIFIER_POINTER (decl_name) == '$'))
              {
                pp_string (buffer, "--  skipped anonymous struct ");
                dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
                TREE_VISITED (t) = 1;
                return 1;
              }

            if (orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
              pp_string (buffer, "subtype ");
            else
              {
                dump_nested_types (buffer, t, t, false, cpp_check, spc);

                if (separate_class_package (t))
                  {
                    is_class = true;
                    pp_string (buffer, "package Class_");
                    dump_generic_ada_node
                      (buffer, t, type, 0, spc, false, true);
                    pp_string (buffer, " is");
                    spc += INDENT_INCR;
                    newline_and_indent (buffer, spc);
                  }

                pp_string (buffer, "type ");
              }
            break;

          case ARRAY_TYPE:
          case POINTER_TYPE:
          case REFERENCE_TYPE:
            if ((orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
                || is_char_array (t))
              pp_string (buffer, "subtype ");
            else
              pp_string (buffer, "type ");
            break;

          case FUNCTION_TYPE:
            pp_string (buffer, "--  skipped function type ");
            dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
            return 1;
            break;

          case ENUMERAL_TYPE:
            if ((orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
                || !is_simple_enum (TREE_TYPE (t)))
              pp_string (buffer, "subtype ");
            else
              pp_string (buffer, "type ");
            break;

          default:
            pp_string (buffer, "subtype ");
        }
      TREE_VISITED (t) = 1;
    }
  else
    {
      if (TREE_CODE (t) == VAR_DECL
          && decl_name
          && *IDENTIFIER_POINTER (decl_name) == '_')
        return 0;

      need_indent = 1;
    }

  /* Print the type and name.  */
  if (TREE_CODE (TREE_TYPE (t)) == ARRAY_TYPE)
    {
      if (need_indent)
        INDENT (spc);

      /* Print variable's name.  */
      dump_generic_ada_node (buffer, t, type, cpp_check, spc, false, true);

      if (TREE_CODE (t) == TYPE_DECL)
        {
          pp_string (buffer, " is ");

          if (orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
            dump_generic_ada_node
              (buffer, TYPE_NAME (orig), type,
               cpp_check, spc, false, true);
          else
            dump_ada_array_type (buffer, t, spc);
        }
      else
        {
          tree tmp = TYPE_NAME (TREE_TYPE (t));

          if (spc == INDENT_INCR || TREE_STATIC (t))
            is_var = 1;

          pp_string (buffer, " : ");

          if (tmp)
            {
              if (TREE_CODE (TREE_TYPE (tmp)) != POINTER_TYPE
                  && TREE_CODE (tmp) != INTEGER_TYPE)
                pp_string (buffer, "aliased ");

              dump_generic_ada_node (buffer, tmp, type, 0, spc, false, true);
            }
          else
            {
              pp_string (buffer, "aliased ");

              if (!type)
                dump_ada_array_type (buffer, t, spc);
              else
                dump_ada_double_name (buffer, type, t, "_array");
            }
        }
    }
  else if (TREE_CODE (t) == FUNCTION_DECL)
    {
      bool is_function = true, is_method, is_abstract_class = false;
      tree decl_name = DECL_NAME (t);
      int prev_in_function = in_function;
      bool is_abstract = false;
      bool is_constructor = false;
      bool is_destructor = false;
      bool is_copy_constructor = false;

      if (!decl_name)
        return 0;

      if (cpp_check)
        {
          is_abstract = cpp_check (t, IS_ABSTRACT);
          is_constructor = cpp_check (t, IS_CONSTRUCTOR);
          is_destructor = cpp_check (t, IS_DESTRUCTOR);
          is_copy_constructor = cpp_check (t, IS_COPY_CONSTRUCTOR);
        }

      /* Skip __comp_dtor destructor which is redundant with the '~class()'
         destructor.  */
      if (is_destructor
          && !strncmp (IDENTIFIER_POINTER (decl_name), "__comp", 6))
        return 0;

      /* Skip copy constructors: some are internal only, and those that are
         not cannot be called easily from Ada anyway.  */
      if (is_copy_constructor)
        return 0;

      /* If this function has an entry in the dispatch table, we cannot
         omit it.  */
      if (!DECL_VINDEX (t) && *IDENTIFIER_POINTER (decl_name) == '_')
        {
          if (IDENTIFIER_POINTER (decl_name)[1] == '_')
            return 0;

          INDENT (spc);
          pp_string (buffer, "--  skipped func ");
          pp_string (buffer, IDENTIFIER_POINTER (decl_name));
          return 1;
        }

      if (need_indent)
        INDENT (spc);

      if (is_constructor)
        pp_string (buffer, "function New_");
      else if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t))))
        {
          is_function = false;
          pp_string (buffer, "procedure ");
        }
      else
        pp_string (buffer, "function ");

      in_function = is_function;
      is_method = TREE_CODE (TREE_TYPE (t)) == METHOD_TYPE;

      if (is_destructor)
        print_destructor (buffer, t);
      else
        dump_ada_decl_name (buffer, t, false);

      dump_ada_function_declaration
        (buffer, t, is_method, is_constructor, is_destructor, spc);
      in_function = prev_in_function;

      if (is_function)
        {
          pp_string (buffer, " return ");

          if (is_constructor)
            {
              dump_ada_decl_name (buffer, t, false);
            }
          else
            {
              dump_generic_ada_node
                (buffer, TREE_TYPE (TREE_TYPE (t)), type, cpp_check,
                 spc, false, true);
            }
        }

      if (is_constructor && cpp_check && type
          && AGGREGATE_TYPE_P (type)
          && TYPE_METHODS (type))
        {
          tree tmp = TYPE_METHODS (type);

          for (; tmp; tmp = TREE_CHAIN (tmp))
            if (cpp_check (tmp, IS_ABSTRACT))
              {
                is_abstract_class = 1;
                break;
              }
        }

      if (is_abstract || is_abstract_class)
        pp_string (buffer, " is abstract");

      pp_semicolon (buffer);
      pp_string (buffer, "  -- ");
      dump_sloc (buffer, t);

      if (is_abstract)
        return 1;

      newline_and_indent (buffer, spc);

      if (is_constructor)
        {
          pp_string (buffer, "pragma CPP_Constructor (New_");
          dump_ada_decl_name (buffer, t, false);
          pp_string (buffer, ", \"");
          pp_asm_name (buffer, t);
          pp_string (buffer, "\");");
        }
      else if (is_destructor)
        {
          pp_string (buffer, "pragma Import (CPP, ");
          print_destructor (buffer, t);
          pp_string (buffer, ", \"");
          pp_asm_name (buffer, t);
          pp_string (buffer, "\");");
        }
      else
        {
          dump_ada_import (buffer, t);
        }

      return 1;
    }
  else if (TREE_CODE (t) == TYPE_DECL && !DECL_ORIGINAL_TYPE (t))
    {
      int is_interface = 0;
      int is_abstract_record = 0;

      if (need_indent)
        INDENT (spc);

      /* Anonymous structs/unions */
      dump_generic_ada_node
        (buffer, TREE_TYPE (t), t, cpp_check, spc, false, true);

      if (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE
          || TREE_CODE (TREE_TYPE (t)) == QUAL_UNION_TYPE)
        {
          pp_string (buffer, " (discr : unsigned := 0)");
        }

      pp_string (buffer, " is ");

      /* Check whether we have an Ada interface compatible class.  */
      if (cpp_check && AGGREGATE_TYPE_P (TREE_TYPE (t))
          && TYPE_METHODS (TREE_TYPE (t)))
        {
          int num_fields = 0;
          tree tmp = TYPE_FIELDS (TREE_TYPE (t));

          /* Check that there are no fields other than the virtual table.  */
          for (; tmp; tmp = TREE_CHAIN (tmp))
            {
              if (TREE_CODE (tmp) == TYPE_DECL)
                continue;
              num_fields++;
            }

          if (num_fields == 1)
            is_interface = 1;

          /* Also check that there are only virtual methods.  */
          for (tmp = TYPE_METHODS (TREE_TYPE (t)); tmp; tmp = TREE_CHAIN (tmp))
            {
              if (cpp_check (tmp, IS_ABSTRACT))
                is_abstract_record = 1;
              else
                is_interface = 0;
            }
        }

      TREE_VISITED (t) = 1; 
      if (is_interface)
        {
          pp_string (buffer, "limited interface;  -- ");
          dump_sloc (buffer, t);
          newline_and_indent (buffer, spc);
          pp_string (buffer, "pragma Import (CPP, ");
          dump_generic_ada_node
            (buffer, TYPE_NAME (TREE_TYPE (t)), type, cpp_check,
             spc, false, true);
          pp_character (buffer, ')');

          print_ada_methods (buffer, TREE_TYPE (t), cpp_check, spc);
        }
      else
        {
          if (is_abstract_record)
            pp_string (buffer, "abstract ");
          dump_generic_ada_node (buffer, t, t, cpp_check, spc, false, false);
        }
    }
  else
    {
      if (need_indent)
        INDENT (spc);

      if (TREE_CODE (t) == FIELD_DECL && DECL_NAME (t))
        check_name (buffer, t);

      /* Print variable/type's name.  */
      dump_generic_ada_node (buffer, t, t, cpp_check, spc, false, true);

      if (TREE_CODE (t) == TYPE_DECL)
        {
          tree orig = DECL_ORIGINAL_TYPE (t);
          int is_subtype = orig && TYPE_NAME (orig) && orig != TREE_TYPE (t);

          if (!is_subtype
              && (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE
                  || TREE_CODE (TREE_TYPE (t)) == QUAL_UNION_TYPE))
            pp_string (buffer, " (discr : unsigned := 0)");

          pp_string (buffer, " is ");

          dump_generic_ada_node
            (buffer, orig, t, cpp_check, spc, false, is_subtype);
        }
      else
        {
          if (spc == INDENT_INCR || TREE_STATIC (t))
            is_var = 1;

          pp_string (buffer, " : ");

          /* Print type declaration.  */

          if (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE
              && !TYPE_NAME (TREE_TYPE (t)))
            {
              dump_ada_double_name (buffer, type, t, "_union");
            }
          else if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t)))
            {
              if (TREE_CODE (TREE_TYPE (t)) == RECORD_TYPE)
                pp_string (buffer, "aliased ");

              dump_generic_ada_node
                (buffer, TREE_TYPE (t), t, cpp_check, spc, false, true);
            }
          else
            {
              if (TREE_CODE (TREE_TYPE (t)) != POINTER_TYPE
                  && (TYPE_NAME (TREE_TYPE (t))
                      || TREE_CODE (TREE_TYPE (t)) != INTEGER_TYPE))
                pp_string (buffer, "aliased ");

              dump_generic_ada_node
                (buffer, TREE_TYPE (t), TREE_TYPE (t), cpp_check,
                 spc, false, true);
            }
        }
    }

  if (is_class)
    {
      spc -= 3;
      newline_and_indent (buffer, spc);
      pp_string (buffer, "end;");
      newline_and_indent (buffer, spc);
      pp_string (buffer, "use Class_");
      dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
      pp_semicolon (buffer);
      pp_newline (buffer);

      /* All needed indentation/newline performed already, so return 0.  */
      return 0;
    }
  else
    {
      pp_string (buffer, ";  -- ");
      dump_sloc (buffer, t);
    }

  if (is_var)
    {
      newline_and_indent (buffer, spc);
      dump_ada_import (buffer, t);
    }

  return 1;
}

/* Prints in BUFFER a structure NODE of type TYPE: name, fields, and methods
   with Ada syntax.  CPP_CHECK is used to perform C++ queries on nodes.  SPC
   is the indentation level.  If DISPLAY_CONVENTION is true, also print the
   pragma Convention for NODE.  */

static void
print_ada_struct_decl (pretty_printer *buffer, tree node, tree type,
                       int (*cpp_check)(tree, cpp_operation), int spc,
                       bool display_convention)
{
  tree tmp;
  int is_union =
    TREE_CODE (node) == UNION_TYPE || TREE_CODE (node) == QUAL_UNION_TYPE;
  char buf[32];
  int field_num = 0;
  int field_spc = spc + INDENT_INCR;
  int need_semicolon;

  bitfield_used = false;

  if (!TYPE_FIELDS (node))
    pp_string (buffer, "null record;");
  else
    {
      pp_string (buffer, "record");

      /* Print the contents of the structure.  */

      if (is_union)
        {
          newline_and_indent (buffer, spc + INDENT_INCR);
          pp_string (buffer, "case discr is");
          field_spc = spc + INDENT_INCR * 3;
        }

      pp_newline (buffer);

      /* Print the non-static fields of the structure.  */
      for (tmp = TYPE_FIELDS (node); tmp; tmp = TREE_CHAIN (tmp))
        {
          /* Add parent field if needed.  */
          if (!DECL_NAME (tmp))
            {
              if (!is_tagged_type (TREE_TYPE (tmp)))
                {
                  if (!TYPE_NAME (TREE_TYPE (tmp)))
                    print_ada_declaration
                      (buffer, tmp, type, cpp_check, field_spc);
                  else
                    {
                      INDENT (field_spc);

                      if (field_num == 0)
                        pp_string (buffer, "parent : aliased ");
                      else
                        {
                          sprintf (buf, "field_%d : aliased ", field_num + 1);
                          pp_string (buffer, buf);
                        }
                      dump_ada_decl_name
                        (buffer, TYPE_NAME (TREE_TYPE (tmp)), false);
                      pp_semicolon (buffer);
                    }
                  pp_newline (buffer);
                  field_num++;
                }
            }
          /* Avoid printing the structure recursively.  */
          else if ((TREE_TYPE (tmp) != node
                   || (TREE_CODE (TREE_TYPE (tmp)) == POINTER_TYPE
                       && TREE_TYPE (TREE_TYPE (tmp)) != node))
                   && TREE_CODE (tmp) != TYPE_DECL
                   && !TREE_STATIC (tmp))
            {
              /* Skip internal virtual table field.  */
              if (strncmp (IDENTIFIER_POINTER (DECL_NAME (tmp)), "_vptr", 5))
                {
                  if (is_union)
                    {
                      if (TREE_CHAIN (tmp)
                          && TREE_TYPE (TREE_CHAIN (tmp)) != node
                          && TREE_CODE (TREE_CHAIN (tmp)) != TYPE_DECL)
                        sprintf (buf, "when %d =>", field_num);
                      else
                        sprintf (buf, "when others =>");

                      INDENT (spc + INDENT_INCR * 2);
                      pp_string (buffer, buf);
                      pp_newline (buffer);
                    }

                  if (print_ada_declaration (buffer,
                                             tmp, type, cpp_check, field_spc))
                    {
                      pp_newline (buffer);
                      field_num++;
                    }
                }
            }
        }

      if (is_union)
        {
          INDENT (spc + INDENT_INCR);
          pp_string (buffer, "end case;");
          pp_newline (buffer);
        }

      if (field_num == 0)
        {
          INDENT (spc + INDENT_INCR);
          pp_string (buffer, "null;");
          pp_newline (buffer);
        }

      INDENT (spc);
      pp_string (buffer, "end record;");
    }

  newline_and_indent (buffer, spc);

  if (!display_convention)
    return;

  if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (type)))
    {
      if (TYPE_METHODS (TREE_TYPE (type)))
        pp_string (buffer, "pragma Import (CPP, ");
      else
        pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
    }
  else
    pp_string (buffer, "pragma Convention (C, ");

  package_prefix = false;
  dump_generic_ada_node
    (buffer, TREE_TYPE (type), type, cpp_check, spc, false, true);
  package_prefix = true;
  pp_character (buffer, ')');

  if (is_union)
    {
      pp_semicolon (buffer);
      newline_and_indent (buffer, spc);
      pp_string (buffer, "pragma Unchecked_Union (");

      dump_generic_ada_node
        (buffer, TREE_TYPE (type), type, cpp_check, spc, false, true);
      pp_character (buffer, ')');
    }

  if (bitfield_used)
    {
      pp_semicolon (buffer);
      newline_and_indent (buffer, spc);
      pp_string (buffer, "pragma Pack (");
      dump_generic_ada_node
        (buffer, TREE_TYPE (type), type, cpp_check, spc, false, true);
      pp_character (buffer, ')');
      bitfield_used = false;
    }

  print_ada_methods (buffer, node, cpp_check, spc);

  /* Print the static fields of the structure, if any.  */
  need_semicolon = TYPE_METHODS (node) == NULL_TREE;
  for (tmp = TYPE_FIELDS (node); tmp; tmp = TREE_CHAIN (tmp))
    {
      if (DECL_NAME (tmp) && TREE_STATIC (tmp))
        {
          if (need_semicolon)
            {
              need_semicolon = false;
              pp_semicolon (buffer);
            }
          pp_newline (buffer);
          pp_newline (buffer);
          print_ada_declaration (buffer, tmp, type, cpp_check, spc);
        }
    }
}

/* Dump all the declarations in SOURCE_FILE to an Ada spec.
   COLLECT_ALL_REFS is a front-end callback used to collect all relevant
   nodes for SOURCE_FILE.  CPP_CHECK is used to perform C++ queries on
   nodes.  */

static void
dump_ads (const char *source_file,
          void (*collect_all_refs)(const char *),
          int (*cpp_check)(tree, cpp_operation))
{
  char *ads_name;
  char *pkg_name;
  char *s;
  FILE *f;

  pkg_name = get_ada_package (source_file);

  /* Construct the .ads filename and package name.  */
  ads_name = xstrdup (pkg_name);

  for (s = ads_name; *s; s++)
    if (*s == '.')
      *s = '-';
    else
      *s = TOLOWER (*s);

  ads_name = reconcat (ads_name, ads_name, ".ads", NULL);

  /* Write out the .ads file.  */
  f = fopen (ads_name, "w");
  if (f)
    {
      pretty_printer pp;

      pp_construct (&pp, NULL, 0);
      pp_needs_newline (&pp) = true;
      pp.buffer->stream = f;

      /* Dump all relevant macros.  */
      dump_ada_macros (&pp, source_file);

      /* Reset the table of withs for this file.  */
      reset_ada_withs ();

      (*collect_all_refs) (source_file);

      /* Dump all references.  */
      dump_ada_nodes (&pp, source_file, cpp_check);

      /* Requires Ada 2005 syntax, so generate corresponding pragma.
         Also, disable style checks since this file is auto-generated.  */
      fprintf (f, "pragma Ada_2005;\npragma Style_Checks (Off);\n\n");

      /* Dump withs.  */
      dump_ada_withs (f);

      fprintf (f, "\npackage %s is\n\n", pkg_name);
      pp_write_text_to_stream (&pp);
      /* ??? need to free pp */
      fprintf (f, "end %s;\n", pkg_name);
      fclose (f);
    }

  free (ads_name);
  free (pkg_name);
}

static const char **source_refs = NULL;
static int source_refs_used = 0;
static int source_refs_allocd = 0;

/* Add an entry for FILENAME to the table SOURCE_REFS.  */

void
collect_source_ref (const char *filename)
{
  int i;

  if (!filename)
    return;

  if (source_refs_allocd == 0)
    {
      source_refs_allocd = 1024;
      source_refs = XNEWVEC (const char *, source_refs_allocd);
    }

  for (i = 0; i < source_refs_used; i++)
    if (filename == source_refs[i])
      return;

  if (source_refs_used == source_refs_allocd)
    {
      source_refs_allocd *= 2;
      source_refs = XRESIZEVEC (const char *, source_refs, source_refs_allocd);
    }

  source_refs[source_refs_used++] = filename;
}

/* Main entry point: dump all Ada specs corresponding to SOURCE_REFS
   using callbacks COLLECT_ALL_REFS and CPP_CHECK.
   COLLECT_ALL_REFS is a front-end callback used to collect all relevant
   nodes for a given source file.
   CPP_CHECK is used to perform C++ queries on nodes, or NULL for the C
   front-end.  */

void
dump_ada_specs (void (*collect_all_refs)(const char *),
                int (*cpp_check)(tree, cpp_operation))
{
  int i;

  /* Iterate over the list of files to dump specs for */
  for (i = 0; i < source_refs_used; i++)
    dump_ads (source_refs[i], collect_all_refs, cpp_check);

  /* Free files table.  */
  free (source_refs);
}