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