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