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