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