Mercurial > hg > CbC > CbC_gcc

comparison gcc/c-family/c-ada-spec.c @ 111:04ced10e8804

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