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