gcc/c-family/c-ada-spec.c

   1 /* Print GENERIC declaration (functions, variables, types) trees coming from
   2    the C and C++ front-ends as well as macros in Ada syntax.
   3    Copyright (C) 2010 Free Software Foundation, Inc.
   4    Adapted from tree-pretty-print.c by Arnaud Charlet  <charlet@adacore.com>
   5
   6 This file is part of GCC.
   7
   8 GCC is free software; you can redistribute it and/or modify it under
   9 the terms of the GNU General Public License as published by the Free
  10 Software Foundation; either version 3, or (at your option) any later
  11 version.
  12
  13 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
  14 WARRANTY; without even the implied warranty of MERCHANTABILITY or
  15 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  16 for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with GCC; see the file COPYING3.  If not see
  20 <http://www.gnu.org/licenses/>.  */
  21
  22 #include "config.h"
  23 #include "system.h"
  24 #include "coretypes.h"
  25 #include "tm.h"
  26 #include "tree.h"
  27 #include "tree-pass.h"  /* For TDI_ada and friends.  */
  28 #include "output.h"
  29 #include "c-ada-spec.h"
  30 #include "cpplib.h"
  31 #include "c-pragma.h"
  32 #include "cpp-id-data.h"
  33
  34 /* Local functions, macros and variables.  */
  35 static int dump_generic_ada_node (pretty_printer *, tree, tree,
  36                                   int (*)(tree, cpp_operation), int, int, bool);
  37 static int print_ada_declaration (pretty_printer *, tree, tree,
  38                                   int (*cpp_check)(tree, cpp_operation), int);
  39 static void print_ada_struct_decl (pretty_printer *, tree, tree,
  40                                    int (*cpp_check)(tree, cpp_operation), int,
  41                                    bool);
  42 static void dump_sloc (pretty_printer *buffer, tree node);
  43 static void print_comment (pretty_printer *, const char *);
  44 static void print_generic_ada_decl (pretty_printer *, tree,
  45                                     int (*)(tree, cpp_operation), const char *);
  46 static char *get_ada_package (const char *);
  47 static void dump_ada_nodes (pretty_printer *, const char *,
  48                             int (*)(tree, cpp_operation));
  49 static void reset_ada_withs (void);
  50 static void dump_ada_withs (FILE *);
  51 static void dump_ads (const char *, void (*)(const char *),
  52                       int (*)(tree, cpp_operation));
  53 static char *to_ada_name (const char *, int *);
  54 static bool separate_class_package (tree);
  55
  56 #define LOCATION_COL(LOC) ((expand_location (LOC)).column)
  57
  58 #define INDENT(SPACE) do { \
  59   int i; for (i = 0; i<SPACE; i++) pp_space (buffer); } while (0)
  60
  61 #define INDENT_INCR 3
  62
  63 /* Given a cpp MACRO, compute the max length BUFFER_LEN of the macro, as well
  64    as max length PARAM_LEN of arguments for fun_like macros, and also set
  65    SUPPORTED to 0 if the macro cannot be mapped to an Ada construct.  */
  66
  67 static void
  68 macro_length (const cpp_macro *macro, int *supported, int *buffer_len,
  69               int *param_len)
  70 {
  71   int i;
  72   unsigned j;
  73
  74   *supported = 1;
  75   *buffer_len = 0;
  76   *param_len = 0;
  77
  78   if (macro->fun_like)
  79     {
  80       param_len++;
  81       for (i = 0; i < macro->paramc; i++)
  82         {
  83           cpp_hashnode *param = macro->params[i];
  84
  85           *param_len += NODE_LEN (param);
  86
  87           if (i + 1 < macro->paramc)
  88             {
  89               *param_len += 2;  /* ", " */
  90             }
  91           else if (macro->variadic)
  92             {
  93               *supported = 0;
  94               return;
  95             }
  96         }
  97       *param_len += 2;  /* ")\0" */
  98     }
  99
 100   for (j = 0; j < macro->count; j++)
 101     {
 102       cpp_token *token = &macro->exp.tokens[j];
 103
 104       if (token->flags & PREV_WHITE)
 105         (*buffer_len)++;
 106
 107       if (token->flags & STRINGIFY_ARG || token->flags & PASTE_LEFT)
 108         {
 109           *supported = 0;
 110           return;
 111         }
 112
 113       if (token->type == CPP_MACRO_ARG)
 114         *buffer_len +=
 115           NODE_LEN (macro->params[token->val.macro_arg.arg_no - 1]);
 116       else
 117         /* Include enough extra space to handle e.g. special characters.  */
 118         *buffer_len += (cpp_token_len (token) + 1) * 8;
 119     }
 120
 121   (*buffer_len)++;
 122 }
 123
 124 /* Dump into PP a set of MAX_ADA_MACROS MACROS (C/C++) as Ada constants when
 125    possible.  */
 126
 127 static void
 128 print_ada_macros (pretty_printer *pp, cpp_hashnode **macros, int max_ada_macros)
 129 {
 130   int j, num_macros = 0, prev_line = -1;
 131
 132   for (j = 0; j < max_ada_macros; j++)
 133     {
 134       cpp_hashnode *node = macros [j];
 135       const cpp_macro *macro = node->value.macro;
 136       unsigned i;
 137       int supported = 1, prev_is_one = 0, buffer_len, param_len;
 138       int is_string = 0, is_char = 0;
 139       char *ada_name;
 140       unsigned char *s, *params, *buffer, *buf_param, *char_one = NULL;
 141
 142       macro_length (macro, &supported, &buffer_len, &param_len);
 143       s = buffer = XALLOCAVEC (unsigned char, buffer_len);
 144       params = buf_param = XALLOCAVEC (unsigned char, param_len);
 145
 146       if (supported)
 147         {
 148           if (macro->fun_like)
 149             {
 150               *buf_param++ = '(';
 151               for (i = 0; i < macro->paramc; i++)
 152                 {
 153                   cpp_hashnode *param = macro->params[i];
 154
 155                   memcpy (buf_param, NODE_NAME (param), NODE_LEN (param));
 156                   buf_param += NODE_LEN (param);
 157
 158                   if (i + 1 < macro->paramc)
 159                     {
 160                       *buf_param++ = ',';
 161                       *buf_param++ = ' ';
 162                     }
 163                   else if (macro->variadic)
 164                     {
 165                       supported = 0;
 166                       break;
 167                     }
 168                 }
 169               *buf_param++ = ')';
 170               *buf_param = '\0';
 171             }
 172
 173           for (i = 0; supported && i < macro->count; i++)
 174             {
 175               cpp_token *token = &macro->exp.tokens[i];
 176               int is_one = 0;
 177
 178               if (token->flags & PREV_WHITE)
 179                 *buffer++ = ' ';
 180
 181               if (token->flags & STRINGIFY_ARG || token->flags & PASTE_LEFT)
 182                 {
 183                   supported = 0;
 184                   break;
 185                 }
 186
 187               switch (token->type)
 188                 {
 189                   case CPP_MACRO_ARG:
 190                     {
 191                       cpp_hashnode *param =
 192                         macro->params[token->val.macro_arg.arg_no - 1];
 193                       memcpy (buffer, NODE_NAME (param), NODE_LEN (param));
 194                       buffer += NODE_LEN (param);
 195                     }
 196                     break;
 197
 198                   case CPP_EQ_EQ:       *buffer++ = '='; break;
 199                   case CPP_GREATER:     *buffer++ = '>'; break;
 200                   case CPP_LESS:        *buffer++ = '<'; break;
 201                   case CPP_PLUS:        *buffer++ = '+'; break;
 202                   case CPP_MINUS:       *buffer++ = '-'; break;
 203                   case CPP_MULT:        *buffer++ = '*'; break;
 204                   case CPP_DIV:         *buffer++ = '/'; break;
 205                   case CPP_COMMA:       *buffer++ = ','; break;
 206                   case CPP_OPEN_SQUARE:
 207                   case CPP_OPEN_PAREN:  *buffer++ = '('; break;
 208                   case CPP_CLOSE_SQUARE: /* fallthrough */
 209                   case CPP_CLOSE_PAREN: *buffer++ = ')'; break;
 210                   case CPP_DEREF:       /* fallthrough */
 211                   case CPP_SCOPE:       /* fallthrough */
 212                   case CPP_DOT:         *buffer++ = '.'; break;
 213
 214                   case CPP_EQ:          *buffer++ = ':'; *buffer++ = '='; break;
 215                   case CPP_NOT_EQ:      *buffer++ = '/'; *buffer++ = '='; break;
 216                   case CPP_GREATER_EQ:  *buffer++ = '>'; *buffer++ = '='; break;
 217                   case CPP_LESS_EQ:     *buffer++ = '<'; *buffer++ = '='; break;
 218
 219                   case CPP_NOT:
 220                     *buffer++ = 'n'; *buffer++ = 'o'; *buffer++ = 't'; break;
 221                   case CPP_MOD:
 222                     *buffer++ = 'm'; *buffer++ = 'o'; *buffer++ = 'd'; break;
 223                   case CPP_AND:
 224                     *buffer++ = 'a'; *buffer++ = 'n'; *buffer++ = 'd'; break;
 225                   case CPP_OR:
 226                     *buffer++ = 'o'; *buffer++ = 'r'; break;
 227                   case CPP_XOR:
 228                     *buffer++ = 'x'; *buffer++ = 'o'; *buffer++ = 'r'; break;
 229                   case CPP_AND_AND:
 230                     strcpy ((char *) buffer, " and then ");
 231                     buffer += 10;
 232                     break;
 233                   case CPP_OR_OR:
 234                     strcpy ((char *) buffer, " or else ");
 235                     buffer += 9;
 236                     break;
 237
 238                   case CPP_PADDING:
 239                     *buffer++ = ' ';
 240                     is_one = prev_is_one;
 241                     break;
 242
 243                   case CPP_COMMENT: break;
 244
 245                   case CPP_WSTRING:
 246                   case CPP_STRING16:
 247                   case CPP_STRING32:
 248                   case CPP_UTF8STRING:
 249                   case CPP_WCHAR:
 250                   case CPP_CHAR16:
 251                   case CPP_CHAR32:
 252                   case CPP_NAME:
 253                   case CPP_STRING:
 254                   case CPP_NUMBER:
 255                     if (!macro->fun_like)
 256                       supported = 0;
 257                     else
 258                       buffer = cpp_spell_token (parse_in, token, buffer, false);
 259                     break;
 260
 261                   case CPP_CHAR:
 262                     is_char = 1;
 263                     {
 264                       unsigned chars_seen;
 265                       int ignored;
 266                       cppchar_t c;
 267
 268                       c = cpp_interpret_charconst (parse_in, token,
 269                                                    &chars_seen, &ignored);
 270                       if (c >= 32 && c <= 126)
 271                         {
 272                           *buffer++ = '\'';
 273                           *buffer++ = (char) c;
 274                           *buffer++ = '\'';
 275                         }
 276                       else
 277                         {
 278                           chars_seen = sprintf
 279                             ((char *) buffer, "Character'Val (%d)", (int) c);
 280                           buffer += chars_seen;
 281                         }
 282                     }
 283                     break;
 284
 285                   case CPP_LSHIFT:
 286                     if (prev_is_one)
 287                       {
 288                         /* Replace "1 << N" by "2 ** N" */
 289                         *char_one = '2';
 290                         *buffer++ = '*';
 291                         *buffer++ = '*';
 292                         break;
 293                       }
 294                     /* fallthrough */
 295
 296                   case CPP_RSHIFT:
 297                   case CPP_COMPL:
 298                   case CPP_QUERY:
 299                   case CPP_EOF:
 300                   case CPP_PLUS_EQ:
 301                   case CPP_MINUS_EQ:
 302                   case CPP_MULT_EQ:
 303                   case CPP_DIV_EQ:
 304                   case CPP_MOD_EQ:
 305                   case CPP_AND_EQ:
 306                   case CPP_OR_EQ:
 307                   case CPP_XOR_EQ:
 308                   case CPP_RSHIFT_EQ:
 309                   case CPP_LSHIFT_EQ:
 310                   case CPP_PRAGMA:
 311                   case CPP_PRAGMA_EOL:
 312                   case CPP_HASH:
 313                   case CPP_PASTE:
 314                   case CPP_OPEN_BRACE:
 315                   case CPP_CLOSE_BRACE:
 316                   case CPP_SEMICOLON:
 317                   case CPP_ELLIPSIS:
 318                   case CPP_PLUS_PLUS:
 319                   case CPP_MINUS_MINUS:
 320                   case CPP_DEREF_STAR:
 321                   case CPP_DOT_STAR:
 322                   case CPP_ATSIGN:
 323                   case CPP_HEADER_NAME:
 324                   case CPP_AT_NAME:
 325                   case CPP_OTHER:
 326                   case CPP_OBJC_STRING:
 327                   default:
 328                     if (!macro->fun_like)
 329                       supported = 0;
 330                     else
 331                       buffer = cpp_spell_token (parse_in, token, buffer, false);
 332                     break;
 333                 }
 334
 335               prev_is_one = is_one;
 336             }
 337
 338           if (supported)
 339             *buffer = '\0';
 340         }
 341
 342       if (macro->fun_like && supported)
 343         {
 344           char *start = (char *) s;
 345           int is_function = 0;
 346
 347           pp_string (pp, "   --  arg-macro: ");
 348
 349           if (*start == '(' && buffer [-1] == ')')
 350             {
 351               start++;
 352               buffer [-1] = '\0';
 353               is_function = 1;
 354               pp_string (pp, "function ");
 355             }
 356           else
 357             {
 358               pp_string (pp, "procedure ");
 359             }
 360
 361           pp_string (pp, (const char *) NODE_NAME (node));
 362           pp_space (pp);
 363           pp_string (pp, (char *) params);
 364           pp_newline (pp);
 365           pp_string (pp, "   --    ");
 366
 367           if (is_function)
 368             {
 369               pp_string (pp, "return ");
 370               pp_string (pp, start);
 371               pp_semicolon (pp);
 372             }
 373           else
 374             pp_string (pp, start);
 375
 376           pp_newline (pp);
 377         }
 378       else if (supported)
 379         {
 380           expanded_location sloc = expand_location (macro->line);
 381
 382           if (sloc.line != prev_line + 1)
 383             pp_newline (pp);
 384
 385           num_macros++;
 386           prev_line = sloc.line;
 387
 388           pp_string (pp, "   ");
 389           ada_name = to_ada_name ((const char *) NODE_NAME (node), NULL);
 390           pp_string (pp, ada_name);
 391           free (ada_name);
 392           pp_string (pp, " : ");
 393
 394           if (is_string)
 395             pp_string (pp, "aliased constant String");
 396           else if (is_char)
 397             pp_string (pp, "aliased constant Character");
 398           else
 399             pp_string (pp, "constant");
 400
 401           pp_string (pp, " := ");
 402           pp_string (pp, (char *) s);
 403
 404           if (is_string)
 405             pp_string (pp, " & ASCII.NUL");
 406
 407           pp_string (pp, ";  --  ");
 408           pp_string (pp, sloc.file);
 409           pp_character (pp, ':');
 410           pp_scalar (pp, "%d", sloc.line);
 411           pp_newline (pp);
 412         }
 413       else
 414         {
 415           pp_string (pp, "   --  unsupported macro: ");
 416           pp_string (pp, (const char *) cpp_macro_definition (parse_in, node));
 417           pp_newline (pp);
 418         }
 419     }
 420
 421   if (num_macros > 0)
 422     pp_newline (pp);
 423 }
 424
 425 static const char *source_file;
 426 static int max_ada_macros;
 427
 428 /* Callback used to count the number of relevant macros from
 429    cpp_forall_identifiers. PFILE and V are not used. NODE is the current macro
 430    to consider.  */
 431
 432 static int
 433 count_ada_macro (cpp_reader *pfile ATTRIBUTE_UNUSED, cpp_hashnode *node,
 434                  void *v ATTRIBUTE_UNUSED)
 435 {
 436   const cpp_macro *macro = node->value.macro;
 437
 438   if (node->type == NT_MACRO && !(node->flags & NODE_BUILTIN)
 439       && macro->count
 440       && *NODE_NAME (node) != '_'
 441       && LOCATION_FILE (macro->line) == source_file)
 442     max_ada_macros++;
 443
 444   return 1;
 445 }
 446
 447 static int store_ada_macro_index;
 448
 449 /* Callback used to store relevant macros from cpp_forall_identifiers.
 450    PFILE is not used. NODE is the current macro to store if relevant.
 451    MACROS is an array of cpp_hashnode* used to store NODE.  */
 452
 453 static int
 454 store_ada_macro (cpp_reader *pfile ATTRIBUTE_UNUSED,
 455                  cpp_hashnode *node, void *macros)
 456 {
 457   const cpp_macro *macro = node->value.macro;
 458
 459   if (node->type == NT_MACRO && !(node->flags & NODE_BUILTIN)
 460       && macro->count
 461       && *NODE_NAME (node) != '_'
 462       && LOCATION_FILE (macro->line) == source_file)
 463     ((cpp_hashnode **) macros)[store_ada_macro_index++] = node;
 464
 465   return 1;
 466 }
 467
 468 /* Callback used to compare (during qsort) macros.  NODE1 and NODE2 are the
 469    two macro nodes to compare.  */
 470
 471 static int
 472 compare_macro (const void *node1, const void *node2)
 473 {
 474   typedef const cpp_hashnode *const_hnode;
 475
 476   const_hnode n1 = *(const const_hnode *) node1;
 477   const_hnode n2 = *(const const_hnode *) node2;
 478
 479   return n1->value.macro->line - n2->value.macro->line;
 480 }
 481
 482 /* Dump in PP all relevant macros appearing in FILE.  */
 483
 484 static void
 485 dump_ada_macros (pretty_printer *pp, const char* file)
 486 {
 487   cpp_hashnode **macros;
 488
 489   /* Initialize file-scope variables.  */
 490   max_ada_macros = 0;
 491   store_ada_macro_index = 0;
 492   source_file = file;
 493
 494   /* Count all potentially relevant macros, and then sort them by sloc.  */
 495   cpp_forall_identifiers (parse_in, count_ada_macro, NULL);
 496   macros = XALLOCAVEC (cpp_hashnode *, max_ada_macros);
 497   cpp_forall_identifiers (parse_in, store_ada_macro, macros);
 498   qsort (macros, max_ada_macros, sizeof (cpp_hashnode *), compare_macro);
 499
 500   print_ada_macros (pp, macros, max_ada_macros);
 501 }
 502
 503 /* Current source file being handled.  */
 504
 505 static const char *source_file_base;
 506
 507 /* Compare the declaration (DECL) of struct-like types based on the sloc of
 508    their last field (if LAST is true), so that more nested types collate before
 509    less nested ones.
 510    If ORIG_TYPE is true, also consider struct with a DECL_ORIGINAL_TYPE.  */
 511
 512 static location_t
 513 decl_sloc_common (const_tree decl, bool last, bool orig_type)
 514 {
 515   tree type = TREE_TYPE (decl);
 516
 517   if (TREE_CODE (decl) == TYPE_DECL
 518       && (orig_type || !DECL_ORIGINAL_TYPE (decl))
 519       && RECORD_OR_UNION_TYPE_P (type)
 520       && TYPE_FIELDS (type))
 521     {
 522       tree f = TYPE_FIELDS (type);
 523
 524       if (last)
 525         while (TREE_CHAIN (f))
 526           f = TREE_CHAIN (f);
 527
 528       return DECL_SOURCE_LOCATION (f);
 529     }
 530   else
 531     return DECL_SOURCE_LOCATION (decl);
 532 }
 533
 534 /* Return sloc of DECL, using sloc of last field if LAST is true.  */
 535
 536 location_t
 537 decl_sloc (const_tree decl, bool last)
 538 {
 539   return decl_sloc_common (decl, last, false);
 540 }
 541
 542 /* Compare two declarations (LP and RP) by their source location.  */
 543
 544 static int
 545 compare_node (const void *lp, const void *rp)
 546 {
 547   const_tree lhs = *((const tree *) lp);
 548   const_tree rhs = *((const tree *) rp);
 549
 550   return decl_sloc (lhs, true) - decl_sloc (rhs, true);
 551 }
 552
 553 /* Compare two comments (LP and RP) by their source location.  */
 554
 555 static int
 556 compare_comment (const void *lp, const void *rp)
 557 {
 558   const cpp_comment *lhs = (const cpp_comment *) lp;
 559   const cpp_comment *rhs = (const cpp_comment *) rp;
 560
 561   if (LOCATION_FILE (lhs->sloc) != LOCATION_FILE (rhs->sloc))
 562     return strcmp (LOCATION_FILE (lhs->sloc), LOCATION_FILE (rhs->sloc));
 563
 564   if (LOCATION_LINE (lhs->sloc) != LOCATION_LINE (rhs->sloc))
 565     return LOCATION_LINE (lhs->sloc) - LOCATION_LINE (rhs->sloc);
 566
 567   if (LOCATION_COL (lhs->sloc) != LOCATION_COL (rhs->sloc))
 568     return LOCATION_COL (lhs->sloc) - LOCATION_COL (rhs->sloc);
 569
 570   return 0;
 571 }
 572
 573 static tree *to_dump = NULL;
 574 static int to_dump_count = 0;
 575
 576 /* Collect a list of declarations from T relevant to SOURCE_FILE to be dumped
 577    by a subsequent call to dump_ada_nodes.  */
 578
 579 void
 580 collect_ada_nodes (tree t, const char *source_file)
 581 {
 582   tree n;
 583   int i = to_dump_count;
 584
 585   /* Count the likely relevant nodes.  */
 586   for (n = t; n; n = TREE_CHAIN (n))
 587     if (!DECL_IS_BUILTIN (n)
 588         && LOCATION_FILE (decl_sloc (n, false)) == source_file)
 589       to_dump_count++;
 590
 591   /* Allocate sufficient storage for all nodes.  */
 592   to_dump = XRESIZEVEC (tree, to_dump, to_dump_count);
 593
 594   /* Store the relevant nodes.  */
 595   for (n = t; n; n = TREE_CHAIN (n))
 596     if (!DECL_IS_BUILTIN (n)
 597         && LOCATION_FILE (decl_sloc (n, false)) == source_file)
 598       to_dump [i++] = n;
 599 }
 600
 601 /* Call back for walk_tree to clear the TREE_VISITED flag of TP.  */
 602
 603 static tree
 604 unmark_visited_r (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED,
 605                   void *data ATTRIBUTE_UNUSED)
 606 {
 607   if (TREE_VISITED (*tp))
 608     TREE_VISITED (*tp) = 0;
 609   else
 610     *walk_subtrees = 0;
 611
 612   return NULL_TREE;
 613 }
 614
 615 /* Dump nodes into PP relevant to SOURCE_FILE, as collected by previous calls
 616    to collect_ada_nodes.  CPP_CHECK is used to perform C++ queries on nodes.  */
 617
 618 static void
 619 dump_ada_nodes (pretty_printer *pp, const char *source_file,
 620                 int (*cpp_check)(tree, cpp_operation))
 621 {
 622   int i, j;
 623   cpp_comment_table *comments;
 624
 625   /* Sort the table of declarations to dump by sloc.  */
 626   qsort (to_dump, to_dump_count, sizeof (tree), compare_node);
 627
 628   /* Fetch the table of comments.  */
 629   comments = cpp_get_comments (parse_in);
 630
 631   /* Sort the comments table by sloc.  */
 632   qsort (comments->entries, comments->count, sizeof (cpp_comment),
 633          compare_comment);
 634
 635   /* Interleave comments and declarations in line number order.  */
 636   i = j = 0;
 637   do
 638     {
 639       /* Advance j until comment j is in this file.  */
 640       while (j != comments->count
 641              && LOCATION_FILE (comments->entries[j].sloc) != source_file)
 642         j++;
 643
 644       /* Advance j until comment j is not a duplicate.  */
 645       while (j < comments->count - 1
 646              && !compare_comment (&comments->entries[j],
 647                                   &comments->entries[j + 1]))
 648         j++;
 649
 650       /* Write decls until decl i collates after comment j.  */
 651       while (i != to_dump_count)
 652         {
 653           if (j == comments->count
 654               || LOCATION_LINE (decl_sloc (to_dump[i], false))
 655               <  LOCATION_LINE (comments->entries[j].sloc))
 656             print_generic_ada_decl (pp, to_dump[i++], cpp_check, source_file);
 657           else
 658             break;
 659         }
 660
 661       /* Write comment j, if there is one.  */
 662       if (j != comments->count)
 663         print_comment (pp, comments->entries[j++].comment);
 664
 665     } while (i != to_dump_count || j != comments->count);
 666
 667   /* Clear the TREE_VISITED flag over each subtree we've dumped.  */
 668   for (i = 0; i < to_dump_count; i++)
 669     walk_tree (&to_dump[i], unmark_visited_r, NULL, NULL);
 670
 671   /* Finalize the to_dump table.  */
 672   if (to_dump)
 673     {
 674       free (to_dump);
 675       to_dump = NULL;
 676       to_dump_count = 0;
 677     }
 678 }
 679
 680 /* Print a COMMENT to the output stream PP.  */
 681
 682 static void
 683 print_comment (pretty_printer *pp, const char *comment)
 684 {
 685   int len = strlen (comment);
 686   char *str = XALLOCAVEC (char, len + 1);
 687   char *tok;
 688   bool extra_newline = false;
 689
 690   memcpy (str, comment, len + 1);
 691
 692   /* Trim C/C++ comment indicators.  */
 693   if (str[len - 2] == '*' && str[len - 1] == '/')
 694     {
 695       str[len - 2] = ' ';
 696       str[len - 1] = '\0';
 697     }
 698   str += 2;
 699
 700   tok = strtok (str, "\n");
 701   while (tok) {
 702     pp_string (pp, "  --");
 703     pp_string (pp, tok);
 704     pp_newline (pp);
 705     tok = strtok (NULL, "\n");
 706
 707     /* Leave a blank line after multi-line comments.  */
 708     if (tok)
 709       extra_newline = true;
 710   }
 711
 712   if (extra_newline)
 713     pp_newline (pp);
 714 }
 715
 716 /* Prints declaration DECL to PP in Ada syntax. The current source file being
 717    handled is SOURCE_FILE, and CPP_CHECK is used to perform C++ queries on
 718    nodes.  */
 719
 720 static void
 721 print_generic_ada_decl (pretty_printer *pp, tree decl,
 722                         int (*cpp_check)(tree, cpp_operation),
 723                         const char* source_file)
 724 {
 725   source_file_base = source_file;
 726
 727   if (print_ada_declaration (pp, decl, 0, cpp_check, INDENT_INCR))
 728     {
 729       pp_newline (pp);
 730       pp_newline (pp);
 731     }
 732 }
 733
 734 /* Dump a newline and indent BUFFER by SPC chars.  */
 735
 736 static void
 737 newline_and_indent (pretty_printer *buffer, int spc)
 738 {
 739   pp_newline (buffer);
 740   INDENT (spc);
 741 }
 742
 743 struct with { char *s; const char *in_file; int limited; };
 744 static struct with *withs = NULL;
 745 static int withs_max = 4096;
 746 static int with_len = 0;
 747
 748 /* Record a "with" clause on package S (a limited with if LIMITED_ACCESS is
 749    true), if not already done.  */
 750
 751 static void
 752 append_withs (const char *s, int limited_access)
 753 {
 754   int i;
 755
 756   if (withs == NULL)
 757     withs = XNEWVEC (struct with, withs_max);
 758
 759   if (with_len == withs_max)
 760     {
 761       withs_max *= 2;
 762       withs = XRESIZEVEC (struct with, withs, withs_max);
 763     }
 764
 765   for (i = 0; i < with_len; i++)
 766     if (!strcmp (s, withs [i].s)
 767         && source_file_base == withs [i].in_file)
 768       {
 769         withs [i].limited &= limited_access;
 770         return;
 771       }
 772
 773   withs [with_len].s = xstrdup (s);
 774   withs [with_len].in_file = source_file_base;
 775   withs [with_len].limited = limited_access;
 776   with_len++;
 777 }
 778
 779 /* Reset "with" clauses.  */
 780
 781 static void
 782 reset_ada_withs (void)
 783 {
 784   int i;
 785
 786   if (!withs)
 787     return;
 788
 789   for (i = 0; i < with_len; i++)
 790     free (withs [i].s);
 791   free (withs);
 792   withs = NULL;
 793   withs_max = 4096;
 794   with_len = 0;
 795 }
 796
 797 /* Dump "with" clauses in F.  */
 798
 799 static void
 800 dump_ada_withs (FILE *f)
 801 {
 802   int i;
 803
 804   fprintf (f, "with Interfaces.C; use Interfaces.C;\n");
 805
 806   for (i = 0; i < with_len; i++)
 807     fprintf
 808       (f, "%swith %s;\n", withs [i].limited ? "limited " : "", withs [i].s);
 809 }
 810
 811 /* Return suitable Ada package name from FILE.  */
 812
 813 static char *
 814 get_ada_package (const char *file)
 815 {
 816   const char *base;
 817   char *res;
 818   const char *s;
 819   int i;
 820
 821   s = strstr (file, "/include/");
 822   if (s)
 823     base = s + 9;
 824   else
 825     base = lbasename (file);
 826   res = XNEWVEC (char, strlen (base) + 1);
 827
 828   for (i = 0; *base; base++, i++)
 829     switch (*base)
 830       {
 831         case '+':
 832           res [i] = 'p';
 833           break;
 834
 835         case '.':
 836         case '-':
 837         case '_':
 838         case '/':
 839         case '\\':
 840           res [i] = (i == 0 || res [i - 1] == '_') ? 'u' : '_';
 841           break;
 842
 843         default:
 844           res [i] = *base;
 845           break;
 846       }
 847   res [i] = '\0';
 848
 849   return res;
 850 }
 851
 852 static const char *ada_reserved[] = {
 853   "abort", "abs", "abstract", "accept", "access", "aliased", "all", "and",
 854   "array", "at", "begin", "body", "case", "constant", "declare", "delay",
 855   "delta", "digits", "do", "else", "elsif", "end", "entry", "exception",
 856   "exit", "for", "function", "generic", "goto", "if", "in", "interface", "is",
 857   "limited", "loop", "mod", "new", "not", "null", "others", "out", "of", "or",
 858   "overriding", "package", "pragma", "private", "procedure", "protected",
 859   "raise", "range", "record", "rem", "renames", "requeue", "return", "reverse",
 860   "select", "separate", "subtype", "synchronized", "tagged", "task",
 861   "terminate", "then", "type", "until", "use", "when", "while", "with", "xor",
 862   NULL};
 863
 864 /* ??? would be nice to specify this list via a config file, so that users
 865    can create their own dictionary of conflicts.  */
 866 static const char *c_duplicates[] = {
 867   /* system will cause troubles with System.Address.  */
 868   "system",
 869
 870   /* The following values have other definitions with same name/other
 871      casing.  */
 872   "funmap",
 873   "rl_vi_fWord",
 874   "rl_vi_bWord",
 875   "rl_vi_eWord",
 876   "rl_readline_version",
 877   "_Vx_ushort",
 878   "USHORT",
 879   "XLookupKeysym",
 880   NULL};
 881
 882 /* Return a declaration tree corresponding to TYPE.  */
 883
 884 static tree
 885 get_underlying_decl (tree type)
 886 {
 887   tree decl = NULL_TREE;
 888
 889   if (type == NULL_TREE)
 890     return NULL_TREE;
 891
 892   /* type is a declaration.  */
 893   if (DECL_P (type))
 894     decl = type;
 895
 896   /* type is a typedef.  */
 897   if (TYPE_P (type) && TYPE_NAME (type) && DECL_P (TYPE_NAME (type)))
 898     decl = TYPE_NAME (type);
 899
 900   /* TYPE_STUB_DECL has been set for type.  */
 901   if (TYPE_P (type) && TYPE_STUB_DECL (type) &&
 902       DECL_P (TYPE_STUB_DECL (type)))
 903     decl = TYPE_STUB_DECL (type);
 904
 905   return decl;
 906 }
 907
 908 /* Return whether TYPE has static fields.  */
 909
 910 static int
 911 has_static_fields (const_tree type)
 912 {
 913   tree tmp;
 914
 915   for (tmp = TYPE_FIELDS (type); tmp; tmp = TREE_CHAIN (tmp))
 916     {
 917       if (DECL_NAME (tmp) && TREE_STATIC (tmp))
 918         return true;
 919     }
 920   return false;
 921 }
 922
 923 /* Return whether TYPE corresponds to an Ada tagged type (has a dispatch
 924    table).  */
 925
 926 static int
 927 is_tagged_type (const_tree type)
 928 {
 929   tree tmp;
 930
 931   if (!type || !RECORD_OR_UNION_TYPE_P (type))
 932     return false;
 933
 934   for (tmp = TYPE_METHODS (type); tmp; tmp = TREE_CHAIN (tmp))
 935     if (DECL_VINDEX (tmp))
 936       return true;
 937
 938   return false;
 939 }
 940
 941 /* Generate a legal Ada name from a C NAME, returning a malloc'd string.
 942    SPACE_FOUND, if not NULL, is used to indicate whether a space was found in
 943    NAME.  */
 944
 945 static char *
 946 to_ada_name (const char *name, int *space_found)
 947 {
 948   const char **names;
 949   int len = strlen (name);
 950   int j, len2 = 0;
 951   int found = false;
 952   char *s = XNEWVEC (char, len * 2 + 5);
 953   char c;
 954
 955   if (space_found)
 956     *space_found = false;
 957
 958   /* Add trailing "c_" if name is an Ada reserved word.  */
 959   for (names = ada_reserved; *names; names++)
 960     if (!strcasecmp (name, *names))
 961       {
 962         s [len2++] = 'c';
 963         s [len2++] = '_';
 964         found = true;
 965         break;
 966       }
 967
 968   if (!found)
 969     /* Add trailing "c_" if name is an potential case sensitive duplicate.  */
 970     for (names = c_duplicates; *names; names++)
 971       if (!strcmp (name, *names))
 972         {
 973           s [len2++] = 'c';
 974           s [len2++] = '_';
 975           found = true;
 976           break;
 977         }
 978
 979   for (j = 0; name [j] == '_'; j++)
 980     s [len2++] = 'u';
 981
 982   if (j > 0)
 983     s [len2++] = '_';
 984   else if (*name == '.' || *name == '$')
 985     {
 986       s [0] = 'a';
 987       s [1] = 'n';
 988       s [2] = 'o';
 989       s [3] = 'n';
 990       len2 = 4;
 991       j++;
 992     }
 993
 994   /* Replace unsuitable characters for Ada identifiers.  */
 995
 996   for (; j < len; j++)
 997     switch (name [j])
 998       {
 999         case ' ':
1000           if (space_found)
1001             *space_found = true;
1002           s [len2++] = '_';
1003           break;
1004
1005         /* ??? missing some C++ operators.  */
1006         case '=':
1007           s [len2++] = '_';
1008
1009           if (name [j + 1] == '=')
1010             {
1011               j++;
1012               s [len2++] = 'e';
1013               s [len2++] = 'q';
1014             }
1015           else
1016             {
1017               s [len2++] = 'a';
1018               s [len2++] = 's';
1019             }
1020           break;
1021
1022         case '!':
1023           s [len2++] = '_';
1024           if (name [j + 1] == '=')
1025             {
1026               j++;
1027               s [len2++] = 'n';
1028               s [len2++] = 'e';
1029             }
1030           break;
1031
1032         case '~':
1033           s [len2++] = '_';
1034           s [len2++] = 't';
1035           s [len2++] = 'i';
1036           break;
1037
1038         case '&':
1039         case '|':
1040         case '^':
1041           s [len2++] = '_';
1042           s [len2++] = name [j] == '&' ? 'a' : name [j] == '|' ? 'o' : 'x';
1043
1044           if (name [j + 1] == '=')
1045             {
1046               j++;
1047               s [len2++] = 'e';
1048             }
1049           break;
1050
1051         case '+':
1052         case '-':
1053         case '*':
1054         case '/':
1055         case '(':
1056         case '[':
1057           if (s [len2 - 1] != '_')
1058             s [len2++] = '_';
1059
1060           switch (name [j + 1]) {
1061             case '\0':
1062               j++;
1063               switch (name [j - 1]) {
1064                 case '+': s [len2++] = 'p'; break;  /* + */
1065                 case '-': s [len2++] = 'm'; break;  /* - */
1066                 case '*': s [len2++] = 't'; break;  /* * */
1067                 case '/': s [len2++] = 'd'; break;  /* / */
1068               }
1069               break;
1070
1071             case '=':
1072               j++;
1073               switch (name [j - 1]) {
1074                 case '+': s [len2++] = 'p'; break;  /* += */
1075                 case '-': s [len2++] = 'm'; break;  /* -= */
1076                 case '*': s [len2++] = 't'; break;  /* *= */
1077                 case '/': s [len2++] = 'd'; break;  /* /= */
1078               }
1079               s [len2++] = 'a';
1080               break;
1081
1082             case '-':  /* -- */
1083               j++;
1084               s [len2++] = 'm';
1085               s [len2++] = 'm';
1086               break;
1087
1088             case '+':  /* ++ */
1089               j++;
1090               s [len2++] = 'p';
1091               s [len2++] = 'p';
1092               break;
1093
1094             case ')':  /* () */
1095               j++;
1096               s [len2++] = 'o';
1097               s [len2++] = 'p';
1098               break;
1099
1100             case ']':  /* [] */
1101               j++;
1102               s [len2++] = 'o';
1103               s [len2++] = 'b';
1104               break;
1105           }
1106
1107           break;
1108
1109         case '<':
1110         case '>':
1111           c = name [j] == '<' ? 'l' : 'g';
1112           s [len2++] = '_';
1113
1114           switch (name [j + 1]) {
1115             case '\0':
1116               s [len2++] = c;
1117               s [len2++] = 't';
1118               break;
1119             case '=':
1120               j++;
1121               s [len2++] = c;
1122               s [len2++] = 'e';
1123               break;
1124             case '>':
1125               j++;
1126               s [len2++] = 's';
1127               s [len2++] = 'r';
1128               break;
1129             case '<':
1130               j++;
1131               s [len2++] = 's';
1132               s [len2++] = 'l';
1133               break;
1134             default:
1135               break;
1136           }
1137           break;
1138
1139         case '_':
1140           if (len2 && s [len2 - 1] == '_')
1141             s [len2++] = 'u';
1142           /* fall through */
1143
1144         default:
1145           s [len2++] = name [j];
1146       }
1147
1148   if (s [len2 - 1] == '_')
1149     s [len2++] = 'u';
1150
1151   s [len2] = '\0';
1152
1153   return s;
1154 }
1155
1156 /* Return true if DECL refers to a C++ class type for which a
1157    separate enclosing package has been or should be generated.  */
1158
1159 static bool
1160 separate_class_package (tree decl)
1161 {
1162   if (decl)
1163     {
1164       tree type = TREE_TYPE (decl);
1165       return type
1166         && TREE_CODE (type) == RECORD_TYPE
1167         && (TYPE_METHODS (type) || has_static_fields (type));
1168     }
1169   else
1170     return false;
1171 }
1172
1173 static bool package_prefix = true;
1174
1175 /* Dump in BUFFER the name of an identifier NODE of type TYPE, following Ada
1176    syntax.  LIMITED_ACCESS indicates whether NODE can be accessed via a limited
1177    'with' clause rather than a regular 'with' clause.  */
1178
1179 static void
1180 pp_ada_tree_identifier (pretty_printer *buffer, tree node, tree type,
1181                         int limited_access)
1182 {
1183   const char *name = IDENTIFIER_POINTER (node);
1184   int space_found = false;
1185   char *s = to_ada_name (name, &space_found);
1186   tree decl;
1187
1188   /* If the entity is a type and comes from another file, generate "package"
1189      prefix.  */
1190
1191   decl = get_underlying_decl (type);
1192
1193   if (decl)
1194     {
1195       expanded_location xloc = expand_location (decl_sloc (decl, false));
1196
1197       if (xloc.file && xloc.line)
1198         {
1199           if (xloc.file != source_file_base)
1200             {
1201               switch (TREE_CODE (type))
1202                 {
1203                   case ENUMERAL_TYPE:
1204                   case INTEGER_TYPE:
1205                   case REAL_TYPE:
1206                   case FIXED_POINT_TYPE:
1207                   case BOOLEAN_TYPE:
1208                   case REFERENCE_TYPE:
1209                   case POINTER_TYPE:
1210                   case ARRAY_TYPE:
1211                   case RECORD_TYPE:
1212                   case UNION_TYPE:
1213                   case QUAL_UNION_TYPE:
1214                   case TYPE_DECL:
1215                     {
1216                       char *s1 = get_ada_package (xloc.file);
1217
1218                       if (package_prefix)
1219                         {
1220                           append_withs (s1, limited_access);
1221                           pp_string (buffer, s1);
1222                           pp_character (buffer, '.');
1223                         }
1224                       free (s1);
1225                     }
1226                     break;
1227                   default:
1228                     break;
1229                 }
1230
1231               if (separate_class_package (decl))
1232                 {
1233                   pp_string (buffer, "Class_");
1234                   pp_string (buffer, s);
1235                   pp_string (buffer, ".");
1236                 }
1237
1238             }
1239         }
1240     }
1241
1242   if (space_found)
1243     if (!strcmp (s, "short_int"))
1244       pp_string (buffer, "short");
1245     else if (!strcmp (s, "short_unsigned_int"))
1246       pp_string (buffer, "unsigned_short");
1247     else if (!strcmp (s, "unsigned_int"))
1248       pp_string (buffer, "unsigned");
1249     else if (!strcmp (s, "long_int"))
1250       pp_string (buffer, "long");
1251     else if (!strcmp (s, "long_unsigned_int"))
1252       pp_string (buffer, "unsigned_long");
1253     else if (!strcmp (s, "long_long_int"))
1254       pp_string (buffer, "Long_Long_Integer");
1255     else if (!strcmp (s, "long_long_unsigned_int"))
1256       {
1257         if (package_prefix)
1258           {
1259             append_withs ("Interfaces.C.Extensions", false);
1260             pp_string (buffer, "Extensions.unsigned_long_long");
1261           }
1262         else
1263           pp_string (buffer, "unsigned_long_long");
1264       }
1265     else
1266       pp_string(buffer, s);
1267   else
1268     if (!strcmp (s, "bool"))
1269       {
1270         if (package_prefix)
1271           {
1272             append_withs ("Interfaces.C.Extensions", false);
1273             pp_string (buffer, "Extensions.bool");
1274           }
1275         else
1276           pp_string (buffer, "bool");
1277       }
1278     else
1279       pp_string(buffer, s);
1280
1281   free (s);
1282 }
1283
1284 /* Dump in BUFFER the assembly name of T.  */
1285
1286 static void
1287 pp_asm_name (pretty_printer *buffer, tree t)
1288 {
1289   tree name = DECL_ASSEMBLER_NAME (t);
1290   char *ada_name = XALLOCAVEC (char, IDENTIFIER_LENGTH (name) + 1), *s;
1291   const char *ident = IDENTIFIER_POINTER (name);
1292
1293   for (s = ada_name; *ident; ident++)
1294     {
1295       if (*ident == ' ')
1296         break;
1297       else if (*ident != '*')
1298         *s++ = *ident;
1299     }
1300
1301   *s = '\0';
1302   pp_string (buffer, ada_name);
1303 }
1304
1305 /* Dump in BUFFER the name of a DECL node if set, following Ada syntax.
1306    LIMITED_ACCESS indicates whether NODE can be accessed via a limited
1307    'with' clause rather than a regular 'with' clause.  */
1308
1309 static void
1310 dump_ada_decl_name (pretty_printer *buffer, tree decl, int limited_access)
1311 {
1312   if (DECL_NAME (decl))
1313     pp_ada_tree_identifier (buffer, DECL_NAME (decl), decl, limited_access);
1314   else
1315     {
1316       tree type_name = TYPE_NAME (TREE_TYPE (decl));
1317
1318       if (!type_name)
1319         {
1320           pp_string (buffer, "anon");
1321           if (TREE_CODE (decl) == FIELD_DECL)
1322             pp_scalar (buffer, "%d", DECL_UID (decl));
1323           else
1324             pp_scalar (buffer, "%d", TYPE_UID (TREE_TYPE (decl)));
1325         }
1326       else if (TREE_CODE (type_name) == IDENTIFIER_NODE)
1327         pp_ada_tree_identifier (buffer, type_name, decl, limited_access);
1328     }
1329 }
1330
1331 /* Dump in BUFFER a name based on both T1 and T2, followed by S.  */
1332
1333 static void
1334 dump_ada_double_name (pretty_printer *buffer, tree t1, tree t2, const char *s)
1335 {
1336   if (DECL_NAME (t1))
1337     pp_ada_tree_identifier (buffer, DECL_NAME (t1), t1, false);
1338   else
1339     {
1340       pp_string (buffer, "anon");
1341       pp_scalar (buffer, "%d", TYPE_UID (TREE_TYPE (t1)));
1342     }
1343
1344   pp_character (buffer, '_');
1345
1346   if (DECL_NAME (t1))
1347     pp_ada_tree_identifier (buffer, DECL_NAME (t2), t2, false);
1348   else
1349     {
1350       pp_string (buffer, "anon");
1351       pp_scalar (buffer, "%d", TYPE_UID (TREE_TYPE (t2)));
1352     }
1353
1354   pp_string (buffer, s);
1355 }
1356
1357 /* Dump in BUFFER pragma Import C/CPP on a given node T.  */
1358
1359 static void
1360 dump_ada_import (pretty_printer *buffer, tree t)
1361 {
1362   const char *name = IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (t));
1363   int is_stdcall = TREE_CODE (t) == FUNCTION_DECL &&
1364     lookup_attribute ("stdcall", TYPE_ATTRIBUTES (TREE_TYPE (t)));
1365
1366   if (is_stdcall)
1367     pp_string (buffer, "pragma Import (Stdcall, ");
1368   else if (name [0] == '_' && name [1] == 'Z')
1369     pp_string (buffer, "pragma Import (CPP, ");
1370   else
1371     pp_string (buffer, "pragma Import (C, ");
1372
1373   dump_ada_decl_name (buffer, t, false);
1374   pp_string (buffer, ", \"");
1375
1376   if (is_stdcall)
1377     pp_string (buffer, IDENTIFIER_POINTER (DECL_NAME (t)));
1378   else
1379     pp_asm_name (buffer, t);
1380
1381   pp_string (buffer, "\");");
1382 }
1383
1384 /* Check whether T and its type have different names, and append "the_"
1385    otherwise in BUFFER.  */
1386
1387 static void
1388 check_name (pretty_printer *buffer, tree t)
1389 {
1390   const char *s;
1391   tree tmp = TREE_TYPE (t);
1392
1393   while (TREE_CODE (tmp) == POINTER_TYPE && !TYPE_NAME (tmp))
1394     tmp = TREE_TYPE (tmp);
1395
1396   if (TREE_CODE (tmp) != FUNCTION_TYPE)
1397     {
1398       if (TREE_CODE (tmp) == IDENTIFIER_NODE)
1399         s = IDENTIFIER_POINTER (tmp);
1400       else if (!TYPE_NAME (tmp))
1401         s = "";
1402       else if (TREE_CODE (TYPE_NAME (tmp)) == IDENTIFIER_NODE)
1403         s = IDENTIFIER_POINTER (TYPE_NAME (tmp));
1404       else
1405         s = IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp)));
1406
1407       if (!strcasecmp (IDENTIFIER_POINTER (DECL_NAME (t)), s))
1408         pp_string (buffer, "the_");
1409     }
1410 }
1411
1412 /* Dump in BUFFER a function declaration FUNC with Ada syntax.
1413    IS_METHOD indicates whether FUNC is a C++ method.
1414    IS_CONSTRUCTOR whether FUNC is a C++ constructor.
1415    IS_DESTRUCTOR whether FUNC is a C++ destructor.
1416    SPC is the current indentation level.  */
1417
1418 static int
1419 dump_ada_function_declaration (pretty_printer *buffer, tree func,
1420                                int is_method, int is_constructor,
1421                                int is_destructor, int spc)
1422 {
1423   tree arg;
1424   const tree node = TREE_TYPE (func);
1425   char buf [16];
1426   int num = 0, num_args = 0, have_args = true, have_ellipsis = false;
1427
1428   /* Compute number of arguments.  */
1429   arg = TYPE_ARG_TYPES (node);
1430
1431   if (arg)
1432     {
1433       while (TREE_CHAIN (arg) && arg != error_mark_node)
1434         {
1435           num_args++;
1436           arg = TREE_CHAIN (arg);
1437         }
1438
1439       if (TREE_CODE (TREE_VALUE (arg)) != VOID_TYPE)
1440         {
1441           num_args++;
1442           have_ellipsis = true;
1443         }
1444     }
1445
1446   if (is_constructor)
1447     num_args--;
1448
1449   if (is_destructor)
1450     num_args = 1;
1451
1452   if (num_args > 2)
1453     newline_and_indent (buffer, spc + 1);
1454
1455   if (num_args > 0)
1456     {
1457       pp_space (buffer);
1458       pp_character (buffer, '(');
1459     }
1460
1461   if (TREE_CODE (func) == FUNCTION_DECL)
1462     arg = DECL_ARGUMENTS (func);
1463   else
1464     arg = NULL_TREE;
1465
1466   if (arg == NULL_TREE)
1467     {
1468       have_args = false;
1469       arg = TYPE_ARG_TYPES (node);
1470
1471       if (arg && TREE_CODE (TREE_VALUE (arg)) == VOID_TYPE)
1472         arg = NULL_TREE;
1473     }
1474
1475   if (is_constructor)
1476     arg = TREE_CHAIN (arg);
1477
1478   /* Print the argument names (if available) & types.  */
1479
1480   for (num = 1; num <= num_args; num++)
1481     {
1482       if (have_args)
1483         {
1484           if (DECL_NAME (arg))
1485             {
1486               check_name (buffer, arg);
1487               pp_ada_tree_identifier (buffer, DECL_NAME (arg), 0, false);
1488               pp_string (buffer, " : ");
1489             }
1490           else
1491             {
1492               sprintf (buf, "arg%d : ", num);
1493               pp_string (buffer, buf);
1494             }
1495
1496           dump_generic_ada_node
1497             (buffer, TREE_TYPE (arg), node, NULL, spc, 0, true);
1498         }
1499       else
1500         {
1501           sprintf (buf, "arg%d : ", num);
1502           pp_string (buffer, buf);
1503           dump_generic_ada_node
1504             (buffer, TREE_VALUE (arg), node, NULL, spc, 0, true);
1505         }
1506
1507       if (TREE_TYPE (arg) && TREE_TYPE (TREE_TYPE (arg))
1508           && is_tagged_type (TREE_TYPE (TREE_TYPE (arg))))
1509         {
1510           if (!is_method
1511               || (num != 1 || (!DECL_VINDEX (func) && !is_constructor)))
1512             pp_string (buffer, "'Class");
1513         }
1514
1515       arg = TREE_CHAIN (arg);
1516
1517       if (num < num_args)
1518         {
1519           pp_character (buffer, ';');
1520
1521           if (num_args > 2)
1522             newline_and_indent (buffer, spc + INDENT_INCR);
1523           else
1524             pp_space (buffer);
1525         }
1526     }
1527
1528   if (have_ellipsis)
1529     {
1530       pp_string (buffer, "  -- , ...");
1531       newline_and_indent (buffer, spc + INDENT_INCR);
1532     }
1533
1534   if (num_args > 0)
1535     pp_character (buffer, ')');
1536   return num_args;
1537 }
1538
1539 /* Dump in BUFFER all the domains associated with an array NODE,
1540    using Ada syntax.  SPC is the current indentation level.  */
1541
1542 static void
1543 dump_ada_array_domains (pretty_printer *buffer, tree node, int spc)
1544 {
1545   int first = 1;
1546   pp_character (buffer, '(');
1547
1548   for (; TREE_CODE (node) == ARRAY_TYPE; node = TREE_TYPE (node))
1549     {
1550       tree domain = TYPE_DOMAIN (node);
1551
1552       if (domain)
1553         {
1554           tree min = TYPE_MIN_VALUE (domain);
1555           tree max = TYPE_MAX_VALUE (domain);
1556
1557           if (!first)
1558             pp_string (buffer, ", ");
1559           first = 0;
1560
1561           if (min)
1562             dump_generic_ada_node (buffer, min, NULL_TREE, NULL, spc, 0, true);
1563           pp_string (buffer, " .. ");
1564
1565           /* If the upper bound is zero, gcc may generate a NULL_TREE
1566              for TYPE_MAX_VALUE rather than an integer_cst.  */
1567           if (max)
1568             dump_generic_ada_node (buffer, max, NULL_TREE, NULL, spc, 0, true);
1569           else
1570             pp_string (buffer, "0");
1571         }
1572       else
1573         pp_string (buffer, "size_t");
1574     }
1575   pp_character (buffer, ')');
1576 }
1577
1578 /* Dump in BUFFER file:line information related to NODE.  */
1579
1580 static void
1581 dump_sloc (pretty_printer *buffer, tree node)
1582 {
1583   expanded_location xloc;
1584
1585   xloc.file = NULL;
1586
1587   if (TREE_CODE_CLASS (TREE_CODE (node)) == tcc_declaration)
1588     xloc = expand_location (DECL_SOURCE_LOCATION (node));
1589   else if (EXPR_HAS_LOCATION (node))
1590     xloc = expand_location (EXPR_LOCATION (node));
1591
1592   if (xloc.file)
1593     {
1594       pp_string (buffer, xloc.file);
1595       pp_string (buffer, ":");
1596       pp_decimal_int (buffer, xloc.line);
1597     }
1598 }
1599
1600 /* Return true if T designates a one dimension array of "char".  */
1601
1602 static bool
1603 is_char_array (tree t)
1604 {
1605   tree tmp;
1606   int num_dim = 0;
1607
1608   /* Retrieve array's type.  */
1609   tmp = t;
1610   while (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE)
1611     {
1612       num_dim++;
1613       tmp = TREE_TYPE (tmp);
1614     }
1615
1616   tmp = TREE_TYPE (tmp);
1617   return num_dim == 1 && TREE_CODE (tmp) == INTEGER_TYPE
1618     && !strcmp (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp))), "char");
1619 }
1620
1621 /* Dump in BUFFER an array type T in Ada syntax.  Assume that the "type"
1622    keyword and name have already been printed.  SPC is the indentation
1623    level.  */
1624
1625 static void
1626 dump_ada_array_type (pretty_printer *buffer, tree t, int spc)
1627 {
1628   tree tmp;
1629   bool char_array = is_char_array (t);
1630
1631   /* Special case char arrays.  */
1632   if (char_array)
1633     {
1634       pp_string (buffer, "Interfaces.C.char_array ");
1635     }
1636   else
1637     pp_string (buffer, "array ");
1638
1639   /* Print the dimensions.  */
1640   dump_ada_array_domains (buffer, TREE_TYPE (t), spc);
1641
1642   /* Retrieve array's type.  */
1643   tmp = TREE_TYPE (t);
1644   while (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE)
1645     tmp = TREE_TYPE (tmp);
1646
1647   /* Print array's type.  */
1648   if (!char_array)
1649     {
1650       pp_string (buffer, " of ");
1651
1652       if (TREE_CODE (TREE_TYPE (tmp)) != POINTER_TYPE)
1653         pp_string (buffer, "aliased ");
1654
1655       dump_generic_ada_node
1656         (buffer, TREE_TYPE (tmp), TREE_TYPE (t), NULL, spc, false, true);
1657     }
1658 }
1659
1660 /* Dump in BUFFER type names associated with a template, each prepended with
1661    '_'.  TYPES is the TREE_PURPOSE of a DECL_TEMPLATE_INSTANTIATIONS.
1662    CPP_CHECK is used to perform C++ queries on nodes.
1663    SPC is the indentation level.  */
1664
1665 static void
1666 dump_template_types (pretty_printer *buffer, tree types,
1667                      int (*cpp_check)(tree, cpp_operation), int spc)
1668 {
1669   size_t i;
1670   size_t len = TREE_VEC_LENGTH (types);
1671
1672   for (i = 0; i < len; i++)
1673     {
1674       tree elem = TREE_VEC_ELT (types, i);
1675       pp_character (buffer, '_');
1676       if (!dump_generic_ada_node (buffer, elem, 0, cpp_check, spc, false, true))
1677         {
1678           pp_string (buffer, "unknown");
1679           pp_scalar (buffer, "%lu", (unsigned long) TREE_HASH (elem));
1680         }
1681     }
1682 }
1683
1684 /* Dump in BUFFER the contents of all instantiations associated with a given
1685    template T.  CPP_CHECK is used to perform C++ queries on nodes.
1686    SPC is the indentation level. */
1687
1688 static int
1689 dump_ada_template (pretty_printer *buffer, tree t,
1690                    int (*cpp_check)(tree, cpp_operation), int spc)
1691 {
1692   tree inst = DECL_VINDEX (t);
1693   /* DECL_VINDEX is DECL_TEMPLATE_INSTANTIATIONS in this context.  */
1694   int num_inst = 0;
1695
1696   while (inst && inst != error_mark_node)
1697     {
1698       tree types = TREE_PURPOSE (inst);
1699       tree instance = TREE_VALUE (inst);
1700
1701       if (TREE_VEC_LENGTH (types) == 0)
1702         break;
1703
1704       if (!TYPE_METHODS (instance))
1705         break;
1706
1707       num_inst++;
1708       INDENT (spc);
1709       pp_string (buffer, "package ");
1710       package_prefix = false;
1711       dump_generic_ada_node (buffer, instance, t, cpp_check, spc, false, true);
1712       dump_template_types (buffer, types, cpp_check, spc);
1713       pp_string (buffer, " is");
1714       spc += INDENT_INCR;
1715       newline_and_indent (buffer, spc);
1716
1717       TREE_VISITED (get_underlying_decl (instance)) = 1;
1718       pp_string (buffer, "type ");
1719       dump_generic_ada_node (buffer, instance, t, cpp_check, spc, false, true);
1720       package_prefix = true;
1721
1722       if (is_tagged_type (instance))
1723         pp_string (buffer, " is tagged limited ");
1724       else
1725         pp_string (buffer, " is limited ");
1726
1727       dump_generic_ada_node (buffer, instance, t, cpp_check, spc, false, false);
1728       pp_newline (buffer);
1729       spc -= INDENT_INCR;
1730       newline_and_indent (buffer, spc);
1731
1732       pp_string (buffer, "end;");
1733       newline_and_indent (buffer, spc);
1734       pp_string (buffer, "use ");
1735       package_prefix = false;
1736       dump_generic_ada_node (buffer, instance, t, cpp_check, spc, false, true);
1737       dump_template_types (buffer, types, cpp_check, spc);
1738       package_prefix = true;
1739       pp_semicolon (buffer);
1740       pp_newline (buffer);
1741       pp_newline (buffer);
1742
1743       inst = TREE_CHAIN (inst);
1744     }
1745
1746   return num_inst > 0;
1747 }
1748
1749 /* Return true if NODE is a simple enum types, that can be mapped to an
1750    Ada enum type directly.  */
1751
1752 static bool
1753 is_simple_enum (tree node)
1754 {
1755   unsigned HOST_WIDE_INT count = 0;
1756   tree value;
1757
1758   for (value = TYPE_VALUES (node); value; value = TREE_CHAIN (value))
1759     {
1760       tree int_val = TREE_VALUE (value);
1761
1762       if (TREE_CODE (int_val) != INTEGER_CST)
1763         int_val = DECL_INITIAL (int_val);
1764
1765       if (!host_integerp (int_val, 0))
1766         return false;
1767       else if (TREE_INT_CST_LOW (int_val) != count)
1768         return false;
1769
1770       count++;
1771     }
1772
1773   return true;
1774 }
1775
1776 static bool in_function = true;
1777 static bool bitfield_used = false;
1778
1779 /* Recursively dump in BUFFER Ada declarations corresponding to NODE of type
1780    TYPE.  CPP_CHECK is used to perform C++ queries on nodes.  SPC is the
1781    indentation level.  LIMITED_ACCESS indicates whether NODE can be referenced
1782    via a "limited with" clause.  NAME_ONLY indicates whether we should only
1783    dump the name of NODE, instead of its full declaration.  */
1784
1785 static int
1786 dump_generic_ada_node (pretty_printer *buffer, tree node, tree type,
1787                        int (*cpp_check)(tree, cpp_operation), int spc,
1788                        int limited_access, bool name_only)
1789 {
1790   if (node == NULL_TREE)
1791     return 0;
1792
1793   switch (TREE_CODE (node))
1794     {
1795     case ERROR_MARK:
1796       pp_string (buffer, "<<< error >>>");
1797       return 0;
1798
1799     case IDENTIFIER_NODE:
1800       pp_ada_tree_identifier (buffer, node, type, limited_access);
1801       break;
1802
1803     case TREE_LIST:
1804       pp_string (buffer, "--- unexpected node: TREE_LIST");
1805       return 0;
1806
1807     case TREE_BINFO:
1808       dump_generic_ada_node
1809         (buffer, BINFO_TYPE (node), type, cpp_check,
1810          spc, limited_access, name_only);
1811
1812     case TREE_VEC:
1813       pp_string (buffer, "--- unexpected node: TREE_VEC");
1814       return 0;
1815
1816     case VOID_TYPE:
1817       if (package_prefix)
1818         {
1819           append_withs ("System", false);
1820           pp_string (buffer, "System.Address");
1821         }
1822       else
1823         pp_string (buffer, "address");
1824       break;
1825
1826     case VECTOR_TYPE:
1827       pp_string (buffer, "<vector>");
1828       break;
1829
1830     case COMPLEX_TYPE:
1831       pp_string (buffer, "<complex>");
1832       break;
1833
1834     case ENUMERAL_TYPE:
1835       if (name_only)
1836         dump_generic_ada_node
1837           (buffer, TYPE_NAME (node), node, cpp_check, spc, 0, true);
1838       else
1839         {
1840           tree value = TYPE_VALUES (node);
1841
1842           if (is_simple_enum (node))
1843             {
1844               bool first = true;
1845               spc += INDENT_INCR;
1846               newline_and_indent (buffer, spc - 1);
1847               pp_string (buffer, "(");
1848               for (; value; value = TREE_CHAIN (value))
1849                 {
1850                   if (first)
1851                     first = false;
1852                   else
1853                     {
1854                       pp_string (buffer, ",");
1855                       newline_and_indent (buffer, spc);
1856                     }
1857
1858                   pp_ada_tree_identifier
1859                     (buffer, TREE_PURPOSE (value), node, false);
1860                 }
1861               pp_string (buffer, ");");
1862               spc -= INDENT_INCR;
1863               newline_and_indent (buffer, spc);
1864               pp_string (buffer, "pragma Convention (C, ");
1865               dump_generic_ada_node
1866                 (buffer, DECL_NAME (type) ? type : TYPE_NAME (node), type,
1867                  cpp_check, spc, 0, true);
1868               pp_string (buffer, ")");
1869             }
1870           else
1871             {
1872               pp_string (buffer, "unsigned");
1873               for (; value; value = TREE_CHAIN (value))
1874                 {
1875                   pp_semicolon (buffer);
1876                   newline_and_indent (buffer, spc);
1877
1878                   pp_ada_tree_identifier
1879                     (buffer, TREE_PURPOSE (value), node, false);
1880                   pp_string (buffer, " : constant ");
1881
1882                   dump_generic_ada_node
1883                     (buffer, DECL_NAME (type) ? type : TYPE_NAME (node), type,
1884                      cpp_check, spc, 0, true);
1885
1886                   pp_string (buffer, " := ");
1887                   dump_generic_ada_node
1888                     (buffer,
1889                      TREE_CODE (TREE_VALUE (value)) == INTEGER_CST ?
1890                        TREE_VALUE (value) : DECL_INITIAL (TREE_VALUE (value)),
1891                      node, cpp_check, spc, false, true);
1892                 }
1893             }
1894         }
1895       break;
1896
1897     case INTEGER_TYPE:
1898     case REAL_TYPE:
1899     case FIXED_POINT_TYPE:
1900     case BOOLEAN_TYPE:
1901       {
1902         enum tree_code_class tclass;
1903
1904         tclass = TREE_CODE_CLASS (TREE_CODE (node));
1905
1906         if (tclass == tcc_declaration)
1907           {
1908             if (DECL_NAME (node))
1909               pp_ada_tree_identifier
1910                 (buffer, DECL_NAME (node), 0, limited_access);
1911             else
1912               pp_string (buffer, "<unnamed type decl>");
1913           }
1914         else if (tclass == tcc_type)
1915           {
1916             if (TYPE_NAME (node))
1917               {
1918                 if (TREE_CODE (TYPE_NAME (node)) == IDENTIFIER_NODE)
1919                   pp_ada_tree_identifier (buffer, TYPE_NAME (node),
1920                                           node, limited_access);
1921                 else if (TREE_CODE (TYPE_NAME (node)) == TYPE_DECL
1922                          && DECL_NAME (TYPE_NAME (node)))
1923                   dump_ada_decl_name (buffer, TYPE_NAME (node), limited_access);
1924                 else
1925                   pp_string (buffer, "<unnamed type>");
1926               }
1927             else if (TREE_CODE (node) == INTEGER_TYPE)
1928               {
1929                 append_withs ("Interfaces.C.Extensions", false);
1930                 bitfield_used = true;
1931
1932                 if (TYPE_PRECISION (node) == 1)
1933                   pp_string (buffer, "Extensions.Unsigned_1");
1934                 else
1935                   {
1936                     pp_string (buffer, (TYPE_UNSIGNED (node)
1937                                         ? "Extensions.Unsigned_"
1938                                         : "Extensions.Signed_"));
1939                     pp_decimal_int (buffer, TYPE_PRECISION (node));
1940                   }
1941               }
1942             else
1943               pp_string (buffer, "<unnamed type>");
1944           }
1945         break;
1946       }
1947
1948     case POINTER_TYPE:
1949     case REFERENCE_TYPE:
1950       if (TREE_CODE (TREE_TYPE (node)) == FUNCTION_TYPE)
1951         {
1952           tree fnode = TREE_TYPE (node);
1953           bool is_function;
1954           bool prev_in_function = in_function;
1955
1956           if (VOID_TYPE_P (TREE_TYPE (fnode)))
1957             {
1958               is_function = false;
1959               pp_string (buffer, "access procedure");
1960             }
1961           else
1962             {
1963               is_function = true;
1964               pp_string (buffer, "access function");
1965             }
1966
1967           in_function = is_function;
1968           dump_ada_function_declaration
1969             (buffer, node, false, false, false, spc + INDENT_INCR);
1970           in_function = prev_in_function;
1971
1972           if (is_function)
1973             {
1974               pp_string (buffer, " return ");
1975               dump_generic_ada_node
1976                 (buffer, TREE_TYPE (fnode), type, cpp_check, spc, 0, true);
1977             }
1978         }
1979       else
1980         {
1981           int is_access = false;
1982           unsigned int quals = TYPE_QUALS (TREE_TYPE (node));
1983
1984           if (name_only && TYPE_NAME (node))
1985             dump_generic_ada_node
1986               (buffer, TYPE_NAME (node), node, cpp_check,
1987                spc, limited_access, true);
1988           else if (VOID_TYPE_P (TREE_TYPE (node)))
1989             {
1990               if (!name_only)
1991                 pp_string (buffer, "new ");
1992               if (package_prefix)
1993                 {
1994                   append_withs ("System", false);
1995                   pp_string (buffer, "System.Address");
1996                 }
1997               else
1998                 pp_string (buffer, "address");
1999             }
2000           else
2001             {
2002               if (TREE_CODE (node) == POINTER_TYPE
2003                   && TREE_CODE (TREE_TYPE (node)) == INTEGER_TYPE
2004                   && !strcmp
2005                         (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME
2006                           (TREE_TYPE (node)))), "char"))
2007                 {
2008                   if (!name_only)
2009                     pp_string (buffer, "new ");
2010
2011                   if (package_prefix)
2012                     {
2013                       pp_string (buffer, "Interfaces.C.Strings.chars_ptr");
2014                       append_withs ("Interfaces.C.Strings", false);
2015                     }
2016                   else
2017                     pp_string (buffer, "chars_ptr");
2018                 }
2019               else
2020                 {
2021                   /* For now, handle all access-to-access or
2022                      access-to-unknown-structs as opaque system.address.  */
2023
2024                   tree type_name = TYPE_NAME (TREE_TYPE (node));
2025                   const_tree typ2 = !type ||
2026                     DECL_P (type) ? type : TYPE_NAME (type);
2027                   const_tree underlying_type =
2028                     get_underlying_decl (TREE_TYPE (node));
2029
2030                   if (TREE_CODE (TREE_TYPE (node)) == POINTER_TYPE
2031                       /* Pointer to pointer.  */
2032
2033                       || (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node))
2034                           && (!underlying_type
2035                               || !TYPE_FIELDS (TREE_TYPE (underlying_type))))
2036                       /* Pointer to opaque structure.  */
2037
2038                       || underlying_type == NULL_TREE
2039                       || (!typ2
2040                           && !TREE_VISITED (underlying_type)
2041                           && !TREE_VISITED (type_name)
2042                           && !is_tagged_type (TREE_TYPE (node))
2043                           && DECL_SOURCE_FILE (underlying_type)
2044                                == source_file_base)
2045                       || (type_name && typ2
2046                           && DECL_P (underlying_type)
2047                           && DECL_P (typ2)
2048                           && decl_sloc (underlying_type, true)
2049                                > decl_sloc (typ2, true)
2050                           && DECL_SOURCE_FILE (underlying_type)
2051                                == DECL_SOURCE_FILE (typ2)))
2052                     {
2053                       if (package_prefix)
2054                         {
2055                           append_withs ("System", false);
2056                           if (!name_only)
2057                             pp_string (buffer, "new ");
2058                           pp_string (buffer, "System.Address");
2059                         }
2060                       else
2061                         pp_string (buffer, "address");
2062                       return spc;
2063                     }
2064
2065                   if (!package_prefix)
2066                     pp_string (buffer, "access");
2067                   else if (AGGREGATE_TYPE_P (TREE_TYPE (node)))
2068                     {
2069                       if (!type || TREE_CODE (type) != FUNCTION_DECL)
2070                         {
2071                           pp_string (buffer, "access ");
2072                           is_access = true;
2073
2074                           if (quals & TYPE_QUAL_CONST)
2075                             pp_string (buffer, "constant ");
2076                           else if (!name_only)
2077                             pp_string (buffer, "all ");
2078                         }
2079                       else if (quals & TYPE_QUAL_CONST)
2080                         pp_string (buffer, "in ");
2081                       else if (in_function)
2082                         {
2083                           is_access = true;
2084                           pp_string (buffer, "access ");
2085                         }
2086                       else
2087                         {
2088                           is_access = true;
2089                           pp_string (buffer, "access ");
2090                           /* ??? should be configurable: access or in out.  */
2091                         }
2092                     }
2093                   else
2094                     {
2095                       is_access = true;
2096                       pp_string (buffer, "access ");
2097
2098                       if (!name_only)
2099                         pp_string (buffer, "all ");
2100                     }
2101
2102                   if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node))
2103                       && type_name != NULL_TREE)
2104                     dump_generic_ada_node
2105                       (buffer, type_name,
2106                        TREE_TYPE (node), cpp_check, spc, is_access, true);
2107                   else
2108                     dump_generic_ada_node
2109                       (buffer, TREE_TYPE (node), TREE_TYPE (node),
2110                        cpp_check, spc, 0, true);
2111                 }
2112             }
2113         }
2114       break;
2115
2116     case ARRAY_TYPE:
2117       if (name_only)
2118         dump_generic_ada_node
2119           (buffer, TYPE_NAME (node), node, cpp_check,
2120            spc, limited_access, true);
2121       else
2122         dump_ada_array_type (buffer, node, spc);
2123       break;
2124
2125     case RECORD_TYPE:
2126     case UNION_TYPE:
2127     case QUAL_UNION_TYPE:
2128       if (name_only)
2129         {
2130           if (TYPE_NAME (node))
2131             dump_generic_ada_node
2132               (buffer, TYPE_NAME (node), node, cpp_check,
2133                spc, limited_access, true);
2134           else
2135             {
2136               pp_string (buffer, "anon_");
2137               pp_scalar (buffer, "%d", TYPE_UID (node));
2138             }
2139         }
2140       else
2141         print_ada_struct_decl
2142           (buffer, node, type, cpp_check, spc, true);
2143       break;
2144
2145     case INTEGER_CST:
2146       if (TREE_CODE (TREE_TYPE (node)) == POINTER_TYPE)
2147         {
2148           pp_wide_integer (buffer, TREE_INT_CST_LOW (node));
2149           pp_string (buffer, "B"); /* pseudo-unit */
2150         }
2151       else if (!host_integerp (node, 0))
2152         {
2153           tree val = node;
2154           unsigned HOST_WIDE_INT low = TREE_INT_CST_LOW (val);
2155           HOST_WIDE_INT high = TREE_INT_CST_HIGH (val);
2156
2157           if (tree_int_cst_sgn (val) < 0)
2158             {
2159               pp_character (buffer, '-');
2160               high = ~high + !low;
2161               low = -low;
2162             }
2163           sprintf (pp_buffer (buffer)->digit_buffer,
2164           HOST_WIDE_INT_PRINT_DOUBLE_HEX,
2165             (unsigned HOST_WIDE_INT) high, low);
2166           pp_string (buffer, pp_buffer (buffer)->digit_buffer);
2167         }
2168       else
2169         pp_wide_integer (buffer, TREE_INT_CST_LOW (node));
2170       break;
2171
2172     case REAL_CST:
2173     case FIXED_CST:
2174     case COMPLEX_CST:
2175     case STRING_CST:
2176     case VECTOR_CST:
2177       return 0;
2178
2179     case FUNCTION_DECL:
2180     case CONST_DECL:
2181       dump_ada_decl_name (buffer, node, limited_access);
2182       break;
2183
2184     case TYPE_DECL:
2185       if (DECL_IS_BUILTIN (node))
2186         {
2187           /* Don't print the declaration of built-in types.  */
2188
2189           if (name_only)
2190             {
2191               /* If we're in the middle of a declaration, defaults to
2192                  System.Address.  */
2193               if (package_prefix)
2194                 {
2195                   append_withs ("System", false);
2196                   pp_string (buffer, "System.Address");
2197                 }
2198               else
2199                 pp_string (buffer, "address");
2200             }
2201           break;
2202         }
2203
2204       if (name_only)
2205         dump_ada_decl_name (buffer, node, limited_access);
2206       else
2207         {
2208           if (is_tagged_type (TREE_TYPE (node)))
2209             {
2210               tree tmp = TYPE_FIELDS (TREE_TYPE (node));
2211               int first = 1;
2212
2213               /* Look for ancestors.  */
2214               for (; tmp; tmp = TREE_CHAIN (tmp))
2215                 {
2216                   if (!DECL_NAME (tmp) && is_tagged_type (TREE_TYPE (tmp)))
2217                     {
2218                       if (first)
2219                         {
2220                           pp_string (buffer, "limited new ");
2221                           first = 0;
2222                         }
2223                       else
2224                         pp_string (buffer, " and ");
2225
2226                       dump_ada_decl_name
2227                         (buffer, TYPE_NAME (TREE_TYPE (tmp)), false);
2228                     }
2229                 }
2230
2231               pp_string (buffer, first ? "tagged limited " : " with ");
2232             }
2233           else if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node))
2234                    && TYPE_METHODS (TREE_TYPE (node)))
2235             pp_string (buffer, "limited ");
2236
2237           dump_generic_ada_node
2238             (buffer, TREE_TYPE (node), type, cpp_check, spc, false, false);
2239         }
2240       break;
2241
2242     case VAR_DECL:
2243     case PARM_DECL:
2244     case FIELD_DECL:
2245     case NAMESPACE_DECL:
2246       dump_ada_decl_name (buffer, node, false);
2247       break;
2248
2249     default:
2250       /* Ignore other nodes (e.g. expressions).  */
2251       return 0;
2252     }
2253
2254   return 1;
2255 }
2256
2257 /* Dump in BUFFER NODE's methods.  CPP_CHECK is used to perform C++ queries on
2258    nodes.  SPC is the indentation level.  */
2259
2260 static void
2261 print_ada_methods (pretty_printer *buffer, tree node,
2262                    int (*cpp_check)(tree, cpp_operation), int spc)
2263 {
2264   tree tmp = TYPE_METHODS (node);
2265   int res = 1;
2266
2267   if (tmp)
2268     {
2269       pp_semicolon (buffer);
2270
2271       for (; tmp; tmp = TREE_CHAIN (tmp))
2272         {
2273           if (res)
2274             {
2275               pp_newline (buffer);
2276               pp_newline (buffer);
2277             }
2278           res = print_ada_declaration (buffer, tmp, node, cpp_check, spc);
2279         }
2280     }
2281 }
2282
2283 /* Dump in BUFFER anonymous types nested inside T's definition.
2284    PARENT is the parent node of T.
2285    FORWARD indicates whether a forward declaration of T should be generated.
2286    CPP_CHECK is used to perform C++ queries on
2287    nodes.  SPC is the indentation level.  */
2288
2289 static void
2290 dump_nested_types (pretty_printer *buffer, tree t, tree parent, bool forward,
2291                    int (*cpp_check)(tree, cpp_operation), int spc)
2292 {
2293   tree field, outer, decl;
2294
2295   /* Avoid recursing over the same tree.  */
2296   if (TREE_VISITED (t))
2297     return;
2298
2299   /* Find possible anonymous arrays/unions/structs recursively.  */
2300
2301   outer = TREE_TYPE (t);
2302
2303   if (outer == NULL_TREE)
2304     return;
2305
2306   if (forward)
2307     {
2308       pp_string (buffer, "type ");
2309       dump_generic_ada_node
2310         (buffer, t, t, cpp_check, spc, false, true);
2311       pp_semicolon (buffer);
2312       newline_and_indent (buffer, spc);
2313       TREE_VISITED (t) = 1;
2314     }
2315
2316   field = TYPE_FIELDS (outer);
2317   while (field)
2318     {
2319       if ((TREE_TYPE (field) != outer
2320            || (TREE_CODE (TREE_TYPE (field)) == POINTER_TYPE
2321                && TREE_TYPE (TREE_TYPE (field)) != outer))
2322            && (!TYPE_NAME (TREE_TYPE (field))
2323               || (TREE_CODE (field) == TYPE_DECL
2324                   && DECL_NAME (field) != DECL_NAME (t)
2325                   && TYPE_NAME (TREE_TYPE (field)) != TYPE_NAME (outer))))
2326         {
2327           switch (TREE_CODE (TREE_TYPE (field)))
2328             {
2329               case POINTER_TYPE:
2330                 decl = TREE_TYPE (TREE_TYPE (field));
2331
2332                 if (TREE_CODE (decl) == FUNCTION_TYPE)
2333                   for (decl = TREE_TYPE (decl);
2334                        decl && TREE_CODE (decl) == POINTER_TYPE;
2335                        decl = TREE_TYPE (decl));
2336
2337                 decl = get_underlying_decl (decl);
2338
2339                 if (decl
2340                     && DECL_P (decl)
2341                     && decl_sloc (decl, true) > decl_sloc (t, true)
2342                     && DECL_SOURCE_FILE (decl) == DECL_SOURCE_FILE (t)
2343                     && !TREE_VISITED (decl)
2344                     && !DECL_IS_BUILTIN (decl)
2345                     && (!RECORD_OR_UNION_TYPE_P (TREE_TYPE (decl))
2346                         || TYPE_FIELDS (TREE_TYPE (decl))))
2347                   {
2348                     /* Generate forward declaration.  */
2349
2350                     pp_string (buffer, "type ");
2351                     dump_generic_ada_node
2352                       (buffer, decl, 0, cpp_check, spc, false, true);
2353                     pp_semicolon (buffer);
2354                     newline_and_indent (buffer, spc);
2355
2356                     /* Ensure we do not generate duplicate forward
2357                        declarations for this type.  */
2358                     TREE_VISITED (decl) = 1;
2359                   }
2360                 break;
2361
2362               case ARRAY_TYPE:
2363                 /* Special case char arrays.  */
2364                 if (is_char_array (field))
2365                   pp_string (buffer, "sub");
2366
2367                 pp_string (buffer, "type ");
2368                 dump_ada_double_name (buffer, parent, field, "_array is ");
2369                 dump_ada_array_type (buffer, field, spc);
2370                 pp_semicolon (buffer);
2371                 newline_and_indent (buffer, spc);
2372                 break;
2373
2374               case UNION_TYPE:
2375                 TREE_VISITED (t) = 1;
2376                 dump_nested_types (buffer, field, t, false, cpp_check, spc);
2377
2378                 pp_string (buffer, "type ");
2379
2380                 if (TYPE_NAME (TREE_TYPE (field)))
2381                   {
2382                     dump_generic_ada_node
2383                       (buffer, TYPE_NAME (TREE_TYPE (field)), 0, cpp_check,
2384                        spc, false, true);
2385                     pp_string (buffer, " (discr : unsigned := 0) is ");
2386                     print_ada_struct_decl
2387                       (buffer, TREE_TYPE (field), t, cpp_check, spc, false);
2388
2389                     pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
2390                     dump_generic_ada_node
2391                       (buffer, TREE_TYPE (field), 0, cpp_check,
2392                        spc, false, true);
2393                     pp_string (buffer, ");");
2394                     newline_and_indent (buffer, spc);
2395
2396                     pp_string (buffer, "pragma Unchecked_Union (");
2397                     dump_generic_ada_node
2398                       (buffer, TREE_TYPE (field), 0, cpp_check,
2399                        spc, false, true);
2400                     pp_string (buffer, ");");
2401                   }
2402                 else
2403                   {
2404                     dump_ada_double_name
2405                       (buffer, parent, field,
2406                         "_union (discr : unsigned := 0) is ");
2407                     print_ada_struct_decl
2408                       (buffer, TREE_TYPE (field), t, cpp_check, spc, false);
2409                     pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
2410                     dump_ada_double_name (buffer, parent, field, "_union);");
2411                     newline_and_indent (buffer, spc);
2412
2413                     pp_string (buffer, "pragma Unchecked_Union (");
2414                     dump_ada_double_name (buffer, parent, field, "_union);");
2415                   }
2416
2417                 newline_and_indent (buffer, spc);
2418                 break;
2419
2420               case RECORD_TYPE:
2421                 if (TYPE_NAME (TREE_TYPE (t)) && !TREE_VISITED (t))
2422                   {
2423                     pp_string (buffer, "type ");
2424                     dump_generic_ada_node
2425                       (buffer, t, parent, 0, spc, false, true);
2426                     pp_semicolon (buffer);
2427                     newline_and_indent (buffer, spc);
2428                   }
2429
2430                 TREE_VISITED (t) = 1;
2431                 dump_nested_types (buffer, field, t, false, cpp_check, spc);
2432                 pp_string (buffer, "type ");
2433
2434                 if (TYPE_NAME (TREE_TYPE (field)))
2435                   {
2436                     dump_generic_ada_node
2437                       (buffer, TREE_TYPE (field), 0, cpp_check,
2438                        spc, false, true);
2439                     pp_string (buffer, " is ");
2440                     print_ada_struct_decl
2441                       (buffer, TREE_TYPE (field), t, cpp_check, spc, false);
2442                     pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
2443                     dump_generic_ada_node
2444                       (buffer, TREE_TYPE (field), 0, cpp_check,
2445                        spc, false, true);
2446                     pp_string (buffer, ");");
2447                   }
2448                 else
2449                   {
2450                     dump_ada_double_name
2451                       (buffer, parent, field, "_struct is ");
2452                     print_ada_struct_decl
2453                       (buffer, TREE_TYPE (field), t, cpp_check, spc, false);
2454                     pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
2455                     dump_ada_double_name (buffer, parent, field, "_struct);");
2456                   }
2457
2458                 newline_and_indent (buffer, spc);
2459                 break;
2460
2461               default:
2462                 break;
2463             }
2464         }
2465       field = TREE_CHAIN (field);
2466     }
2467
2468   TREE_VISITED (t) = 1;
2469 }
2470
2471 /* Dump in BUFFER destructor spec corresponding to T.  */
2472
2473 static void
2474 print_destructor (pretty_printer *buffer, tree t)
2475 {
2476   const char *s = IDENTIFIER_POINTER (DECL_NAME (t));
2477
2478   if (*s == '_')
2479     for (s += 2; *s != ' '; s++)
2480       pp_character (buffer, *s);
2481   else
2482     {
2483       pp_string (buffer, "Delete_");
2484       pp_ada_tree_identifier (buffer, DECL_NAME (t), t, false);
2485     }
2486 }
2487
2488 /* Return the name of type T.  */
2489
2490 static const char *
2491 type_name (tree t)
2492 {
2493   tree n = TYPE_NAME (t);
2494
2495   if (TREE_CODE (n) == IDENTIFIER_NODE)
2496     return IDENTIFIER_POINTER (n);
2497   else
2498     return IDENTIFIER_POINTER (DECL_NAME (n));
2499 }
2500
2501 /* Print in BUFFER the declaration of a variable T of type TYPE in Ada syntax.
2502    CPP_CHECK is used to perform C++ queries on nodes.  SPC is the indentation
2503    level.  Return 1 if a declaration was printed, 0 otherwise.  */
2504
2505 static int
2506 print_ada_declaration (pretty_printer *buffer, tree t, tree type,
2507                        int (*cpp_check)(tree, cpp_operation), int spc)
2508 {
2509   int is_var = 0, need_indent = 0;
2510   int is_class = false;
2511   tree name = TYPE_NAME (TREE_TYPE (t));
2512   tree decl_name = DECL_NAME (t);
2513   bool dump_internal = get_dump_file_info (TDI_ada)->flags & TDF_RAW;
2514   tree orig = NULL_TREE;
2515
2516   if (cpp_check && cpp_check (t, IS_TEMPLATE))
2517     return dump_ada_template (buffer, t, cpp_check, spc);
2518
2519   if (TREE_CODE (t) == CONST_DECL && TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE)
2520     /* Skip enumeral values: will be handled as part of the type itself.  */
2521     return 0;
2522
2523   if (TREE_CODE (t) == TYPE_DECL)
2524     {
2525       orig = DECL_ORIGINAL_TYPE (t);
2526
2527       if (orig && TYPE_STUB_DECL (orig))
2528         {
2529           tree stub = TYPE_STUB_DECL (orig);
2530           tree typ = TREE_TYPE (stub);
2531
2532           if (TYPE_NAME (typ))
2533             {
2534               /* If types have same representation, and same name (ignoring
2535                  casing), then ignore the second type.  */
2536               if (type_name (typ) == type_name (TREE_TYPE (t))
2537                   || !strcasecmp (type_name (typ), type_name (TREE_TYPE (t))))
2538                 return 0;
2539
2540               INDENT (spc);
2541
2542               if (RECORD_OR_UNION_TYPE_P (typ) && !TYPE_FIELDS (typ))
2543                 {
2544                   pp_string (buffer, "--  skipped empty struct ");
2545                   dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
2546                 }
2547               else
2548                 {
2549                   if (!TREE_VISITED (stub)
2550                       && DECL_SOURCE_FILE (stub) == source_file_base)
2551                     dump_nested_types
2552                       (buffer, stub, stub, true, cpp_check, spc);
2553
2554                   pp_string (buffer, "subtype ");
2555                   dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
2556                   pp_string (buffer, " is ");
2557                   dump_generic_ada_node
2558                     (buffer, typ, type, 0, spc, false, true);
2559                   pp_semicolon (buffer);
2560                 }
2561               return 1;
2562             }
2563         }
2564
2565       /* Skip unnamed or anonymous structs/unions/enum types.  */
2566       if (!orig && !decl_name && !name)
2567         {
2568           tree tmp;
2569           location_t sloc;
2570
2571           if (cpp_check || TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE)
2572             return 0;
2573
2574           if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t)))
2575             {
2576               /* Search next items until finding a named type decl.  */
2577               sloc = decl_sloc_common (t, true, true);
2578
2579               for (tmp = TREE_CHAIN (t); tmp; tmp = TREE_CHAIN (tmp))
2580                 {
2581                   if (TREE_CODE (tmp) == TYPE_DECL
2582                       && (DECL_NAME (tmp) || TYPE_NAME (TREE_TYPE (tmp))))
2583                     {
2584                       /* If same sloc, it means we can ignore the anonymous
2585                          struct.  */
2586                       if (decl_sloc_common (tmp, true, true) == sloc)
2587                         return 0;
2588                       else
2589                         break;
2590                     }
2591                 }
2592               if (tmp == NULL)
2593                 return 0;
2594             }
2595         }
2596
2597       if (!orig
2598           && TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE
2599           && decl_name
2600           && (*IDENTIFIER_POINTER (decl_name) == '.'
2601               || *IDENTIFIER_POINTER (decl_name) == '$'))
2602         /* Skip anonymous enum types (duplicates of real types).  */
2603         return 0;
2604
2605       INDENT (spc);
2606
2607       switch (TREE_CODE (TREE_TYPE (t)))
2608         {
2609           case RECORD_TYPE:
2610           case UNION_TYPE:
2611           case QUAL_UNION_TYPE:
2612             /* Skip empty structs (typically forward references to real
2613                structs).  */
2614             if (!TYPE_FIELDS (TREE_TYPE (t)))
2615               {
2616                 pp_string (buffer, "--  skipped empty struct ");
2617                 dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
2618                 return 1;
2619               }
2620
2621             if (decl_name
2622                 && (*IDENTIFIER_POINTER (decl_name) == '.'
2623                     || *IDENTIFIER_POINTER (decl_name) == '$'))
2624               {
2625                 pp_string (buffer, "--  skipped anonymous struct ");
2626                 dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
2627                 TREE_VISITED (t) = 1;
2628                 return 1;
2629               }
2630
2631             if (orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
2632               pp_string (buffer, "subtype ");
2633             else
2634               {
2635                 dump_nested_types (buffer, t, t, false, cpp_check, spc);
2636
2637                 if (separate_class_package (t))
2638                   {
2639                     is_class = true;
2640                     pp_string (buffer, "package Class_");
2641                     dump_generic_ada_node
2642                       (buffer, t, type, 0, spc, false, true);
2643                     pp_string (buffer, " is");
2644                     spc += INDENT_INCR;
2645                     newline_and_indent (buffer, spc);
2646                   }
2647
2648                 pp_string (buffer, "type ");
2649               }
2650             break;
2651
2652           case ARRAY_TYPE:
2653           case POINTER_TYPE:
2654           case REFERENCE_TYPE:
2655             if ((orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
2656                 || is_char_array (t))
2657               pp_string (buffer, "subtype ");
2658             else
2659               pp_string (buffer, "type ");
2660             break;
2661
2662           case FUNCTION_TYPE:
2663             pp_string (buffer, "--  skipped function type ");
2664             dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
2665             return 1;
2666             break;
2667
2668           case ENUMERAL_TYPE:
2669             if ((orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
2670                 || !is_simple_enum (TREE_TYPE (t)))
2671               pp_string (buffer, "subtype ");
2672             else
2673               pp_string (buffer, "type ");
2674             break;
2675
2676           default:
2677             pp_string (buffer, "subtype ");
2678         }
2679       TREE_VISITED (t) = 1;
2680     }
2681   else
2682     {
2683       if (!dump_internal
2684           && TREE_CODE (t) == VAR_DECL
2685           && decl_name
2686           && *IDENTIFIER_POINTER (decl_name) == '_')
2687         return 0;
2688
2689       need_indent = 1;
2690     }
2691
2692   /* Print the type and name.  */
2693   if (TREE_CODE (TREE_TYPE (t)) == ARRAY_TYPE)
2694     {
2695       if (need_indent)
2696         INDENT (spc);
2697
2698       /* Print variable's name.  */
2699       dump_generic_ada_node (buffer, t, type, cpp_check, spc, false, true);
2700
2701       if (TREE_CODE (t) == TYPE_DECL)
2702         {
2703           pp_string (buffer, " is ");
2704
2705           if (orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
2706             dump_generic_ada_node
2707               (buffer, TYPE_NAME (orig), type,
2708                cpp_check, spc, false, true);
2709           else
2710             dump_ada_array_type (buffer, t, spc);
2711         }
2712       else
2713         {
2714           tree tmp = TYPE_NAME (TREE_TYPE (t));
2715
2716           if (spc == INDENT_INCR || TREE_STATIC (t))
2717             is_var = 1;
2718
2719           pp_string (buffer, " : ");
2720
2721           if (tmp)
2722             {
2723               if (TREE_CODE (TREE_TYPE (tmp)) != POINTER_TYPE
2724                   && TREE_CODE (tmp) != INTEGER_TYPE)
2725                 pp_string (buffer, "aliased ");
2726
2727               dump_generic_ada_node (buffer, tmp, type, 0, spc, false, true);
2728             }
2729           else
2730             {
2731               pp_string (buffer, "aliased ");
2732
2733               if (!type)
2734                 dump_ada_array_type (buffer, t, spc);
2735               else
2736                 dump_ada_double_name (buffer, type, t, "_array");
2737             }
2738         }
2739     }
2740   else if (TREE_CODE (t) == FUNCTION_DECL)
2741     {
2742       bool is_function = true, is_method, is_abstract_class = false;
2743       tree decl_name = DECL_NAME (t);
2744       int prev_in_function = in_function;
2745       bool is_abstract = false;
2746       bool is_constructor = false;
2747       bool is_destructor = false;
2748       bool is_copy_constructor = false;
2749
2750       if (!decl_name)
2751         return 0;
2752
2753       if (cpp_check)
2754         {
2755           is_abstract = cpp_check (t, IS_ABSTRACT);
2756           is_constructor = cpp_check (t, IS_CONSTRUCTOR);
2757           is_destructor = cpp_check (t, IS_DESTRUCTOR);
2758           is_copy_constructor = cpp_check (t, IS_COPY_CONSTRUCTOR);
2759         }
2760
2761       /* Skip __comp_dtor destructor which is redundant with the '~class()'
2762          destructor.  */
2763       if (is_destructor
2764           && !strncmp (IDENTIFIER_POINTER (decl_name), "__comp", 6))
2765         return 0;
2766
2767       /* Skip copy constructors: some are internal only, and those that are
2768          not cannot be called easily from Ada anyway.  */
2769       if (is_copy_constructor)
2770         return 0;
2771
2772       /* If this function has an entry in the dispatch table, we cannot
2773          omit it.  */
2774       if (!dump_internal && !DECL_VINDEX (t)
2775           && *IDENTIFIER_POINTER (decl_name) == '_')
2776         {
2777           if (IDENTIFIER_POINTER (decl_name)[1] == '_')
2778             return 0;
2779
2780           INDENT (spc);
2781           pp_string (buffer, "--  skipped func ");
2782           pp_string (buffer, IDENTIFIER_POINTER (decl_name));
2783           return 1;
2784         }
2785
2786       if (need_indent)
2787         INDENT (spc);
2788
2789       if (is_constructor)
2790         pp_string (buffer, "function New_");
2791       else if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t))))
2792         {
2793           is_function = false;
2794           pp_string (buffer, "procedure ");
2795         }
2796       else
2797         pp_string (buffer, "function ");
2798
2799       in_function = is_function;
2800       is_method = TREE_CODE (TREE_TYPE (t)) == METHOD_TYPE;
2801
2802       if (is_destructor)
2803         print_destructor (buffer, t);
2804       else
2805         dump_ada_decl_name (buffer, t, false);
2806
2807       dump_ada_function_declaration
2808         (buffer, t, is_method, is_constructor, is_destructor, spc);
2809       in_function = prev_in_function;
2810
2811       if (is_function)
2812         {
2813           pp_string (buffer, " return ");
2814
2815           if (is_constructor)
2816             {
2817               dump_ada_decl_name (buffer, t, false);
2818             }
2819           else
2820             {
2821               dump_generic_ada_node
2822                 (buffer, TREE_TYPE (TREE_TYPE (t)), type, cpp_check,
2823                  spc, false, true);
2824             }
2825         }
2826
2827       if (is_constructor && cpp_check && type
2828           && AGGREGATE_TYPE_P (type)
2829           && TYPE_METHODS (type))
2830         {
2831           tree tmp = TYPE_METHODS (type);
2832
2833           for (; tmp; tmp = TREE_CHAIN (tmp))
2834             if (cpp_check (tmp, IS_ABSTRACT))
2835               {
2836                 is_abstract_class = 1;
2837                 break;
2838               }
2839         }
2840
2841       if (is_abstract || is_abstract_class)
2842         pp_string (buffer, " is abstract");
2843
2844       pp_semicolon (buffer);
2845       pp_string (buffer, "  -- ");
2846       dump_sloc (buffer, t);
2847
2848       if (is_abstract)
2849         return 1;
2850
2851       newline_and_indent (buffer, spc);
2852
2853       if (is_constructor)
2854         {
2855           pp_string (buffer, "pragma CPP_Constructor (New_");
2856           dump_ada_decl_name (buffer, t, false);
2857           pp_string (buffer, ", \"");
2858           pp_asm_name (buffer, t);
2859           pp_string (buffer, "\");");
2860         }
2861       else if (is_destructor)
2862         {
2863           pp_string (buffer, "pragma Import (CPP, ");
2864           print_destructor (buffer, t);
2865           pp_string (buffer, ", \"");
2866           pp_asm_name (buffer, t);
2867           pp_string (buffer, "\");");
2868         }
2869       else
2870         {
2871           dump_ada_import (buffer, t);
2872         }
2873
2874       return 1;
2875     }
2876   else if (TREE_CODE (t) == TYPE_DECL && !DECL_ORIGINAL_TYPE (t))
2877     {
2878       int is_interface = 0;
2879       int is_abstract_record = 0;
2880
2881       if (need_indent)
2882         INDENT (spc);
2883
2884       /* Anonymous structs/unions */
2885       dump_generic_ada_node
2886         (buffer, TREE_TYPE (t), t, cpp_check, spc, false, true);
2887
2888       if (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE
2889           || TREE_CODE (TREE_TYPE (t)) == QUAL_UNION_TYPE)
2890         {
2891           pp_string (buffer, " (discr : unsigned := 0)");
2892         }
2893
2894       pp_string (buffer, " is ");
2895
2896       /* Check whether we have an Ada interface compatible class.  */
2897       if (cpp_check && AGGREGATE_TYPE_P (TREE_TYPE (t))
2898           && TYPE_METHODS (TREE_TYPE (t)))
2899         {
2900           int num_fields = 0;
2901           tree tmp = TYPE_FIELDS (TREE_TYPE (t));
2902
2903           /* Check that there are no fields other than the virtual table.  */
2904           for (; tmp; tmp = TREE_CHAIN (tmp))
2905             {
2906               if (TREE_CODE (tmp) == TYPE_DECL)
2907                 continue;
2908               num_fields++;
2909             }
2910
2911           if (num_fields == 1)
2912             is_interface = 1;
2913
2914           /* Also check that there are only virtual methods.  */
2915           for (tmp = TYPE_METHODS (TREE_TYPE (t)); tmp; tmp = TREE_CHAIN (tmp))
2916             {
2917               if (cpp_check (tmp, IS_ABSTRACT))
2918                 is_abstract_record = 1;
2919               else
2920                 is_interface = 0;
2921             }
2922         }
2923
2924       TREE_VISITED (t) = 1;
2925       if (is_interface)
2926         {
2927           pp_string (buffer, "limited interface;  -- ");
2928           dump_sloc (buffer, t);
2929           newline_and_indent (buffer, spc);
2930           pp_string (buffer, "pragma Import (CPP, ");
2931           dump_generic_ada_node
2932             (buffer, TYPE_NAME (TREE_TYPE (t)), type, cpp_check,
2933              spc, false, true);
2934           pp_character (buffer, ')');
2935
2936           print_ada_methods (buffer, TREE_TYPE (t), cpp_check, spc);
2937         }
2938       else
2939         {
2940           if (is_abstract_record)
2941             pp_string (buffer, "abstract ");
2942           dump_generic_ada_node (buffer, t, t, cpp_check, spc, false, false);
2943         }
2944     }
2945   else
2946     {
2947       if (need_indent)
2948         INDENT (spc);
2949
2950       if (TREE_CODE (t) == FIELD_DECL && DECL_NAME (t))
2951         check_name (buffer, t);
2952
2953       /* Print variable/type's name.  */
2954       dump_generic_ada_node (buffer, t, t, cpp_check, spc, false, true);
2955
2956       if (TREE_CODE (t) == TYPE_DECL)
2957         {
2958           tree orig = DECL_ORIGINAL_TYPE (t);
2959           int is_subtype = orig && TYPE_NAME (orig) && orig != TREE_TYPE (t);
2960
2961           if (!is_subtype
2962               && (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE
2963                   || TREE_CODE (TREE_TYPE (t)) == QUAL_UNION_TYPE))
2964             pp_string (buffer, " (discr : unsigned := 0)");
2965
2966           pp_string (buffer, " is ");
2967
2968           dump_generic_ada_node
2969             (buffer, orig, t, cpp_check, spc, false, is_subtype);
2970         }
2971       else
2972         {
2973           if (spc == INDENT_INCR || TREE_STATIC (t))
2974             is_var = 1;
2975
2976           pp_string (buffer, " : ");
2977
2978           /* Print type declaration.  */
2979
2980           if (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE
2981               && !TYPE_NAME (TREE_TYPE (t)))
2982             {
2983               dump_ada_double_name (buffer, type, t, "_union");
2984             }
2985           else if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t)))
2986             {
2987               if (TREE_CODE (TREE_TYPE (t)) == RECORD_TYPE)
2988                 pp_string (buffer, "aliased ");
2989
2990               dump_generic_ada_node
2991                 (buffer, TREE_TYPE (t), t, cpp_check, spc, false, true);
2992             }
2993           else
2994             {
2995               if (TREE_CODE (TREE_TYPE (t)) != POINTER_TYPE
2996                   && (TYPE_NAME (TREE_TYPE (t))
2997                       || TREE_CODE (TREE_TYPE (t)) != INTEGER_TYPE))
2998                 pp_string (buffer, "aliased ");
2999
3000               dump_generic_ada_node
3001                 (buffer, TREE_TYPE (t), TREE_TYPE (t), cpp_check,
3002                  spc, false, true);
3003             }
3004         }
3005     }
3006
3007   if (is_class)
3008     {
3009       spc -= 3;
3010       newline_and_indent (buffer, spc);
3011       pp_string (buffer, "end;");
3012       newline_and_indent (buffer, spc);
3013       pp_string (buffer, "use Class_");
3014       dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
3015       pp_semicolon (buffer);
3016       pp_newline (buffer);
3017
3018       /* All needed indentation/newline performed already, so return 0.  */
3019       return 0;
3020     }
3021   else
3022     {
3023       pp_string (buffer, ";  -- ");
3024       dump_sloc (buffer, t);
3025     }
3026
3027   if (is_var)
3028     {
3029       newline_and_indent (buffer, spc);
3030       dump_ada_import (buffer, t);
3031     }
3032
3033   return 1;
3034 }
3035
3036 /* Prints in BUFFER a structure NODE of type TYPE: name, fields, and methods
3037    with Ada syntax.  CPP_CHECK is used to perform C++ queries on nodes.  SPC
3038    is the indentation level.  If DISPLAY_CONVENTION is true, also print the
3039    pragma Convention for NODE.  */
3040
3041 static void
3042 print_ada_struct_decl (pretty_printer *buffer, tree node, tree type,
3043                        int (*cpp_check)(tree, cpp_operation), int spc,
3044                        bool display_convention)
3045 {
3046   tree tmp;
3047   int is_union =
3048     TREE_CODE (node) == UNION_TYPE || TREE_CODE (node) == QUAL_UNION_TYPE;
3049   char buf [16];
3050   int field_num = 0;
3051   int field_spc = spc + INDENT_INCR;
3052   int need_semicolon;
3053
3054   bitfield_used = false;
3055
3056   if (!TYPE_FIELDS (node))
3057     pp_string (buffer, "null record;");
3058   else
3059     {
3060       pp_string (buffer, "record");
3061
3062       /* Print the contents of the structure.  */
3063
3064       if (is_union)
3065         {
3066           newline_and_indent (buffer, spc + INDENT_INCR);
3067           pp_string (buffer, "case discr is");
3068           field_spc = spc + INDENT_INCR * 3;
3069         }
3070
3071       pp_newline (buffer);
3072
3073       /* Print the non-static fields of the structure.  */
3074       for (tmp = TYPE_FIELDS (node); tmp; tmp = TREE_CHAIN (tmp))
3075         {
3076           /* Add parent field if needed.  */
3077           if (!DECL_NAME (tmp))
3078             {
3079               if (!is_tagged_type (TREE_TYPE (tmp)))
3080                 {
3081                   if (!TYPE_NAME (TREE_TYPE (tmp)))
3082                     print_ada_declaration
3083                       (buffer, tmp, type, cpp_check, field_spc);
3084                   else
3085                     {
3086                       INDENT (field_spc);
3087
3088                       if (field_num == 0)
3089                         pp_string (buffer, "parent : ");
3090                       else
3091                         {
3092                           sprintf (buf, "field_%d : ", field_num + 1);
3093                           pp_string (buffer, buf);
3094                         }
3095                       dump_ada_decl_name
3096                         (buffer, TYPE_NAME (TREE_TYPE (tmp)), false);
3097                       pp_semicolon (buffer);
3098                     }
3099                   pp_newline (buffer);
3100                   field_num++;
3101                 }
3102             }
3103           /* Avoid printing the structure recursively.  */
3104           else if ((TREE_TYPE (tmp) != node
3105                    || (TREE_CODE (TREE_TYPE (tmp)) == POINTER_TYPE
3106                        && TREE_TYPE (TREE_TYPE (tmp)) != node))
3107                    && TREE_CODE (tmp) != TYPE_DECL
3108                    && !TREE_STATIC (tmp))
3109             {
3110               /* Skip internal virtual table field.  */
3111               if (strncmp (IDENTIFIER_POINTER (DECL_NAME (tmp)), "_vptr", 5))
3112                 {
3113                   if (is_union)
3114                     {
3115                       if (TREE_CHAIN (tmp)
3116                           && TREE_TYPE (TREE_CHAIN (tmp)) != node
3117                           && TREE_CODE (TREE_CHAIN (tmp)) != TYPE_DECL)
3118                         sprintf (buf, "when %d =>", field_num);
3119                       else
3120                         sprintf (buf, "when others =>");
3121
3122                       INDENT (spc + INDENT_INCR * 2);
3123                       pp_string (buffer, buf);
3124                       pp_newline (buffer);
3125                     }
3126
3127                   if (print_ada_declaration (buffer,
3128                                              tmp, type, cpp_check, field_spc))
3129                     {
3130                       pp_newline (buffer);
3131                       field_num++;
3132                     }
3133                 }
3134             }
3135         }
3136
3137       if (is_union)
3138         {
3139           INDENT (spc + INDENT_INCR);
3140           pp_string (buffer, "end case;");
3141           pp_newline (buffer);
3142         }
3143
3144       if (field_num == 0)
3145         {
3146           INDENT (spc + INDENT_INCR);
3147           pp_string (buffer, "null;");
3148           pp_newline (buffer);
3149         }
3150
3151       INDENT (spc);
3152       pp_string (buffer, "end record;");
3153     }
3154
3155   newline_and_indent (buffer, spc);
3156
3157   if (!display_convention)
3158     return;
3159
3160   if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (type)))
3161     {
3162       if (TYPE_METHODS (TREE_TYPE (type)))
3163         pp_string (buffer, "pragma Import (CPP, ");
3164       else
3165         pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
3166     }
3167   else
3168     pp_string (buffer, "pragma Convention (C, ");
3169
3170   package_prefix = false;
3171   dump_generic_ada_node
3172     (buffer, TREE_TYPE (type), type, cpp_check, spc, false, true);
3173   package_prefix = true;
3174   pp_character (buffer, ')');
3175
3176   if (is_union)
3177     {
3178       pp_semicolon (buffer);
3179       newline_and_indent (buffer, spc);
3180       pp_string (buffer, "pragma Unchecked_Union (");
3181
3182       dump_generic_ada_node
3183         (buffer, TREE_TYPE (type), type, cpp_check, spc, false, true);
3184       pp_character (buffer, ')');
3185     }
3186
3187   if (bitfield_used)
3188     {
3189       pp_semicolon (buffer);
3190       newline_and_indent (buffer, spc);
3191       pp_string (buffer, "pragma Pack (");
3192       dump_generic_ada_node
3193         (buffer, TREE_TYPE (type), type, cpp_check, spc, false, true);
3194       pp_character (buffer, ')');
3195       bitfield_used = false;
3196     }
3197
3198   print_ada_methods (buffer, node, cpp_check, spc);
3199
3200   /* Print the static fields of the structure, if any.  */
3201   need_semicolon = TYPE_METHODS (node) == NULL_TREE;
3202   for (tmp = TYPE_FIELDS (node); tmp; tmp = TREE_CHAIN (tmp))
3203     {
3204       if (DECL_NAME (tmp) && TREE_STATIC (tmp))
3205         {
3206           if (need_semicolon)
3207             {
3208               need_semicolon = false;
3209               pp_semicolon (buffer);
3210             }
3211           pp_newline (buffer);
3212           pp_newline (buffer);
3213           print_ada_declaration (buffer, tmp, type, cpp_check, spc);
3214         }
3215     }
3216 }
3217
3218 /* Dump all the declarations in SOURCE_FILE to an Ada spec.
3219    COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3220    nodes for SOURCE_FILE.  CPP_CHECK is used to perform C++ queries on
3221    nodes.  */
3222
3223 static void
3224 dump_ads (const char *source_file,
3225           void (*collect_all_refs)(const char *),
3226           int (*cpp_check)(tree, cpp_operation))
3227 {
3228   char *ads_name;
3229   char *pkg_name;
3230   char *s;
3231   FILE *f;
3232
3233   pkg_name = get_ada_package (source_file);
3234
3235   /* Construct the the .ads filename and package name.  */
3236   ads_name = xstrdup (pkg_name);
3237
3238   for (s = ads_name; *s; s++)
3239     *s = TOLOWER (*s);
3240
3241   ads_name = reconcat (ads_name, ads_name, ".ads", NULL);
3242
3243   /* Write out the .ads file.  */
3244   f = fopen (ads_name, "w");
3245   if (f)
3246     {
3247       pretty_printer pp;
3248
3249       pp_construct (&pp, NULL, 0);
3250       pp_needs_newline (&pp) = true;
3251       pp.buffer->stream = f;
3252
3253       /* Dump all relevant macros.  */
3254       dump_ada_macros (&pp, source_file);
3255
3256       /* Reset the table of withs for this file.  */
3257       reset_ada_withs ();
3258
3259       (*collect_all_refs) (source_file);
3260
3261       /* Dump all references.  */
3262       dump_ada_nodes (&pp, source_file, cpp_check);
3263
3264       /* Dump withs.  */
3265       dump_ada_withs (f);
3266
3267       fprintf (f, "\npackage %s is\n\n", pkg_name);
3268       pp_write_text_to_stream (&pp);
3269       /* ??? need to free pp */
3270       fprintf (f, "end %s;\n", pkg_name);
3271       fclose (f);
3272     }
3273
3274   free (ads_name);
3275   free (pkg_name);
3276 }
3277
3278 static const char **source_refs = NULL;
3279 static int source_refs_used = 0;
3280 static int source_refs_allocd = 0;
3281
3282 /* Add an entry for FILENAME to the table SOURCE_REFS.  */
3283
3284 void
3285 collect_source_ref (const char *filename)
3286 {
3287   int i;
3288
3289   if (!filename)
3290     return;
3291
3292   if (source_refs_allocd == 0)
3293     {
3294       source_refs_allocd = 1024;
3295       source_refs = XNEWVEC (const char *, source_refs_allocd);
3296     }
3297
3298   for (i = 0; i < source_refs_used; i++)
3299     if (filename == source_refs [i])
3300       return;
3301
3302   if (source_refs_used == source_refs_allocd)
3303     {
3304       source_refs_allocd *= 2;
3305       source_refs = XRESIZEVEC (const char *, source_refs, source_refs_allocd);
3306     }
3307
3308   source_refs [source_refs_used++] = filename;
3309 }
3310
3311 /* Main entry point: dump all Ada specs corresponding to SOURCE_REFS
3312    using callbacks COLLECT_ALL_REFS and CPP_CHECK.
3313    COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3314    nodes for a given source file.
3315    CPP_CHECK is used to perform C++ queries on nodes, or NULL for the C
3316    front-end.  */
3317
3318 void
3319 dump_ada_specs (void (*collect_all_refs)(const char *),
3320                 int (*cpp_check)(tree, cpp_operation))
3321 {
3322   int i;
3323
3324   /* Iterate over the list of files to dump specs for */
3325   for (i = 0; i < source_refs_used; i++)
3326     dump_ads (source_refs [i], collect_all_refs, cpp_check);
3327
3328   /* Free files table.  */
3329   free (source_refs);
3330 }