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