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