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