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