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