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