[patch] support for -fdump-ada-spec

Arnaud Charlet charlet@adacore.com
Mon May 10 09:11:00 GMT 2010


Here is a new version of the patch which removes all the problematic
issues you've raised by, for now, not handling strings or numbers in
macros. I've updated the doc accordingly.

Tested on i686-pc-linux-gnu, OK for mainline?

gcc/

2010-05-10  Arnaud Charlet  <charlet@adacore.com>
            Matthew Gingell  <gingell@adacore.com>

	* doc/invoke.texi: Mention -fdump-ada-spec.
	* tree-dump.c (dump_files): Add ada-spec.
	(FIRST_AUTO_NUMBERED_DUMP): Bump to 8.
	* tree-pass.h (tree_dump_index): Add TDI_ada.
	* gcc.c: Add support for -C without -E and for -fdump-ada-spec.
	(cpp_unique_options): Do not reject -C or -CC when -E isn't present.
	(default_compilers) <@c-header>: Allow -fdump-ada-spec on header files.
	* c-decl.c: Include c-ada-spec.h.
	(collect_source_ref_cb, collect_all_refs, for_each_global_decl): New
	functions.
	(c_write_global_declarations): Add handling of -fdump-ada-spec.
	* c-lex.c (c_lex_with_flags): Add handling of CPP_COMMENT.
	* Makefile.in (C_AND_OBJC_OBJS): Add c-ada-spec.o.
	* c-ada-spec.h, c-ada-spec.c: New files.

gcc/ada

	* gnat_ugn.texi: Improve doc on -fdump-ada-spec, mention limitations.

gcc/cp/

	* Make-lang.in (CXX_C_OBJS): Add c-ada-spec.o.
	* decl2.c: Include langhooks.h and c-ada-spec.h.
	(cpp_check, collect_source_refs, collect_ada_namespace,
	collect_all_refs): New functions.
	(cp_write_global_declarations): Add handling of -fdump-ada-spec.
	* lang-specs.h: Ditto.

gcc/testsuite

	* gnat.dg/c-specs: New directory with initial set of -fdump-ada-spec
	tests.
	* lib/gcc-dg.exp (gcc-dg-test-1): Add support for -fdump-ada-spec tests.
	* lib/gnat-dg.exp (gnat-dg-test): Ditto.

-------------- next part --------------
Index: gcc/doc/invoke.texi
===================================================================
--- gcc/doc/invoke.texi	(revision 159145)
+++ gcc/doc/invoke.texi	(working copy)
@@ -164,7 +164,8 @@ in the following sections.
 @gccoptlist{-c  -S  -E  -o @var{file}  -combine  -no-canonical-prefixes  @gol
 -pipe  -pass-exit-codes  @gol
 -x @var{language}  -v  -###  --help@r{[}=@var{class}@r{[},@dots{}@r{]]}  --target-help  @gol
---version -wrapper@@@var{file} -fplugin=@var{file} -fplugin-arg-@var{name}=@var{arg}}
+--version -wrapper@@@var{file} -fplugin=@var{file} -fplugin-arg-@var{name}=@var{arg}  @gol
+-fdump-ada-spec@r{[}-slim@r{]}}
 
 @item C Language Options
 @xref{C Dialect Options,,Options Controlling C Dialect}.
@@ -985,7 +986,8 @@ Objective-C++ source code which should n
 
 @item @var{file}.h
 C, C++, Objective-C or Objective-C++ header file to be turned into a
-precompiled header.
+precompiled header (default), or C, C++ header file to be turned into an
+Ada spec (via the @option{-fdump-ada-spec} switch).
 
 @item @var{file}.cc
 @itemx @var{file}.cp
@@ -1013,7 +1015,7 @@ Objective-C++ source code which should n
 @itemx @var{file}.HPP
 @itemx @var{file}.h++
 @itemx @var{file}.tcc
-C++ header file to be turned into a precompiled header.
+C++ header file to be turned into a precompiled header or Ada spec.
 
 @item @var{file}.f
 @itemx @var{file}.for
@@ -1368,6 +1370,11 @@ Plugins API.
 Define an argument called @var{key} with a value of @var{value}
 for the plugin called @var{name}.
 
+@item -fdump-ada-spec@r{[}-slim@r{]}
+For C and C++ source and include files, generate corresponding Ada
+specs. @xref{Generating Ada Bindings for C and C++ headers,,, gnat_ugn,
+GNAT User's Guide}, which provides detailed documentation on this feature.
+
 @include @value{srcdir}/../libiberty/at-file.texi
 @end table
 
Index: gcc/ada/gnat_ugn.texi
===================================================================
--- gcc/ada/gnat_ugn.texi	(revision 159145)
+++ gcc/ada/gnat_ugn.texi	(working copy)
@@ -23326,10 +23326,23 @@ Verbose mode: generate version informati
 @findex binding
 
 @noindent
-GNAT now comes with a new experimental binding generator for C and C++
-headers which is intended to do 95% of the tedious work of generating
-Ada specs from C or C++ header files. Note that this still is a work in
-progress, not designed to generate 100% correct Ada specs.
+GNAT now comes with a binding generator for C and C++ headers which is
+intended to do 95% of the tedious work of generating Ada specs from C
+or C++ header files.
+
+Note that this capability is not intended to generate 100% correct Ada specs,
+and will is some cases require manual adjustments, although it can often
+be used out of the box in practice.
+
+Some of the known limitations include:
+
+@itemize @bullet
+@item only very simple character constant macros are translated into Ada
+constants. Function macros (macros with arguments) are partially translated
+as comments, to be completed manually if needed.
+@item some extensions (e.g. vector types) are not supported
+@item pointers to pointers or complex structures are mapped to System.Address
+@end itemize
 
 The code generated is using the Ada 2005 syntax, which makes it
 easier to interface with other languages than previous versions of Ada.
Index: gcc/tree-dump.c
===================================================================
--- gcc/tree-dump.c	(revision 159145)
+++ gcc/tree-dump.c	(working copy)
@@ -783,7 +783,8 @@ static struct dump_file_info dump_files[
   {".gimple", "tree-gimple", NULL, TDF_TREE, 0, 4},
   {".nested", "tree-nested", NULL, TDF_TREE, 0, 5},
   {".vcg", "tree-vcg", NULL, TDF_TREE, 0, 6},
-#define FIRST_AUTO_NUMBERED_DUMP 7
+  {".ads", "ada-spec", NULL, 0, 0, 7},
+#define FIRST_AUTO_NUMBERED_DUMP 8
 
   {NULL, "tree-all", NULL, TDF_TREE, 0, 0},
   {NULL, "rtl-all", NULL, TDF_RTL, 0, 0},
Index: gcc/tree-pass.h
===================================================================
--- gcc/tree-pass.h	(revision 159145)
+++ gcc/tree-pass.h	(working copy)
@@ -38,6 +38,7 @@ enum tree_dump_index
   TDI_nested,			/* dump each function after unnesting it */
   TDI_vcg,			/* create a VCG graph file for each
 				   function's flowgraph.  */
+  TDI_ada,                      /* dump declarations in Ada syntax.  */
   TDI_tree_all,                 /* enable all the GENERIC/GIMPLE dumps.  */
   TDI_rtl_all,                  /* enable all the RTL dumps.  */
   TDI_ipa_all,                  /* enable all the IPA dumps.  */
Index: gcc/gcc.c
===================================================================
--- gcc/gcc.c	(revision 159145)
+++ gcc/gcc.c	(working copy)
@@ -866,8 +866,7 @@ static const char *trad_capable_cpp =
    therefore no dependency entry, confuses make into thinking a .o
    file that happens to exist is up-to-date.  */
 static const char *cpp_unique_options =
-"%{C|CC:%{!E:%eGCC does not support -C or -CC without -E}}\
- %{!Q:-quiet} %{nostdinc*} %{C} %{CC} %{v} %{I*&F*} %{P} %I\
+"%{!Q:-quiet} %{nostdinc*} %{C} %{CC} %{v} %{I*&F*} %{P} %I\
  %{MD:-MD %{!o:%b.d}%{o*:%.d%*}}\
  %{MMD:-MMD %{!o:%b.d}%{o*:%.d%*}}\
  %{M} %{MM} %{MF*} %{MG} %{MP} %{MQ*} %{MT*}\
@@ -1101,12 +1100,12 @@ static const struct compiler default_com
 		%(cpp_options) -o %{save-temps*:%b.i} %{!save-temps*:%g.i} \n\
 		    cc1 -fpreprocessed %{save-temps*:%b.i} %{!save-temps*:%g.i} \
 			%(cc1_options)\
-                        -o %g.s %{!o*:--output-pch=%i.gch}\
-                        %W{o*:--output-pch=%*}%V}\
+                        -o %g.s %{!o*:%{!fdump-ada*:--output-pch=%i.gch}}\
+                        %W{o*:%{!fdump-ada*:--output-pch=%*}}%V}\
 	  %{!save-temps*:%{!traditional-cpp:%{!no-integrated-cpp:\
 		cc1 %(cpp_unique_options) %(cc1_options)\
-                    -o %g.s %{!o*:--output-pch=%i.gch}\
-                    %W{o*:--output-pch=%*}%V}}}}}}", 0, 0, 0},
+                    -o %g.s %{!o*:%{!fdump-ada*:--output-pch=%i.gch}}\
+                    %W{o*:%{!fdump-ada*:--output-pch=%*}}%V}}}}}}", 0, 0, 0},
   {".i", "@cpp-output", 0, 1, 0},
   {"@cpp-output",
    "%{!M:%{!MM:%{!E:cc1 -fpreprocessed %i %(cc1_options) %{!fsyntax-only:%(invoke_as)}}}}", 0, 1, 0},
