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