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