Index: gcc/c-decl.c
===================================================================
--- gcc/c-decl.c	(revision 159145)
+++ gcc/c-decl.c	(working copy)
@@ -65,6 +65,7 @@ along with GCC; see the file COPYING3.  
 #include "pointer-set.h"
 #include "gimple.h"
 #include "plugin.h"
+#include "c-ada-spec.h"
 
 /* In grokdeclarator, distinguish syntactic contexts of declarators.  */
 enum decl_context
@@ -9510,6 +9511,43 @@ c_write_global_declarations_2 (tree glob
     debug_hooks->global_decl (decl);
 }
 
+/* Callback to collect a source_ref from a DECL.  */
+
+static void
+collect_source_ref_cb (tree decl)
+{
+  if (!DECL_IS_BUILTIN (decl))
+    collect_source_ref (LOCATION_FILE (decl_sloc (decl, false)));
+}
+
+/* Collect all references relevant to SOURCE_FILE.  */
+
+static void
+collect_all_refs (const char *source_file)
+{
+  tree t;
+
+  for (t = all_translation_units; t; t = TREE_CHAIN (t))
+    collect_ada_nodes (BLOCK_VARS (DECL_INITIAL (t)), source_file);
+}
+
+/* Iterate over all global declarations and call CALLBACK.  */
+
+static void
+for_each_global_decl (void (*callback) (tree decl))
+{
+  tree t;
+  tree decls;
+  tree decl;
+
+  for (t = all_translation_units; t; t = TREE_CHAIN (t))
+    { 
+      decls = DECL_INITIAL (t);
+      for (decl = BLOCK_VARS (decls); decl; decl = TREE_CHAIN (decl))
+	callback (decl);
+    }
+}
+
 /* Preserve the external declarations scope across a garbage collect.  */
 static GTY(()) tree ext_block;
 
@@ -9532,6 +9570,18 @@ c_write_global_declarations (void)
   external_scope = 0;
   gcc_assert (!current_scope);
 
+  /* Handle -fdump-ada-spec[-slim]. */
+  if (dump_enabled_p (TDI_ada))
+    {
+      /* Build a table of files to generate specs for */
+      if (get_dump_file_info (TDI_ada)->flags & TDF_SLIM)
+	collect_source_ref (main_input_filename);
+      else
+	for_each_global_decl (collect_source_ref_cb);
+
+      dump_ada_specs (collect_all_refs, NULL);
+    }
+
   if (ext_block)
     {
       tree tmp = BLOCK_VARS (ext_block);
Index: gcc/c-lex.c
===================================================================
--- gcc/c-lex.c	(revision 159145)
+++ gcc/c-lex.c	(working copy)
@@ -440,10 +440,14 @@ c_lex_with_flags (tree *value, location_
 
       /* These tokens should not be visible outside cpplib.  */
     case CPP_HEADER_NAME:
-    case CPP_COMMENT:
     case CPP_MACRO_ARG:
       gcc_unreachable ();
 
+    /* CPP_COMMENT will appear when compiling with -C and should be
+       ignored. */
+     case CPP_COMMENT:
+       goto retry;
+
     default:
       *value = NULL_TREE;
       break;
Index: gcc/Makefile.in
===================================================================
--- gcc/Makefile.in	(revision 159145)
+++ gcc/Makefile.in	(working copy)
@@ -1128,7 +1128,7 @@ C_AND_OBJC_OBJS = attribs.o c-errors.o c
   c-convert.o c-aux-info.o c-common.o c-opts.o c-format.o c-semantics.o \
   c-ppoutput.o c-cppbuiltin.o \
   c-objc-common.o c-dump.o c-pch.o c-parser.o $(C_TARGET_OBJS) \
-  c-gimplify.o tree-mudflap.o c-pretty-print.o c-omp.o
+  c-gimplify.o tree-mudflap.o c-pretty-print.o c-omp.o c-ada-spec.o
 
 # Language-specific object files for C.
 C_OBJS = c-lang.o stub-objc.o $(C_AND_OBJC_OBJS)
@@ -1975,7 +1975,8 @@ c-decl.o : c-decl.c $(CONFIG_H) $(SYSTEM
     opts.h $(C_PRAGMA_H) gt-c-decl.h $(CGRAPH_H) $(HASHTAB_H) libfuncs.h \
     $(EXCEPT_H) $(LANGHOOKS_DEF_H) $(TREE_DUMP_H) $(C_COMMON_H) $(CPPLIB_H) \
     $(DIAGNOSTIC_H) $(INPUT_H) langhooks.h $(GIMPLE_H) tree-mudflap.h  \
-    pointer-set.h $(BASIC_BLOCK_H) $(GIMPLE_H) tree-iterator.h c-lang.h $(PLUGIN_H)
+    pointer-set.h $(BASIC_BLOCK_H) $(GIMPLE_H) tree-iterator.h c-lang.h $(PLUGIN_H) \
+    c-ada-spec.h
 c-typeck.o : c-typeck.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) \
     $(TREE_H) $(C_TREE_H) $(TARGET_H) $(FLAGS_H) intl.h output.h $(EXPR_H) \
     $(RTL_H) $(TOPLEV_H) $(TM_P_H) langhooks.h $(GGC_H) $(TREE_FLOW_H) \
@@ -2698,6 +2699,10 @@ tree-pretty-print.o : tree-pretty-print.
    $(TREE_H) $(DIAGNOSTIC_H) $(REAL_H) $(HASHTAB_H) $(TREE_FLOW_H) \
    $(TM_H) coretypes.h tree-iterator.h $(SCEV_H) langhooks.h \
    $(TREE_PASS_H) value-prof.h fixed-value.h output.h
+c-ada-spec.o : c-ada-spec.c c-ada-spec.h $(CONFIG_H) $(SYSTEM_H) \
+   $(TREE_H) $(REAL_H) $(HASHTAB_H) $(TREE_FLOW_H) \
+   $(CPP_ID_DATA_H) $(TM_H) coretypes.h tree-iterator.h tree-pass.h \
+   value-prof.h fixed-value.h output.h
 fold-const.o : fold-const.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) \
    $(TREE_H) $(FLAGS_H) $(REAL_H) $(TOPLEV_H) $(HASHTAB_H) $(EXPR_H) $(RTL_H) \
    $(GGC_H) $(TM_P_H) langhooks.h $(MD5_H) intl.h fixed-value.h $(TARGET_H) \
Index: gcc/cp/Make-lang.in
===================================================================
--- gcc/cp/Make-lang.in	(revision 159145)
+++ gcc/cp/Make-lang.in	(working copy)
@@ -74,7 +74,7 @@ g++-cross$(exeext): g++$(exeext)
 CXX_C_OBJS = attribs.o c-common.o c-format.o c-pragma.o c-semantics.o c-lex.o \
 	c-dump.o $(CXX_TARGET_OBJS) c-pretty-print.o c-opts.o c-pch.o \
 	incpath.o c-ppoutput.o c-cppbuiltin.o prefix.o \
-	c-gimplify.o c-omp.o
+	c-gimplify.o c-omp.o c-ada-spec.o
 
 # Language-specific object files for C++ and Objective C++.
 CXX_AND_OBJCXX_OBJS = cp/call.o cp/decl.o cp/expr.o cp/pt.o cp/typeck2.o \
@@ -259,7 +259,8 @@ cp/decl.o: cp/decl.c $(CXX_TREE_H) $(TM_
   intl.h
 cp/decl2.o: cp/decl2.c $(CXX_TREE_H) $(TM_H) $(FLAGS_H) cp/decl.h $(EXPR_H) \
   output.h except.h toplev.h $(RTL_H) $(C_COMMON_H) gt-cp-decl2.h $(CGRAPH_H) \
-  $(C_PRAGMA_H) $(TREE_DUMP_H) intl.h $(TARGET_H) $(GIMPLE_H) $(POINTER_SET_H)
+  $(C_PRAGMA_H) $(TREE_DUMP_H) intl.h $(TARGET_H) $(GIMPLE_H) $(POINTER_SET_H) \
+  c-ada-spec.h
 cp/cp-objcp-common.o : cp/cp-objcp-common.c $(CONFIG_H) $(SYSTEM_H) \
   coretypes.h $(TM_H) $(TREE_H) $(CXX_TREE_H) $(C_COMMON_H) toplev.h \
   langhooks.h $(LANGHOOKS_DEF_H) $(DIAGNOSTIC_H) debug.h \
Index: gcc/cp/decl2.c
===================================================================
--- gcc/cp/decl2.c	(revision 159145)
+++ gcc/cp/decl2.c	(working copy)
@@ -1,6 +1,6 @@
 /* Process declarations and variables for C++ compiler.
    Copyright (C) 1988, 1992, 1993, 1994, 1995, 1996, 1997, 1998,
-   1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007, 2008, 2009
+   1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007, 2008, 2009, 2010
    Free Software Foundation, Inc.
    Hacked by Michael Tiemann (tiemann@cygnus.com)
 
@@ -53,6 +53,8 @@ along with GCC; see the file COPYING3.  
 #include "intl.h"
 #include "gimple.h"
 #include "pointer-set.h"
+#include "langhooks.h"
+#include "c-ada-spec.h"
 
 extern cpp_reader *parse_in;
 
@@ -3455,6 +3457,69 @@ build_java_method_aliases (struct pointe
     }
 }
 
+/* Return C++ property of T, based on given operation OP.  */
+
+static int
+cpp_check (tree t, cpp_operation op)
+{
+  switch (op)
+    {
+      case IS_ABSTRACT:
+	return DECL_PURE_VIRTUAL_P (t);
+      case IS_CONSTRUCTOR:
+	return DECL_CONSTRUCTOR_P (t);
+      case IS_DESTRUCTOR:
+	return DECL_DESTRUCTOR_P (t);
+      case IS_COPY_CONSTRUCTOR:
+	return DECL_COPY_CONSTRUCTOR_P (t);
+      case IS_TEMPLATE:
+	return TREE_CODE (t) == TEMPLATE_DECL;
+      default:
+        return 0;
+    }
+}
+
+/* Collect source file references recursively, starting from NAMESPC.  */
+
+static void 
+collect_source_refs (tree namespc) 
+{
+  tree t;
+
+  if (!namespc) 
+    return;
+
+  /* Iterate over names in this name space.  */
+  for (t = NAMESPACE_LEVEL (namespc)->names; t; t = TREE_CHAIN (t))
+    if (!DECL_IS_BUILTIN (t) )
+      collect_source_ref (DECL_SOURCE_FILE (t));
+  
+  /* Dump siblings, if any */
+  collect_source_refs (TREE_CHAIN (namespc));
+
+  /* Dump children, if any */
+  collect_source_refs (NAMESPACE_LEVEL (namespc)->namespaces);
+}
+
+/* Collect decls relevant to SOURCE_FILE from all namespaces recursively,
+   starting from NAMESPC.  */
+
+static void
+collect_ada_namespace (tree namespc, const char *source_file)
+{
+  if (!namespc)
+    return;
+
+  /* Collect decls from this namespace */
+  collect_ada_nodes (NAMESPACE_LEVEL (namespc)->names, source_file);
+
+  /* Collect siblings, if any */
+  collect_ada_namespace (TREE_CHAIN (namespc), source_file);
+
+  /* Collect children, if any */
+  collect_ada_namespace (NAMESPACE_LEVEL (namespc)->namespaces, source_file);
+}
+
 /* Returns true iff there is a definition available for variable or
    function DECL.  */
 
@@ -3489,6 +3554,14 @@ no_linkage_error (tree decl)
 	       "is used but never defined", decl, t);
 }
 
