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