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