+/* Collect declarations from all namespaces relevant to SOURCE_FILE.  */
+
+static void
+collect_all_refs (const char *source_file)
+{
+  collect_ada_namespace (global_namespace, source_file);
+}
+
 /* This routine is called at the end of compilation.
    Its job is to create all the code needed to initialize and
    destroy the global aggregates.  We do the destruction
@@ -3516,6 +3589,17 @@ cp_write_global_declarations (void)
   if (pch_file)
     c_common_write_pch ();
 
+  /* Handle -fdump-ada-spec[-slim] */
+  if (dump_enabled_p (TDI_ada))
+    {
+      if (get_dump_file_info (TDI_ada)->flags & TDF_SLIM)
+	collect_source_ref (main_input_filename);
+      else
+	collect_source_refs (global_namespace);
+
+      dump_ada_specs (collect_all_refs, cpp_check);
+    }
+
   /* FIXME - huh?  was  input_line -= 1;*/
 
   /* We now have to write out all the stuff we put off writing out.
Index: gcc/cp/lang-specs.h
===================================================================
--- gcc/cp/lang-specs.h	(revision 159145)
+++ gcc/cp/lang-specs.h	(working copy)
@@ -48,7 +48,8 @@ along with GCC; see the file COPYING3.  
       cc1plus %{save-temps|no-integrated-cpp:-fpreprocessed %{save-temps:%b.ii} %{!save-temps:%g.ii}}\
 	      %{!save-temps:%{!no-integrated-cpp:%(cpp_unique_options)}}\
 	%(cc1_options) %2 %{+e1*}\
-	%{!fsyntax-only:-o %g.s %{!o*:--output-pch=%i.gch} %W{o*:--output-pch=%*}%V}}}}",
+	%{!fsyntax-only:-o %g.s %{!o*:%{!fdump-ada*:--output-pch=%i.gch}}\
+        %W{o*:%{!fdump-ada*:--output-pch=%*}}%V}}}}",
      CPLUSPLUS_CPP_SPEC, 0, 0},
   {"@c++",
     "%{E|M|MM:cc1plus -E %(cpp_options) %2 %(cpp_debug_options)}\
Index: gcc/c-ada-spec.h
===================================================================
--- gcc/c-ada-spec.h	(revision 0)
+++ gcc/c-ada-spec.h	(revision 0)
@@ -0,0 +1,41 @@
+/* Interface for -fdump-ada-spec capability.
+   Copyright (C) 2010, Free Software Foundation, Inc.
+
+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/>.  */
+
+#ifndef C_ADA_SPEC_H
+#define C_ADA_SPEC_H
+
+#include "pretty-print.h"
+
+/* In c-ada-spec.c  */
+
+typedef enum {
+  IS_ABSTRACT,
+  IS_CONSTRUCTOR,
+  IS_DESTRUCTOR,
+  IS_COPY_CONSTRUCTOR,
+  IS_TEMPLATE
+} cpp_operation;
+
+extern location_t decl_sloc (const_tree, bool);
+extern void collect_ada_nodes (tree, const char *);
+extern void collect_source_ref (const char *);
+extern void dump_ada_specs (void (*)(const char *),
+			    int (*)(tree, cpp_operation));
+
+#endif /* ! C_ADA_SPEC_H */
Index: gcc/c-ada-spec.c
===================================================================
--- gcc/c-ada-spec.c	(revision 0)
+++ gcc/c-ada-spec.c	(revision 0)
@@ -0,0 +1,3243 @@
+/* Print GENERIC declaration (functions, variables, types) trees coming from
+   the C and C++ front-ends as well as macros in Ada syntax.
+   Copyright (C) 2010 Free Software Foundation, Inc.
+   Adapted from tree-pretty-print.c by Arnaud Charlet  <charlet@adacore.com>
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tm.h"
+#include "tree.h"
+#include "output.h"
+#include "c-ada-spec.h"
+#include "real.h"
+#include "hashtab.h"
+#include "tree-flow.h"
+#include "langhooks.h"
+#include "tree-iterator.h"
+#include "tree-chrec.h"
+#include "tree-pass.h"
+#include "fixed-value.h"
+#include "value-prof.h"
+#include "predict.h"
+#include "cpplib.h"
+#include "c-pragma.h"
+#include "cpp-id-data.h"
+
+/* Local functions, macros and variables.  */
+static int dump_generic_ada_node (pretty_printer *, tree, tree,
+				  int (*)(tree, cpp_operation), int, int, bool);
+static int print_ada_declaration (pretty_printer *, tree, tree,
+				  int (*cpp_check)(tree, cpp_operation), int);
+static void print_ada_struct_decl (pretty_printer *, tree, tree,
+				   int (*cpp_check)(tree, cpp_operation), int,
+				   bool);
+static void dump_sloc (pretty_printer *buffer, tree node);
+static void print_comment (pretty_printer *, const char *);
+static void print_generic_ada_decl (pretty_printer *, tree,
+				    int (*)(tree, cpp_operation), const char *);
+static char *get_ada_package (const char *);
+static void dump_ada_nodes (pretty_printer *, const char *,
+			    int (*)(tree, cpp_operation));
+static void reset_ada_withs (void);
+static void dump_ada_withs (FILE *);
+static void dump_ads (const char *, void (*)(const char *),
+		      int (*)(tree, cpp_operation));
+static char *to_ada_name (const char *, int *);
+
+#define LOCATION_COL(LOC) ((expand_location (LOC)).column)
+
+#define INDENT(SPACE) do { \
+  int i; for (i = 0; i<SPACE; i++) pp_space (buffer); } while (0)
+
+#define INDENT_INCR 3
+
+/* Given a cpp MACRO, compute the max length BUFFER_LEN of the macro, as well
+   as max length PARAM_LEN of arguments for fun_like macros, and also set
+   SUPPORTED to 0 if the macro cannot be mapped to an Ada construct.  */
+
+static void
+macro_length (const cpp_macro *macro, int *supported, int *buffer_len,
+	      int *param_len)
+{
+  int i;
+  unsigned j;
+
+  *supported = 1;
+  *buffer_len = 0;
+  *param_len = 0;
+
+  if (macro->fun_like)
+    {
+      param_len++;
+      for (i = 0; i < macro->paramc; i++)
+	{
+	  cpp_hashnode *param = macro->params[i];
+
+	  *param_len += NODE_LEN (param);
+
+	  if (i + 1 < macro->paramc)
+	    {
+	      *param_len += 2;  /* ", " */
+	    }
+	  else if (macro->variadic)
+	    {
+	      *supported = 0;
+	      return;
+	    }
+	}
+      *param_len += 2;  /* ")\0" */
+    }
+
+  for (j = 0; j < macro->count; j++)
+    {
+      cpp_token *token = &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 as
+	   handled by handle_escape_character below.  */
+	*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 declarations (LP and RP) by their source location.  */
+
+static int
+compare_node (const void *lp, const void *rp)
+{
+  const_tree lhs = *((const tree *) lp);
+  const_tree rhs = *((const tree *) rp);
+
+  return decl_sloc (lhs, true) - decl_sloc (rhs, true);
+}
+
+/* Compare two comments (LP and RP) by their source location.  */
+
+static int
+compare_comment (const void *lp, const void *rp)
+{
+  const cpp_comment *lhs = (const cpp_comment *) lp;
+  const cpp_comment *rhs = (const cpp_comment *) rp;
+
+  if (LOCATION_FILE (lhs->sloc) != LOCATION_FILE (rhs->sloc))
+    return strcmp (LOCATION_FILE (lhs->sloc), LOCATION_FILE (rhs->sloc));
+
+  if (LOCATION_LINE (lhs->sloc) != LOCATION_LINE (rhs->sloc))
+    return LOCATION_LINE (lhs->sloc) - LOCATION_LINE (rhs->sloc);
+
+  if (LOCATION_COL (lhs->sloc) != LOCATION_COL (rhs->sloc))
+    return LOCATION_COL (lhs->sloc) - LOCATION_COL (rhs->sloc);
+
+  return 0;
+}
+
+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 = (tree *) xrealloc (to_dump, sizeof (tree) * 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 = (struct with *) xmalloc (withs_max * sizeof (struct with));
+
+  if (with_len == withs_max)
+    {
+      withs_max *= 2;
+      withs = (struct with *)
+	xrealloc (withs, withs_max * sizeof (struct with));
+    }
+
+  for (i = 0; i < with_len; i++)
+    if (!strcmp (s, withs [i].s)
+	&& source_file_base == withs [i].in_file)
+      {
+	withs [i].limited &= limited_access;
+	return;
+      }
+
+  withs [with_len].s = xstrdup (s);
+  withs [with_len].in_file = source_file_base;
+  withs [with_len].limited = limited_access;
+  with_len++;
+}
+
+/* Reset "with" clauses.  */
+
+static void
+reset_ada_withs (void)
+{
+  int i;
+
+  if (!withs)
+    return;
+
+  for (i = 0; i < with_len; i++)
+    free (withs [i].s);
+  free (withs);
+  withs = NULL;
+  withs_max = 4096;
+  with_len = 0;
+}
+
+/* Dump "with" clauses in F.  */
+
+static void
+dump_ada_withs (FILE *f)
+{
+  int i;
+
+  fprintf (f, "with Interfaces.C; use Interfaces.C;\n");
+
+  for (i = 0; i < with_len; i++)
+    fprintf
+      (f, "%swith %s;\n", withs [i].limited ? "limited " : "", withs [i].s);
+}
+
+/* Return suitable Ada package name from FILE.  */
+
+static char *
+get_ada_package (const char *file)
+{
+  const char *base;
+  char *res;
+  const char *s;
+  int i;
+
+  s = strstr (file, "/include/");
+  if (s)
+    base = s + 9;
+  else
+    base = lbasename (file);
+  res = (char *) xmalloc (strlen (base) + 1);
+
+  for (i = 0; *base; base++, i++)
+    switch (*base)
+      {
+	case '+':
+	  res [i] = 'p';
+	  break;
+
+	case '.':
+	case '-':
+	case '_':
+	case '/':
+	case '\\':
+	  res [i] = (i == 0 || res [i - 1] == '_') ? 'u' : '_';
+	  break;
+
+	default:
+	  res [i] = *base;
+	  break;
+      }
+  res [i] = '\0';
+
+  return res;
+}
+
+static const char *ada_reserved[] = {
+  "abort", "abs", "abstract", "accept", "access", "aliased", "all", "and",
+  "array", "at", "begin", "body", "case", "constant", "declare", "delay",
+  "delta", "digits", "do", "else", "elsif", "end", "entry", "exception",
+  "exit", "for", "function", "generic", "goto", "if", "in", "interface", "is",
+  "limited", "loop", "mod", "new", "not", "null", "others", "out", "of", "or",
+  "overriding", "package", "pragma", "private", "procedure", "protected",
+  "raise", "range", "record", "rem", "renames", "requeue", "return", "reverse",
+  "select", "separate", "subtype", "synchronized", "tagged", "task",
+  "terminate", "then", "type", "until", "use", "when", "while", "with", "xor",
+  NULL};
+
+/* ??? would be nice to specify this list via a config file, so that users
+   can create their own dictionnary 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 = (char *) xmalloc (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;
+}
+
+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 (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:col 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);
+      pp_string (buffer, ":");
+      pp_decimal_int (buffer, xloc.column);
+    }
+}
+
+/* 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 instantiations associated with a given
+   template T.  CPP_CHECK is used to perform C++ queries on nodes.
+   SPC is the indentation level. */
+
+static int
+dump_ada_template (pretty_printer *buffer, tree t,
+		   int (*cpp_check)(tree, cpp_operation), int spc)
+{
+  tree inst = DECL_VINDEX (t);
+  /* DECL_VINDEX is DECL_TEMPLATE_INSTANTIATIONS in this context.  */
+  int num_inst = 0;
+
+  while (inst && inst != error_mark_node)
+    {
+      tree types = TREE_PURPOSE (inst);
+      tree instance = TREE_VALUE (inst);
+
+      if (TREE_VEC_LENGTH (types) == 0)
+	break;
+
+      if (!TYPE_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);
+
+      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;
+}
+
+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;
+
+	  pp_string (buffer, "unsigned");
+
+	  for (value = TYPE_VALUES (node); value; value = TREE_CHAIN (value))
+	    {
+	      pp_semicolon (buffer);
+	      newline_and_indent (buffer, spc);
+
+	      pp_ada_tree_identifier
+		(buffer, TREE_PURPOSE (value), node, false);
+	      pp_string (buffer, " : constant ");
+
+	      dump_generic_ada_node
+		(buffer, DECL_NAME (type) ? type : TYPE_NAME (node), type,
+		 cpp_check, spc, 0, true);
+
+	      pp_string (buffer, " := ");
+	      dump_generic_ada_node
+		(buffer,
+		 TREE_CODE (TREE_VALUE (value)) == INTEGER_CST ?
+		   TREE_VALUE (value) : DECL_INITIAL (TREE_VALUE (value)),
+		 node,
+		 cpp_check, spc, false, true);
+	    }
+	}
+      break;
+
+    case INTEGER_TYPE:
+    case REAL_TYPE:
+    case FIXED_POINT_TYPE:
+    case BOOLEAN_TYPE:
+      {
+	enum tree_code_class tclass;
+
+	tclass = TREE_CODE_CLASS (TREE_CODE (node));
+
+	if (tclass == tcc_declaration)
+	  {
+	    if (DECL_NAME (node))
+	      pp_ada_tree_identifier
+		(buffer, DECL_NAME (node), 0, limited_access);
+	    else
+	      pp_string (buffer, "<unnamed type decl>");
+	  }
+	else if (tclass == tcc_type)
+	  {
+	    if (TYPE_NAME (node))
+	      {
+		if (TREE_CODE (TYPE_NAME (node)) == IDENTIFIER_NODE)
+		  pp_ada_tree_identifier (buffer, TYPE_NAME (node),
+					  node, limited_access);
+		else if (TREE_CODE (TYPE_NAME (node)) == TYPE_DECL
+			 && DECL_NAME (TYPE_NAME (node)))
+		  dump_ada_decl_name (buffer, TYPE_NAME (node), limited_access);
+		else
+		  pp_string (buffer, "<unnamed type>");
+	      }
+	    else if (TREE_CODE (node) == INTEGER_TYPE)
+	      {
+		append_withs ("Interfaces.C.Extensions", false);
+		bitfield_used = true;
+
+		if (TYPE_PRECISION (node) == 1)
+		  pp_string (buffer, "Extensions.Unsigned_1");
+		else
+		  {
+		    pp_string (buffer, (TYPE_UNSIGNED (node)
+					? "Extensions.Unsigned_"
+					: "Extensions.Signed_"));
+		    pp_decimal_int (buffer, TYPE_PRECISION (node));
+		  }
+	      }
+	    else
+	      pp_string (buffer, "<unnamed type>");
+	  }
+	break;
+      }
+
+    case POINTER_TYPE:
+    case REFERENCE_TYPE:
+      if (TREE_CODE (TREE_TYPE (node)) == FUNCTION_TYPE)
+	{
+	  tree fnode = TREE_TYPE (node);
+	  bool is_function;
+	  bool prev_in_function = in_function;
+
+	  if (VOID_TYPE_P (TREE_TYPE (fnode)))
+	    {
+	      is_function = false;
+	      pp_string (buffer, "access procedure");
+	    }
+	  else
+	    {
+	      is_function = true;
+	      pp_string (buffer, "access function");
+	    }
+
+	  in_function = is_function;
+	  dump_ada_function_declaration
+	    (buffer, node, false, false, false, spc + INDENT_INCR);
+	  in_function = prev_in_function;
+
+	  if (is_function)
+	    {
+	      pp_string (buffer, " return ");
+	      dump_generic_ada_node
+		(buffer, TREE_TYPE (fnode), type, cpp_check, spc, 0, true);
+	    }
+	}
+      else
+	{
+	  int is_access = false;
+	  unsigned int quals = TYPE_QUALS (TREE_TYPE (node));
+
+	  if (name_only && TYPE_NAME (node))
+	    dump_generic_ada_node
+	      (buffer, TYPE_NAME (node), node, cpp_check,
+	       spc, limited_access, true);
+	  else if (VOID_TYPE_P (TREE_TYPE (node)))
+	    {
+	      if (!name_only)
+		pp_string (buffer, "new ");
+	      if (package_prefix)
+		{
+		  append_withs ("System", false);
+		  pp_string (buffer, "System.Address");
+		}
+	      else
+		pp_string (buffer, "address");
+	    }
+	  else
+	    {
+	      if (TREE_CODE (node) == POINTER_TYPE
+		  && TREE_CODE (TREE_TYPE (node)) == INTEGER_TYPE
+		  && !strcmp
+			(IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME
+			  (TREE_TYPE (node)))), "char"))
+		{
+		  if (!name_only)
+		    pp_string (buffer, "new ");
+
+		  if (package_prefix)
+		    {
+		      pp_string (buffer, "Interfaces.C.Strings.chars_ptr");
+		      append_withs ("Interfaces.C.Strings", false);
+		    }
+		  else
+		    pp_string (buffer, "chars_ptr");
+		}
+	      else
+		{
+		  /* For now, handle all access-to-access or
+		     access-to-unknown-structs as opaque system.address.  */
+
+		  tree typ = 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.  */
+
+		      || (typ && 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 (TREE_TYPE (node)))
+		    {
+		      tree name = TYPE_NAME (TREE_TYPE (node));
+		      tree tmp;
+
+		      if (TREE_CODE (name) == TYPE_DECL
+			  && DECL_ORIGINAL_TYPE (name)
+			  && TYPE_STUB_DECL (DECL_ORIGINAL_TYPE (name)))
+			{
+			  tmp = TYPE_NAME (TREE_TYPE (TYPE_STUB_DECL
+			    (DECL_ORIGINAL_TYPE (name))));
+
+			  if (tmp == NULL_TREE)
+			    tmp = TYPE_NAME (TREE_TYPE (node));
+			}
+		      else
+			tmp = TYPE_NAME (TREE_TYPE (node));
+
+		      dump_generic_ada_node
+			(buffer, tmp,
+			 TREE_TYPE (node), cpp_check, spc, is_access, true);
+		    }
+		  else
+		    dump_generic_ada_node
+		      (buffer, TREE_TYPE (node), TREE_TYPE (node),
+		       cpp_check, spc, 0, true);
+		}
+	    }
+	}
+      break;
+
+    case ARRAY_TYPE:
+      if (name_only)
+	dump_generic_ada_node
+	  (buffer, TYPE_NAME (node), node, cpp_check,
+	   spc, limited_access, true);
+      else
+	dump_ada_array_type (buffer, node, spc);
+      break;
+
+    case RECORD_TYPE:
+    case UNION_TYPE:
+    case QUAL_UNION_TYPE:
+      if (name_only)
+	{
+	  if (TYPE_NAME (node))
+	    dump_generic_ada_node
+	      (buffer, TYPE_NAME (node), node, cpp_check,
+	       spc, limited_access, true);
+	  else
+	    {
+	      pp_string (buffer, "anon_");
+	      pp_scalar (buffer, "%d", TYPE_UID (node));
+	    }
+	}
+      else
+	print_ada_struct_decl
+	  (buffer, node, type, cpp_check, spc, true);
+      break;
+
+    case INTEGER_CST:
+      if (TREE_CODE (TREE_TYPE (node)) == POINTER_TYPE)
+	{
+	  pp_wide_integer (buffer, TREE_INT_CST_LOW (node));
+	  pp_string (buffer, "B"); /* pseudo-unit */
+	}
+      else if (! host_integerp (node, 0))
+	{
+	  tree val = node;
+	  unsigned HOST_WIDE_INT low = TREE_INT_CST_LOW (val);
+	  HOST_WIDE_INT high = TREE_INT_CST_HIGH (val);
+
+	  if (tree_int_cst_sgn (val) < 0)
+	    {
+	      pp_character (buffer, '-');
+	      high = ~high + !low;
+	      low = -low;
+	    }
+	  sprintf (pp_buffer (buffer)->digit_buffer,
+	  HOST_WIDE_INT_PRINT_DOUBLE_HEX,
+	    (unsigned HOST_WIDE_INT) high, low);
+	  pp_string (buffer, pp_buffer (buffer)->digit_buffer);
+	}
+      else
+	pp_wide_integer (buffer, TREE_INT_CST_LOW (node));
+      break;
+
+    case REAL_CST:
+    case FIXED_CST:
+    case COMPLEX_CST:
+    case STRING_CST:
+    case VECTOR_CST:
+      return 0;
+
+    case FUNCTION_DECL:
+    case CONST_DECL:
+      dump_ada_decl_name (buffer, node, limited_access);
+      break;
+
+    case TYPE_DECL:
+      if (DECL_IS_BUILTIN (node))
+	{
+	  /* Don't print the declaration of built-in types.  */
+
+	  if (name_only)
+	    {
+	      /* If we're in the middle of a declaration, defaults to
+		 System.Address.  */
+	      if (package_prefix)
+		{
+		  append_withs ("System", false);
+		  pp_string (buffer, "System.Address");
+		}
+	      else
+		pp_string (buffer, "address");
+	    }
+	  break;
+	}
+
+      if (name_only)
+	dump_ada_decl_name (buffer, node, limited_access);
+      else
+	{
+	  if (is_tagged_type (TREE_TYPE (node)))
+	    {
+	      tree tmp = TYPE_FIELDS (TREE_TYPE (node));
+	      int first = 1;
+
+	      /* Look for ancestors.  */
+	      for (; tmp; tmp = TREE_CHAIN (tmp))
+		{
+		  if (!DECL_NAME (tmp) && is_tagged_type (TREE_TYPE (tmp)))
+		    {
+		      if (first)
+			{
+			  pp_string (buffer, "limited new ");
+			  first = 0;
+			}
+		      else
+			pp_string (buffer, " and ");
+
+		      dump_ada_decl_name
+			(buffer, TYPE_NAME (TREE_TYPE (tmp)), false);
+		    }
+		}
+
+	      pp_string (buffer, first ? "tagged limited " : " with ");
+	    }
+	  else if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node))
+		   && TYPE_METHODS (TREE_TYPE (node)))
+	    pp_string (buffer, "limited ");
+
+	  dump_generic_ada_node
+	    (buffer, TREE_TYPE (node), type, cpp_check, spc, false, false);
+	}
+      break;
+
+    case VAR_DECL:
+    case PARM_DECL:
+    case FIELD_DECL:
+    case NAMESPACE_DECL:
+      dump_ada_decl_name (buffer, node, false);
+      break;
+
+    default:
+      /* Ignore other nodes (e.g. expressions).  */
+      return 0;
+    }
+
+  return 1;
+}
+
+/* Dump in BUFFER NODE's methods.  CPP_CHECK is used to perform C++ queries on
+   nodes.  SPC is the indentation level.  */
+
+static void
+print_ada_methods (pretty_printer *buffer, tree node,
+		   int (*cpp_check)(tree, cpp_operation), int spc)
+{
+  tree tmp = TYPE_METHODS (node);
+  int res = 1;
+
+  if (tmp)
+    {
+      pp_semicolon (buffer);
+
+      for (; tmp; tmp = TREE_CHAIN (tmp))
+	{
+	  if (res)
+	    {
+	      pp_newline (buffer);
+	      pp_newline (buffer);
+	    }
+	  res = print_ada_declaration (buffer, tmp, node, cpp_check, spc);
+	}
+    }
+}
+
+/* Dump in BUFFER anonymous types nested inside T's definition.
+   PARENT is the parent node of T.  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,
+		   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;
+
+  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, 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, 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);
+    }
+}
+
+/* Dump in BUFFER destructor spec corresponding to T.  */
+
+static void
+print_destructor (pretty_printer *buffer, tree t)
+{
+  const char *s = IDENTIFIER_POINTER (DECL_NAME (t));
+
+  if (*s == '_')
+    for (s += 2; *s != ' '; s++)
+      pp_character (buffer, *s);
+  else
+    {
+      pp_string (buffer, "Delete_");
+      pp_ada_tree_identifier (buffer, DECL_NAME (t), t, false);
+    }
+}
+
+/* Return the name of type T.  */
+
+static const char *
+type_name (tree t)
+{
+  tree n = TYPE_NAME (t);
+
+  if (TREE_CODE (n) == IDENTIFIER_NODE)
+    return IDENTIFIER_POINTER (n);
+  else
+    return IDENTIFIER_POINTER (DECL_NAME (n));
+}
+
+/* Print in BUFFER the declaration of a variable T of type TYPE in Ada syntax.
+   CPP_CHECK is used to perform C++ queries on nodes.  SPC is the indentation
+   level.  Return 1 if a declaration was printed, 0 otherwise.  */
+
+static int
+print_ada_declaration (pretty_printer *buffer, tree t, tree type,
+		       int (*cpp_check)(tree, cpp_operation), int spc)
+{
+  int is_var = 0, need_indent = 0;
+  int is_class = false;
+  tree name = TYPE_NAME (TREE_TYPE (t));
+  tree decl_name = DECL_NAME (t);
+  bool dump_internal = get_dump_file_info (TDI_ada)->flags & TDF_RAW;
+  tree orig = NULL_TREE;
+
+  if (cpp_check && cpp_check (t, IS_TEMPLATE))
+    return dump_ada_template (buffer, t, cpp_check, spc);
+
+  if (TREE_CODE (t) == CONST_DECL && TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE)
+    /* Skip enumeral values: will be handled as part of the type itself.  */
+    return 0;
+
+  if (TREE_CODE (t) == TYPE_DECL)
+    {
+      orig = DECL_ORIGINAL_TYPE (t);
+
+      if (orig && TYPE_STUB_DECL (orig))
+	{
+	  tree typ = TREE_TYPE (TYPE_STUB_DECL (orig));
+
+	  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
+		{
+		  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);
+		return 1;
+	      }
+
+	    if (orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
+	      pp_string (buffer, "subtype ");
+	    else
+	      {
+		dump_nested_types (buffer, t, t, cpp_check, spc);
+
+		if (TYPE_METHODS (TREE_TYPE (t))
+		    || has_static_fields (TREE_TYPE (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;
+
+	  default:
+	    pp_string (buffer, "subtype ");
+	}
+    }
+  else
+    {
+      if (!dump_internal
+	  && TREE_CODE (t) == VAR_DECL
+	  && decl_name
+	  && *IDENTIFIER_POINTER (decl_name) == '_')
+	return 0;
+
+      need_indent = 1;
+    }
+
+  /* Print the type and name.  */
+  if (TREE_CODE (TREE_TYPE (t)) == ARRAY_TYPE)
+    {
+      if (need_indent)
+	INDENT (spc);
+
+      /* Print variable's name.  */
+      dump_generic_ada_node (buffer, t, type, cpp_check, spc, false, true);
+
+      if (TREE_CODE (t) == TYPE_DECL)
+	{
+	  pp_string (buffer, " is ");
+
+	  if (orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
+	    dump_generic_ada_node
+	      (buffer, TYPE_NAME (orig), type,
+	       cpp_check, spc, false, true);
+	  else
+	    dump_ada_array_type (buffer, t, spc);
+	}
+      else
+	{
+	  tree tmp = TYPE_NAME (TREE_TYPE (t));
+
+	  if (spc == INDENT_INCR || TREE_STATIC (t))
+	    is_var = 1;
+
+	  pp_string (buffer, " : ");
+
+	  if (tmp)
+	    {
+	      if (TREE_CODE (TREE_TYPE (tmp)) != POINTER_TYPE
+		  && TREE_CODE (tmp) != INTEGER_TYPE)
+		pp_string (buffer, "aliased ");
+
+	      dump_generic_ada_node (buffer, tmp, type, 0, spc, false, true);
+	    }
+	  else
+	    {
+	      pp_string (buffer, "aliased ");
+
+	      if (!type)
+		dump_ada_array_type (buffer, t, spc);
+	      else
+		dump_ada_double_name (buffer, type, t, "_array");
+	    }
+	}
+    }
+  else if (TREE_CODE (t) == FUNCTION_DECL)
+    {
+      bool is_function = true, is_method, is_abstract_class = false;
+      tree decl_name = DECL_NAME (t);
+      int prev_in_function = in_function;
+      bool is_abstract = false;
+      bool is_constructor = false;
+      bool is_destructor = false;
+      bool is_copy_constructor = false;
+
+      if (!decl_name)
+	return 0;
+
+      if (cpp_check)
+	{
+	  is_abstract = cpp_check (t, IS_ABSTRACT);
+	  is_constructor = cpp_check (t, IS_CONSTRUCTOR);
+	  is_destructor = cpp_check (t, IS_DESTRUCTOR);
+	  is_copy_constructor = cpp_check (t, IS_COPY_CONSTRUCTOR);
+	}
+
+      /* Skip __comp_dtor destructor which is redundant with the '~class()'
+	 destructor.  */
+      if (is_destructor
+	  && !strncmp (IDENTIFIER_POINTER (decl_name), "__comp", 6))
+	return 0;
+
+      /* Skip copy constructors: some are internal only, and those that are
+	 not cannot be called easily from Ada anyway.  */
+      if (is_copy_constructor)
+	return 0;
+
+      /* If this function has an entry in the dispatch table, we cannot
+	 omit it.  */
+      if (!dump_internal && !DECL_VINDEX (t)
+	  && *IDENTIFIER_POINTER (decl_name) == '_')
+	{
+	  if (IDENTIFIER_POINTER (decl_name)[1] == '_')
+	    return 0;
+
+	  INDENT (spc);
+	  pp_string (buffer, "--  skipped func ");
+	  pp_string (buffer, IDENTIFIER_POINTER (decl_name));
+	  return 1;
+	}
+
+      if (need_indent)
+	INDENT (spc);
+
+      if (is_constructor)
+	pp_string (buffer, "function New_");
+      else if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t))))
+	{
+	  is_function = false;
+	  pp_string (buffer, "procedure ");
+	}
+      else
+	pp_string (buffer, "function ");
+
+      in_function = is_function;
+      is_method = TREE_CODE (TREE_TYPE (t)) == METHOD_TYPE;
+
+      if (is_destructor)
+	print_destructor (buffer, t);
+      else
+	dump_ada_decl_name (buffer, t, false);
+
+      dump_ada_function_declaration
+	(buffer, t, is_method, is_constructor, is_destructor, spc);
+      in_function = prev_in_function;
+
+      if (is_function)
+	{
+	  pp_string (buffer, " return ");
+
+	  if (is_constructor)
+	    {
+	      dump_ada_decl_name (buffer, t, false);
+	    }
+	  else
+	    {
+	      dump_generic_ada_node
+		(buffer, TREE_TYPE (TREE_TYPE (t)), type, cpp_check,
+		 spc, false, true);
+	    }
+	}
+
+      if (is_constructor && cpp_check && type
+	  && AGGREGATE_TYPE_P (type)
+	  && TYPE_METHODS (type))
+	{
+	  tree tmp = TYPE_METHODS (type);
+
+	  for (; tmp; tmp = TREE_CHAIN (tmp))
+	    if (cpp_check (tmp, IS_ABSTRACT))
+	      {
+		is_abstract_class = 1;
+		break;
+	      }
+	}
+
+      if (is_abstract || is_abstract_class)
+	pp_string (buffer, " is abstract");
+
+      pp_semicolon (buffer);
+      pp_string (buffer, "  -- ");
+      dump_sloc (buffer, t);
+
+      if (is_abstract)
+	return 1;
+
+      newline_and_indent (buffer, spc);
+
+      if (is_constructor)
+	{
+	  pp_string (buffer, "pragma CPP_Constructor (New_");
+	  dump_ada_decl_name (buffer, t, false);
+	  pp_string (buffer, ", \"");
+	  pp_asm_name (buffer, t);
+	  pp_string (buffer, "\");");
+	}
+      else if (is_destructor)
+	{
+	  pp_string (buffer, "pragma Import (CPP, ");
+	  print_destructor (buffer, t);
+	  pp_string (buffer, ", \"");
+	  pp_asm_name (buffer, t);
+	  pp_string (buffer, "\");");
+	}
+      else
+	{
+	  dump_ada_import (buffer, t);
+	}
+
+      return 1;
+    }
+  else if (TREE_CODE (t) == TYPE_DECL && !DECL_ORIGINAL_TYPE (t))
+    {
+      int is_interface = 0;
+      int is_abstract_record = 0;
+
+      if (need_indent)
+	INDENT (spc);
+
+      /* Anonymous structs/unions */
+      dump_generic_ada_node
+	(buffer, TREE_TYPE (t), t, cpp_check, spc, false, true);
+
+      if (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE
+	  || TREE_CODE (TREE_TYPE (t)) == QUAL_UNION_TYPE)
+	{
+	  pp_string (buffer, " (discr : unsigned := 0)");
+	}
+
+      pp_string (buffer, " is ");
+
+      /* Check whether we have an Ada interface compatible class.  */
+      if (cpp_check && AGGREGATE_TYPE_P (TREE_TYPE (t))
+	  && TYPE_METHODS (TREE_TYPE (t)))
+	{
+	  int num_fields = 0;
+	  tree tmp = TYPE_FIELDS (TREE_TYPE (t));
+
+	  /* Check that there are no fields other than the virtual table.  */
+	  for (; tmp; tmp = TREE_CHAIN (tmp))
+	    {
+	      if (TREE_CODE (tmp) == TYPE_DECL)
+		continue;
+	      num_fields++;
+	    }
+
+	  if (num_fields == 1)
+	    is_interface = 1;
+
+	  /* Also check that there are only virtual methods.  */
+	  for (tmp = TYPE_METHODS (TREE_TYPE (t)); tmp; tmp = TREE_CHAIN (tmp))
+	    {
+	      if (cpp_check (tmp, IS_ABSTRACT))
+		is_abstract_record = 1;
+	      else
+		is_interface = 0;
+	    }
+	}
+
+      if (is_interface)
+	{
+	  pp_string (buffer, "limited interface;  -- ");
+	  dump_sloc (buffer, t);
+	  newline_and_indent (buffer, spc);
+	  pp_string (buffer, "pragma Import (CPP, ");
+ 	  dump_generic_ada_node
+	    (buffer, TYPE_NAME (TREE_TYPE (t)), type, cpp_check,
+	     spc, false, true);
+  	  pp_character (buffer, ')');
+
+	  print_ada_methods (buffer, TREE_TYPE (t), cpp_check, spc);
+	}
+      else
+	{
+	  if (is_abstract_record)
+	    pp_string (buffer, "abstract ");
+	  dump_generic_ada_node (buffer, t, t, cpp_check, spc, false, false);
+	}
+    }
+  else
+    {
+      if (need_indent)
+	INDENT (spc);
+
+      if (TREE_CODE (t) == FIELD_DECL && DECL_NAME (t))
+	check_name (buffer, t);
+
+      /* Print variable/type's name.  */
+      dump_generic_ada_node (buffer, t, t, cpp_check, spc, false, true);
+
+      if (TREE_CODE (t) == TYPE_DECL)
+	{
+	  tree orig = DECL_ORIGINAL_TYPE (t);
+	  int is_subtype = orig && TYPE_NAME (orig) && orig != TREE_TYPE (t);
+
+	  if (!is_subtype
+	      && (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE
+		  || TREE_CODE (TREE_TYPE (t)) == QUAL_UNION_TYPE))
+	    pp_string (buffer, " (discr : unsigned := 0)");
+
+	  pp_string (buffer, " is ");
+
+	  dump_generic_ada_node
+	    (buffer, orig, t, cpp_check, spc, false, is_subtype);
+	}
+      else
+	{
+	  if (spc == INDENT_INCR || TREE_STATIC (t))
+	    is_var = 1;
+
+	  pp_string (buffer, " : ");
+
+	  /* Print type declaration.  */
+
+	  if (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE
+	      && !TYPE_NAME (TREE_TYPE (t)))
+	    {
+	      dump_ada_double_name (buffer, type, t, "_union");
+	    }
+	  else if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t)))
+	    {
+	      if (TREE_CODE (TREE_TYPE (t)) == RECORD_TYPE)
+		pp_string (buffer, "aliased ");
+
+	      dump_generic_ada_node
+		(buffer, TREE_TYPE (t), t, cpp_check, spc, false, true);
+	    }
+	  else
+	    {
+	      if (TREE_CODE (TREE_TYPE (t)) != POINTER_TYPE
+		  && (TYPE_NAME (TREE_TYPE (t))
+		      || TREE_CODE (TREE_TYPE (t)) != INTEGER_TYPE))
+		pp_string (buffer, "aliased ");
+
+	      dump_generic_ada_node
+		(buffer, TREE_TYPE (t), TREE_TYPE (t), cpp_check,
+		 spc, false, true);
+	    }
+	}
+    }
+
+  if (is_class)
+    {
+      spc -= 3;
+      newline_and_indent (buffer, spc);
+      pp_string (buffer, "end;");
+      newline_and_indent (buffer, spc);
+      pp_string (buffer, "use Class_");
+      dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
+      pp_semicolon (buffer);
+      pp_newline (buffer);
+
+      /* All needed indentation/newline performed already, so return 0.  */
+      return 0;
+    }
+  else
+    {
+      pp_string (buffer, ";  -- ");
+      dump_sloc (buffer, t);
+    }
+
+  if (is_var)
+    {
+      newline_and_indent (buffer, spc);
+      dump_ada_import (buffer, t);
+    }
+
+  return 1;
+}
+
+/* Prints in BUFFER a structure NODE of type TYPE: name, fields, and methods
+   with Ada syntax.  CPP_CHECK is used to perform C++ queries on nodes.  SPC
+   is the indentation level.  If DISPLAY_CONVENTION is true, also print the
+   pragma Convention for NODE.  */
+
+static void
+print_ada_struct_decl (pretty_printer *buffer, tree node, tree type,
+		       int (*cpp_check)(tree, cpp_operation), int spc,
+		       bool display_convention)
+{
+  tree tmp;
+  int is_union =
+    TREE_CODE (node) == UNION_TYPE || TREE_CODE (node) == QUAL_UNION_TYPE;
+  char buf [16];
+  int field_num = 0;
+  int field_spc = spc + INDENT_INCR;
+  int need_semicolon;
+
+  bitfield_used = false;
+
+  if (!TYPE_FIELDS (node))
+    pp_string (buffer, "null record;");
+  else
+    {
+      pp_string (buffer, "record");
+
+      /* Print the contents of the structure.  */
+
+      if (is_union)
+	{
+	  newline_and_indent (buffer, spc + INDENT_INCR);
+	  pp_string (buffer, "case discr is");
+	  field_spc = spc + INDENT_INCR * 3;
+	}
+
+      pp_newline (buffer);
+
+      /* Print the non-static fields of the structure.  */
+      for (tmp = TYPE_FIELDS (node); tmp; tmp = TREE_CHAIN (tmp))
+	{
+	  /* Add parent field if needed.  */
+	  if (!DECL_NAME (tmp))
+	    {
+	      if (!is_tagged_type (TREE_TYPE (tmp)))
+		{
+		  if (!TYPE_NAME (TREE_TYPE (tmp)))
+		    print_ada_declaration
+		      (buffer, tmp, type, cpp_check, field_spc);
+		  else
+		    {
+		      INDENT (field_spc);
+
+		      if (field_num == 0)
+			pp_string (buffer, "parent : ");
+		      else
+			{
+			  sprintf (buf, "field_%d : ", field_num + 1);
+			  pp_string (buffer, buf);
+			}
+		      dump_ada_decl_name
+			(buffer, TYPE_NAME (TREE_TYPE (tmp)), false);
+		      pp_semicolon (buffer);
+		    }
+		  pp_newline (buffer);
+		  field_num++;
+		}
+	    }
+	  /* Avoid printing the structure recursively.  */
+	  else if ((TREE_TYPE (tmp) != node
+		   || (TREE_CODE (TREE_TYPE (tmp)) == POINTER_TYPE
+		       && TREE_TYPE (TREE_TYPE (tmp)) != node))
+		   && TREE_CODE (tmp) != TYPE_DECL
+		   && !TREE_STATIC (tmp))
+	    {
+	      /* Skip internal virtual table field.  */
+	      if (strncmp (IDENTIFIER_POINTER (DECL_NAME (tmp)), "_vptr", 5))
+		{
+		  if (is_union)
+		    {
+		      if (TREE_CHAIN (tmp)
+			  && TREE_TYPE (TREE_CHAIN (tmp)) != node
+			  && TREE_CODE (TREE_CHAIN (tmp)) != TYPE_DECL)
+			sprintf (buf, "when %d =>", field_num);
+		      else
+			sprintf (buf, "when others =>");
+
+		      INDENT (spc + INDENT_INCR * 2);
+		      pp_string (buffer, buf);
+		      pp_newline (buffer);
+		    }
+
+		  if (print_ada_declaration (buffer,
+					     tmp, type, cpp_check, field_spc))
+		    {
+		      pp_newline (buffer);
+		      field_num++;
+		    }
+		}
+	    }
+	}
+
+      if (is_union)
+	{
+	  INDENT (spc + INDENT_INCR);
+	  pp_string (buffer, "end case;");
+	  pp_newline (buffer);
+	}
+
+      if (field_num == 0)
+	{
+	  INDENT (spc + INDENT_INCR);
+	  pp_string (buffer, "null;");
+	  pp_newline (buffer);
+	}
+
+      INDENT (spc);
+      pp_string (buffer, "end record;");
+    }
+
+  newline_and_indent (buffer, spc);
+
+  if (!display_convention)
+    return;
+
+  if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (type)))
+    {
+      if (TYPE_METHODS (TREE_TYPE (type)))
+	pp_string (buffer, "pragma Import (CPP, ");
+      else
+	pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
+    }
+  else
+    pp_string (buffer, "pragma Convention (C, ");
+
+  package_prefix = false;
+  dump_generic_ada_node
+    (buffer, TREE_TYPE (type), type, cpp_check, spc, false, true);
+  package_prefix = true;
+  pp_character (buffer, ')');
+
+  if (is_union)
+    {
+      pp_semicolon (buffer);
+      newline_and_indent (buffer, spc);
+      pp_string (buffer, "pragma Unchecked_Union (");
+
+      dump_generic_ada_node
+	(buffer, TREE_TYPE (type), type, cpp_check, spc, false, true);
+      pp_character (buffer, ')');
+    }
+
+  if (bitfield_used)
+    {
+      pp_semicolon (buffer);
+      newline_and_indent (buffer, spc);
+      pp_string (buffer, "pragma Pack (");
+      dump_generic_ada_node
+	(buffer, TREE_TYPE (type), type, cpp_check, spc, false, true);
+      pp_character (buffer, ')');
+      bitfield_used = false;
+    }
+
+  print_ada_methods (buffer, node, cpp_check, spc);
+
+  /* Print the static fields of the structure, if any.  */
+  need_semicolon = TYPE_METHODS (node) == NULL_TREE;
+  for (tmp = TYPE_FIELDS (node); tmp; tmp = TREE_CHAIN (tmp))
+    {
+      if (DECL_NAME (tmp) && TREE_STATIC (tmp))
+	{
+	  if (need_semicolon)
+	    {
+	      need_semicolon = false;
+	      pp_semicolon (buffer);
+	    }
+	  pp_newline (buffer);
+	  pp_newline (buffer);
+	  print_ada_declaration (buffer, tmp, type, cpp_check, spc);
+	}
+    }
+}
+
+/* Dump all the declarations in SOURCE_FILE to an Ada spec.
+   COLLECT_ALL_REFS is a front-end callback used to collect all relevant
+   nodes for SOURCE_FILE.  CPP_CHECK is used to perform C++ queries on
+   nodes.  */
+
+static void
+dump_ads (const char *source_file,
+	  void (*collect_all_refs)(const char *),
+	  int (*cpp_check)(tree, cpp_operation))
+{
+  char *ads_name;
+  char *pkg_name;
+  char *s;
+  FILE *f;
+
+  pkg_name = get_ada_package (source_file);
+
+  /* Construct the the .ads filename and package name.  */
+  ads_name = xstrdup (pkg_name);
+
+  for (s = ads_name; *s; s++)
+    *s = TOLOWER (*s);
+
+  ads_name = reconcat (ads_name, ads_name, ".ads", NULL);
+
+  /* Write out the .ads file.  */
+  f = fopen (ads_name, "w");
+  if (f)
+    {
+      pretty_printer pp;
+
+      pp_construct (&pp, NULL, 0);
+      pp_needs_newline (&pp) = true;
+      pp.buffer->stream = f;
+
+      /* Dump all relevant macros.  */
+      dump_ada_macros (&pp, source_file);
+
+      /* Reset the table of withs for this file.  */
+      reset_ada_withs ();
+
+      (*collect_all_refs) (source_file);
+
+      /* Dump all references.  */
+      dump_ada_nodes (&pp, source_file, cpp_check);
+
+      /* Dump withs.  */
+      dump_ada_withs (f);
+
+      fprintf (f, "\npackage %s is\n\n", pkg_name);
+      pp_write_text_to_stream (&pp);
+      /* ??? need to free pp */
+      fprintf (f, "end %s;\n", pkg_name);
+      fclose (f);
+    }
+
+  free (ads_name);
+  free (pkg_name);
+}
+
+static const char **source_refs = NULL;
+static int source_refs_used = 0;
+static int source_refs_allocd = 0;
+
+/* Add an entry for FILENAME to the table SOURCE_REFS.  */
+
+void
+collect_source_ref (const char *filename)
+{
+  int i;
+
+  if (!filename)
+    return;
+
+  if (source_refs_allocd == 0)
+    {
+      source_refs_allocd = 1024;
+      source_refs = (const char **)
+	xmalloc (source_refs_allocd * sizeof (const char *));
+    }
+
+  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 = (const char **)
+	xrealloc (source_refs, source_refs_allocd * sizeof (const char *));
+    }
+
+  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);
+}
Index: gcc/testsuite/gnat.dg/c-specs/inner_struct1.h
===================================================================
--- gcc/testsuite/gnat.dg/c-specs/inner_struct1.h	(revision 0)
+++ gcc/testsuite/gnat.dg/c-specs/inner_struct1.h	(revision 0)
@@ -0,0 +1,11 @@
+/* { dg-options "-fdump-ada-spec" } */
+
+struct inner;
+
+typedef struct {
+ struct inner *p;
+} outer;
+
+struct inner {
+ int f;
+};
Index: gcc/testsuite/gnat.dg/c-specs/inner_struct2.h
===================================================================
--- gcc/testsuite/gnat.dg/c-specs/inner_struct2.h	(revision 0)
+++ gcc/testsuite/gnat.dg/c-specs/inner_struct2.h	(revision 0)
@@ -0,0 +1,7 @@
+/* { dg-options "-fdump-ada-spec" } */
+
+ struct _outer {
+   struct _inner {
+     int x;
+   } inner;
+ } outer;
Index: gcc/testsuite/gnat.dg/c-specs/c-specs.exp
===================================================================
--- gcc/testsuite/gnat.dg/c-specs/c-specs.exp	(revision 0)
+++ gcc/testsuite/gnat.dg/c-specs/c-specs.exp	(revision 0)
@@ -0,0 +1,35 @@
+# Copyright (C) 2010 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+# 
+# This program 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/>.
+
+# GCC testsuite that uses the `dg.exp' driver.
+
+# Load support procs.
+load_lib gnat-dg.exp
+
+# If a testcase doesn't have special options, use these.
+global DEFAULT_CFLAGS
+if ![info exists DEFAULT_CFLAGS] then {
+    set DEFAULT_CFLAGS ""
+}
+
+# Initialize `dg'.
+dg-init
+
+# Main loop.
+dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/*.h]] "" $DEFAULT_CFLAGS
+
+# All done.
+dg-finish
Index: gcc/testsuite/gnat.dg/c-specs/inner_struct3.h
===================================================================
--- gcc/testsuite/gnat.dg/c-specs/inner_struct3.h	(revision 0)
+++ gcc/testsuite/gnat.dg/c-specs/inner_struct3.h	(revision 0)
@@ -0,0 +1,7 @@
+/* { dg-options "-fdump-ada-spec" } */
+
+struct _outer {
+  struct inner {
+    struct _outer * (*fn)(void);
+  } fld;
+};
Index: gcc/testsuite/gnat.dg/c-specs/inner_struct4.h
===================================================================
--- gcc/testsuite/gnat.dg/c-specs/inner_struct4.h	(revision 0)
+++ gcc/testsuite/gnat.dg/c-specs/inner_struct4.h	(revision 0)
@@ -0,0 +1,5 @@
+/* { dg-options "-fdump-ada-spec" } */
+
+ typedef struct tag_foo {
+    struct { int inner_field; } outer_field[6];
+ } foo;
Index: gcc/testsuite/gnat.dg/c-specs/comments1.h
===================================================================
--- gcc/testsuite/gnat.dg/c-specs/comments1.h	(revision 0)
+++ gcc/testsuite/gnat.dg/c-specs/comments1.h	(revision 0)
@@ -0,0 +1,17 @@
+/* { dg-options "-fdump-ada-spec -C" } */
+
+/* 
+   This is a test of capturing comments in generated specs. 
+   foo.
+*/
+
+/* Define an integer called 'a'. */
+int a; 
+
+// Define an integer called 'b'.
+int b;
+
+/* Define an integer called 'c'. */
+int c;
+
+/* File ends here! */
Index: gcc/testsuite/gnat.dg/c-specs/typedefs_second.h
===================================================================
--- gcc/testsuite/gnat.dg/c-specs/typedefs_second.h	(revision 0)
+++ gcc/testsuite/gnat.dg/c-specs/typedefs_second.h	(revision 0)
@@ -0,0 +1,7 @@
+/* { dg-options "-fdump-ada-spec" } */
+
+  typedef struct
+  {
+    int c;
+    int d;
+  } second;
Index: gcc/testsuite/gnat.dg/c-specs/typedef0.h
===================================================================
--- gcc/testsuite/gnat.dg/c-specs/typedef0.h	(revision 0)
+++ gcc/testsuite/gnat.dg/c-specs/typedef0.h	(revision 0)
@@ -0,0 +1,16 @@
+/* { dg-options "-fdump-ada-spec" } */
+
+typedef struct
+{
+  union
+  {
+    int wch;
+    char wchb[4];
+  } value;
+} mbstate_t;
+
+typedef struct 
+{
+  mbstate_t m;
+} s1;
+
Index: gcc/testsuite/gnat.dg/c-specs/typedef1.h
===================================================================
--- gcc/testsuite/gnat.dg/c-specs/typedef1.h	(revision 0)
+++ gcc/testsuite/gnat.dg/c-specs/typedef1.h	(revision 0)
@@ -0,0 +1,5 @@
+/* { dg-options "-fdump-ada-spec" } */
+
+#include "typedef0.h"
+
+typedef s1 s2;
Index: gcc/testsuite/gnat.dg/c-specs/typedef2.h
===================================================================
--- gcc/testsuite/gnat.dg/c-specs/typedef2.h	(revision 0)
+++ gcc/testsuite/gnat.dg/c-specs/typedef2.h	(revision 0)
@@ -0,0 +1,5 @@
+/* { dg-options "-fdump-ada-spec" } */
+
+#include "typedef3.h"
+
+typedef s1 s2;
Index: gcc/testsuite/gnat.dg/c-specs/struct_array.h
===================================================================
--- gcc/testsuite/gnat.dg/c-specs/struct_array.h	(revision 0)
+++ gcc/testsuite/gnat.dg/c-specs/struct_array.h	(revision 0)
@@ -0,0 +1,4 @@
+/* { dg-options "-fdump-ada-spec" } */
+
+typedef struct { int f[2]; } s1;
+typedef s1 s2;
Index: gcc/testsuite/gnat.dg/c-specs/macro1.h
===================================================================
--- gcc/testsuite/gnat.dg/c-specs/macro1.h	(revision 0)
+++ gcc/testsuite/gnat.dg/c-specs/macro1.h	(revision 0)
@@ -0,0 +1,7 @@
+/* { dg-options "-fdump-ada-spec" } */
+
+#define IN_CLASSA_NET           0xff000000U
+#define NULL 0
+#define ARG_MACRO(a)   foo(a)
+
+extern int foo();
Index: gcc/testsuite/gnat.dg/c-specs/unknown_struct0.h
===================================================================
--- gcc/testsuite/gnat.dg/c-specs/unknown_struct0.h	(revision 0)
+++ gcc/testsuite/gnat.dg/c-specs/unknown_struct0.h	(revision 0)
@@ -0,0 +1,8 @@
+/* { dg-options "-fdump-ada-spec" } */
+
+struct _IO_FILE;
+
+struct _IO_FILE {
+  int f;
+};
+
Index: gcc/testsuite/gnat.dg/c-specs/typedefs.h
===================================================================
--- gcc/testsuite/gnat.dg/c-specs/typedefs.h	(revision 0)
+++ gcc/testsuite/gnat.dg/c-specs/typedefs.h	(revision 0)
@@ -0,0 +1,12 @@
+/* { dg-options "-fdump-ada-spec" } */
+
+  #include "typedefs_second.h"
+
+  typedef struct
+  {
+    int a;
+    int b;
+  } first;
+
+  typedef first first_bis;
+  typedef second second_bis;
Index: gcc/testsuite/gnat.dg/c-specs/typedef3.h
===================================================================
--- gcc/testsuite/gnat.dg/c-specs/typedef3.h	(revision 0)
+++ gcc/testsuite/gnat.dg/c-specs/typedef3.h	(revision 0)
@@ -0,0 +1,5 @@
+/* { dg-options "-fdump-ada-spec" } */
+
+typedef struct {
+  int f;
+} s1;
Index: gcc/testsuite/gnat.dg/c-specs/unknown_struct1.h
===================================================================
--- gcc/testsuite/gnat.dg/c-specs/unknown_struct1.h	(revision 0)
+++ gcc/testsuite/gnat.dg/c-specs/unknown_struct1.h	(revision 0)
@@ -0,0 +1,6 @@
+/* { dg-options "-fdump-ada-spec" } */
+
+typedef struct _IO_FILE FILE;
+typedef struct _IO_FILE __FILE;
+
+#include "unknown_struct0.h"
Index: gcc/testsuite/gnat.dg/c-specs/animals.h
===================================================================
--- gcc/testsuite/gnat.dg/c-specs/animals.h	(revision 0)
+++ gcc/testsuite/gnat.dg/c-specs/animals.h	(revision 0)
@@ -0,0 +1,28 @@
+/* { dg-options "-fdump-ada-spec -x c++" } */
+
+class Carnivore {
+public:
+   virtual int Number_Of_Teeth () = 0;
+};
+
+class Domestic {
+public:
+   virtual void Set_Owner (char* Name) = 0;
+};
+
+class Animal {
+public:
+  int Age_Count;
+  virtual void Set_Age (int New_Age);
+};
+
+class Dog : Animal, Carnivore, Domestic {
+ public:
+  int  Tooth_Count;
+  char *Owner;
+
+  virtual int  Number_Of_Teeth ();
+  virtual void Set_Owner (char* Name);
+
+  Dog(); // Constructor
+};
Index: gcc/testsuite/gnat.dg/c-specs/enum1.h
===================================================================
--- gcc/testsuite/gnat.dg/c-specs/enum1.h	(revision 0)
+++ gcc/testsuite/gnat.dg/c-specs/enum1.h	(revision 0)
@@ -0,0 +1,3 @@
+/* { dg-options "-fdump-ada-spec" } */
+
+enum simple_enum { ZERO, ONE, TWO };
Index: gcc/testsuite/gnat.dg/c-specs/unknown_struct2.h
===================================================================
--- gcc/testsuite/gnat.dg/c-specs/unknown_struct2.h	(revision 0)
+++ gcc/testsuite/gnat.dg/c-specs/unknown_struct2.h	(revision 0)
@@ -0,0 +1,4 @@
+/* { dg-options "-fdump-ada-spec" } */
+
+struct s;
+struct t {};


More information about the Gcc-patches mailing list