?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Remove outermost loop parameter.
[official-gcc/graphite-test-results.git] / gcc / c-ada-spec.c
blob697b9633afd4966e244473a4758f22083b1e1eee
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:col 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 pp_string (buffer, ":");
1572 pp_decimal_int (buffer, xloc.column);
1573 }
1574 }
1575
1576 /* Return true if T designates a one dimension array of "char". */
1577
1578 static bool
1579 is_char_array (tree t)
1580 {
1581 tree tmp;
1582 int num_dim = 0;
1583
1584 /* Retrieve array's type. */
1585 tmp = t;
1586 while (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE)
1587 {
1588 num_dim++;
1589 tmp = TREE_TYPE (tmp);
1590 }
1591
1592 tmp = TREE_TYPE (tmp);
1593 return num_dim == 1 && TREE_CODE (tmp) == INTEGER_TYPE
1594 && !strcmp (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp))), "char");
1595 }
1596
1597 /* Dump in BUFFER an array type T in Ada syntax. Assume that the "type"
1598 keyword and name have already been printed. SPC is the indentation
1599 level. */
1600
1601 static void
1602 dump_ada_array_type (pretty_printer *buffer, tree t, int spc)
1603 {
1604 tree tmp;
1605 bool char_array = is_char_array (t);
1606
1607 /* Special case char arrays. */
1608 if (char_array)
1609 {
1610 pp_string (buffer, "Interfaces.C.char_array ");
1611 }
1612 else
1613 pp_string (buffer, "array ");
1614
1615 /* Print the dimensions. */
1616 dump_ada_array_domains (buffer, TREE_TYPE (t), spc);
1617
1618 /* Retrieve array's type. */
1619 tmp = TREE_TYPE (t);
1620 while (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE)
1621 tmp = TREE_TYPE (tmp);
1622
1623 /* Print array's type. */
1624 if (!char_array)
1625 {
1626 pp_string (buffer, " of ");
1627
1628 if (TREE_CODE (TREE_TYPE (tmp)) != POINTER_TYPE)
1629 pp_string (buffer, "aliased ");
1630
1631 dump_generic_ada_node
1632 (buffer, TREE_TYPE (tmp), TREE_TYPE (t), NULL, spc, false, true);
1633 }
1634 }
1635
1636 /* Dump in BUFFER type names associated with a template, each prepended with
1637 '_'. TYPES is the TREE_PURPOSE of a DECL_TEMPLATE_INSTANTIATIONS.
1638 CPP_CHECK is used to perform C++ queries on nodes.
1639 SPC is the indentation level. */
1640
1641 static void
1642 dump_template_types (pretty_printer *buffer, tree types,
1643 int (*cpp_check)(tree, cpp_operation), int spc)
1644 {
1645 size_t i;
1646 size_t len = TREE_VEC_LENGTH (types);
1647
1648 for (i = 0; i < len; i++)
1649 {
1650 tree elem = TREE_VEC_ELT (types, i);
1651 pp_character (buffer, '_');
1652 if (!dump_generic_ada_node (buffer, elem, 0, cpp_check, spc, false, true))
1653 {
1654 pp_string (buffer, "unknown");
1655 pp_scalar (buffer, "%lu", (unsigned long) TREE_HASH (elem));
1656 }
1657 }
1658 }
1659
1660 /* Dump in BUFFER the contents of all instantiations associated with a given
1661 template T. CPP_CHECK is used to perform C++ queries on nodes.
1662 SPC is the indentation level. */
1663
1664 static int
1665 dump_ada_template (pretty_printer *buffer, tree t,
1666 int (*cpp_check)(tree, cpp_operation), int spc)
1667 {
1668 tree inst = DECL_VINDEX (t);
1669 /* DECL_VINDEX is DECL_TEMPLATE_INSTANTIATIONS in this context. */
1670 int num_inst = 0;
1671
1672 while (inst && inst != error_mark_node)
1673 {
1674 tree types = TREE_PURPOSE (inst);
1675 tree instance = TREE_VALUE (inst);
1676
1677 if (TREE_VEC_LENGTH (types) == 0)
1678 break;
1679
1680 if (!TYPE_METHODS (instance))
1681 break;
1682
1683 num_inst++;
1684 INDENT (spc);
1685 pp_string (buffer, "package ");
1686 package_prefix = false;
1687 dump_generic_ada_node (buffer, instance, t, cpp_check, spc, false, true);
1688 dump_template_types (buffer, types, cpp_check, spc);
1689 pp_string (buffer, " is");
1690 spc += INDENT_INCR;
1691 newline_and_indent (buffer, spc);
1692
1693 pp_string (buffer, "type ");
1694 dump_generic_ada_node (buffer, instance, t, cpp_check, spc, false, true);
1695 package_prefix = true;
1696
1697 if (is_tagged_type (instance))
1698 pp_string (buffer, " is tagged limited ");
1699 else
1700 pp_string (buffer, " is limited ");
1701
1702 dump_generic_ada_node (buffer, instance, t, cpp_check, spc, false, false);
1703 pp_newline (buffer);
1704 spc -= INDENT_INCR;
1705 newline_and_indent (buffer, spc);
1706
1707 pp_string (buffer, "end;");
1708 newline_and_indent (buffer, spc);
1709 pp_string (buffer, "use ");
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 package_prefix = true;
1714 pp_semicolon (buffer);
1715 pp_newline (buffer);
1716 pp_newline (buffer);
1717
1718 inst = TREE_CHAIN (inst);
1719 }
1720
1721 return num_inst > 0;
1722 }
1723
1724 static bool in_function = true;
1725 static bool bitfield_used = false;
1726
1727 /* Recursively dump in BUFFER Ada declarations corresponding to NODE of type
1728 TYPE. CPP_CHECK is used to perform C++ queries on nodes. SPC is the
1729 indentation level. LIMITED_ACCESS indicates whether NODE can be referenced
1730 via a "limited with" clause. NAME_ONLY indicates whether we should only
1731 dump the name of NODE, instead of its full declaration. */
1732
1733 static int
1734 dump_generic_ada_node (pretty_printer *buffer, tree node, tree type,
1735 int (*cpp_check)(tree, cpp_operation), int spc,
1736 int limited_access, bool name_only)
1737 {
1738 if (node == NULL_TREE)
1739 return 0;
1740
1741 switch (TREE_CODE (node))
1742 {
1743 case ERROR_MARK:
1744 pp_string (buffer, "<<< error >>>");
1745 return 0;
1746
1747 case IDENTIFIER_NODE:
1748 pp_ada_tree_identifier (buffer, node, type, limited_access);
1749 break;
1750
1751 case TREE_LIST:
1752 pp_string (buffer, "--- unexpected node: TREE_LIST");
1753 return 0;
1754
1755 case TREE_BINFO:
1756 dump_generic_ada_node
1757 (buffer, BINFO_TYPE (node), type, cpp_check,
1758 spc, limited_access, name_only);
1759
1760 case TREE_VEC:
1761 pp_string (buffer, "--- unexpected node: TREE_VEC");
1762 return 0;
1763
1764 case VOID_TYPE:
1765 if (package_prefix)
1766 {
1767 append_withs ("System", false);
1768 pp_string (buffer, "System.Address");
1769 }
1770 else
1771 pp_string (buffer, "address");
1772 break;
1773
1774 case VECTOR_TYPE:
1775 pp_string (buffer, "<vector>");
1776 break;
1777
1778 case COMPLEX_TYPE:
1779 pp_string (buffer, "<complex>");
1780 break;
1781
1782 case ENUMERAL_TYPE:
1783 if (name_only)
1784 dump_generic_ada_node
1785 (buffer, TYPE_NAME (node), node, cpp_check, spc, 0, true);
1786 else
1787 {
1788 tree value;
1789
1790 pp_string (buffer, "unsigned");
1791
1792 for (value = TYPE_VALUES (node); value; value = TREE_CHAIN (value))
1793 {
1794 pp_semicolon (buffer);
1795 newline_and_indent (buffer, spc);
1796
1797 pp_ada_tree_identifier
1798 (buffer, TREE_PURPOSE (value), node, false);
1799 pp_string (buffer, " : constant ");
1800
1801 dump_generic_ada_node
1802 (buffer, DECL_NAME (type) ? type : TYPE_NAME (node), type,
1803 cpp_check, spc, 0, true);
1804
1805 pp_string (buffer, " := ");
1806 dump_generic_ada_node
1807 (buffer,
1808 TREE_CODE (TREE_VALUE (value)) == INTEGER_CST ?
1809 TREE_VALUE (value) : DECL_INITIAL (TREE_VALUE (value)),
1810 node,
1811 cpp_check, spc, false, true);
1812 }
1813 }
1814 break;
1815
1816 case INTEGER_TYPE:
1817 case REAL_TYPE:
1818 case FIXED_POINT_TYPE:
1819 case BOOLEAN_TYPE:
1820 {
1821 enum tree_code_class tclass;
1822
1823 tclass = TREE_CODE_CLASS (TREE_CODE (node));
1824
1825 if (tclass == tcc_declaration)
1826 {
1827 if (DECL_NAME (node))
1828 pp_ada_tree_identifier
1829 (buffer, DECL_NAME (node), 0, limited_access);
1830 else
1831 pp_string (buffer, "<unnamed type decl>");
1832 }
1833 else if (tclass == tcc_type)
1834 {
1835 if (TYPE_NAME (node))
1836 {
1837 if (TREE_CODE (TYPE_NAME (node)) == IDENTIFIER_NODE)
1838 pp_ada_tree_identifier (buffer, TYPE_NAME (node),
1839 node, limited_access);
1840 else if (TREE_CODE (TYPE_NAME (node)) == TYPE_DECL
1841 && DECL_NAME (TYPE_NAME (node)))
1842 dump_ada_decl_name (buffer, TYPE_NAME (node), limited_access);
1843 else
1844 pp_string (buffer, "<unnamed type>");
1845 }
1846 else if (TREE_CODE (node) == INTEGER_TYPE)
1847 {
1848 append_withs ("Interfaces.C.Extensions", false);
1849 bitfield_used = true;
1850
1851 if (TYPE_PRECISION (node) == 1)
1852 pp_string (buffer, "Extensions.Unsigned_1");
1853 else
1854 {
1855 pp_string (buffer, (TYPE_UNSIGNED (node)
1856 ? "Extensions.Unsigned_"
1857 : "Extensions.Signed_"));
1858 pp_decimal_int (buffer, TYPE_PRECISION (node));
1859 }
1860 }
1861 else
1862 pp_string (buffer, "<unnamed type>");
1863 }
1864 break;
1865 }
1866
1867 case POINTER_TYPE:
1868 case REFERENCE_TYPE:
1869 if (TREE_CODE (TREE_TYPE (node)) == FUNCTION_TYPE)
1870 {
1871 tree fnode = TREE_TYPE (node);
1872 bool is_function;
1873 bool prev_in_function = in_function;
1874
1875 if (VOID_TYPE_P (TREE_TYPE (fnode)))
1876 {
1877 is_function = false;
1878 pp_string (buffer, "access procedure");
1879 }
1880 else
1881 {
1882 is_function = true;
1883 pp_string (buffer, "access function");
1884 }
1885
1886 in_function = is_function;
1887 dump_ada_function_declaration
1888 (buffer, node, false, false, false, spc + INDENT_INCR);
1889 in_function = prev_in_function;
1890
1891 if (is_function)
1892 {
1893 pp_string (buffer, " return ");
1894 dump_generic_ada_node
1895 (buffer, TREE_TYPE (fnode), type, cpp_check, spc, 0, true);
1896 }
1897 }
1898 else
1899 {
1900 int is_access = false;
1901 unsigned int quals = TYPE_QUALS (TREE_TYPE (node));
1902
1903 if (name_only && TYPE_NAME (node))
1904 dump_generic_ada_node
1905 (buffer, TYPE_NAME (node), node, cpp_check,
1906 spc, limited_access, true);
1907 else if (VOID_TYPE_P (TREE_TYPE (node)))
1908 {
1909 if (!name_only)
1910 pp_string (buffer, "new ");
1911 if (package_prefix)
1912 {
1913 append_withs ("System", false);
1914 pp_string (buffer, "System.Address");
1915 }
1916 else
1917 pp_string (buffer, "address");
1918 }
1919 else
1920 {
1921 if (TREE_CODE (node) == POINTER_TYPE
1922 && TREE_CODE (TREE_TYPE (node)) == INTEGER_TYPE
1923 && !strcmp
1924 (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME
1925 (TREE_TYPE (node)))), "char"))
1926 {
1927 if (!name_only)
1928 pp_string (buffer, "new ");
1929
1930 if (package_prefix)
1931 {
1932 pp_string (buffer, "Interfaces.C.Strings.chars_ptr");
1933 append_withs ("Interfaces.C.Strings", false);
1934 }
1935 else
1936 pp_string (buffer, "chars_ptr");
1937 }
1938 else
1939 {
1940 /* For now, handle all access-to-access or
1941 access-to-unknown-structs as opaque system.address. */
1942
1943 tree typ = TYPE_NAME (TREE_TYPE (node));
1944 const_tree typ2 = !type ||
1945 DECL_P (type) ? type : TYPE_NAME (type);
1946 const_tree underlying_type =
1947 get_underlying_decl (TREE_TYPE (node));
1948
1949 if (TREE_CODE (TREE_TYPE (node)) == POINTER_TYPE
1950 /* Pointer to pointer. */
1951
1952 || (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node))
1953 && (!underlying_type
1954 || !TYPE_FIELDS (TREE_TYPE (underlying_type))))
1955 /* Pointer to opaque structure. */
1956
1957 || (typ && typ2
1958 && DECL_P (underlying_type)
1959 && DECL_P (typ2)
1960 && decl_sloc (underlying_type, true)
1961 > decl_sloc (typ2, true)
1962 && DECL_SOURCE_FILE (underlying_type)
1963 == DECL_SOURCE_FILE (typ2)))
1964 {
1965 if (package_prefix)
1966 {
1967 append_withs ("System", false);
1968 if (!name_only)
1969 pp_string (buffer, "new ");
1970 pp_string (buffer, "System.Address");
1971 }
1972 else
1973 pp_string (buffer, "address");
1974 return spc;
1975 }
1976
1977 if (!package_prefix)
1978 pp_string (buffer, "access");
1979 else if (AGGREGATE_TYPE_P (TREE_TYPE (node)))
1980 {
1981 if (!type || TREE_CODE (type) != FUNCTION_DECL)
1982 {
1983 pp_string (buffer, "access ");
1984 is_access = true;
1985
1986 if (quals & TYPE_QUAL_CONST)
1987 pp_string (buffer, "constant ");
1988 else if (!name_only)
1989 pp_string (buffer, "all ");
1990 }
1991 else if (quals & TYPE_QUAL_CONST)
1992 pp_string (buffer, "in ");
1993 else if (in_function)
1994 {
1995 is_access = true;
1996 pp_string (buffer, "access ");
1997 }
1998 else
1999 {
2000 is_access = true;
2001 pp_string (buffer, "access ");
2002 /* ??? should be configurable: access or in out. */
2003 }
2004 }
2005 else
2006 {
2007 is_access = true;
2008 pp_string (buffer, "access ");
2009
2010 if (!name_only)
2011 pp_string (buffer, "all ");
2012 }
2013
2014 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node))
2015 && TYPE_NAME (TREE_TYPE (node)))
2016 {
2017 tree name = TYPE_NAME (TREE_TYPE (node));
2018 tree tmp;
2019
2020 if (TREE_CODE (name) == TYPE_DECL
2021 && DECL_ORIGINAL_TYPE (name)
2022 && TYPE_STUB_DECL (DECL_ORIGINAL_TYPE (name)))
2023 {
2024 tmp = TYPE_NAME (TREE_TYPE (TYPE_STUB_DECL
2025 (DECL_ORIGINAL_TYPE (name))));
2026
2027 if (tmp == NULL_TREE)
2028 tmp = TYPE_NAME (TREE_TYPE (node));
2029 }
2030 else
2031 tmp = TYPE_NAME (TREE_TYPE (node));
2032
2033 dump_generic_ada_node
2034 (buffer, tmp,
2035 TREE_TYPE (node), cpp_check, spc, is_access, true);
2036 }
2037 else
2038 dump_generic_ada_node
2039 (buffer, TREE_TYPE (node), TREE_TYPE (node),
2040 cpp_check, spc, 0, true);
2041 }
2042 }
2043 }
2044 break;
2045
2046 case ARRAY_TYPE:
2047 if (name_only)
2048 dump_generic_ada_node
2049 (buffer, TYPE_NAME (node), node, cpp_check,
2050 spc, limited_access, true);
2051 else
2052 dump_ada_array_type (buffer, node, spc);
2053 break;
2054
2055 case RECORD_TYPE:
2056 case UNION_TYPE:
2057 case QUAL_UNION_TYPE:
2058 if (name_only)
2059 {
2060 if (TYPE_NAME (node))
2061 dump_generic_ada_node
2062 (buffer, TYPE_NAME (node), node, cpp_check,
2063 spc, limited_access, true);
2064 else
2065 {
2066 pp_string (buffer, "anon_");
2067 pp_scalar (buffer, "%d", TYPE_UID (node));
2068 }
2069 }
2070 else
2071 print_ada_struct_decl
2072 (buffer, node, type, cpp_check, spc, true);
2073 break;
2074
2075 case INTEGER_CST:
2076 if (TREE_CODE (TREE_TYPE (node)) == POINTER_TYPE)
2077 {
2078 pp_wide_integer (buffer, TREE_INT_CST_LOW (node));
2079 pp_string (buffer, "B"); /* pseudo-unit */
2080 }
2081 else if (! host_integerp (node, 0))
2082 {
2083 tree val = node;
2084 unsigned HOST_WIDE_INT low = TREE_INT_CST_LOW (val);
2085 HOST_WIDE_INT high = TREE_INT_CST_HIGH (val);
2086
2087 if (tree_int_cst_sgn (val) < 0)
2088 {
2089 pp_character (buffer, '-');
2090 high = ~high + !low;
2091 low = -low;
2092 }
2093 sprintf (pp_buffer (buffer)->digit_buffer,
2094 HOST_WIDE_INT_PRINT_DOUBLE_HEX,
2095 (unsigned HOST_WIDE_INT) high, low);
2096 pp_string (buffer, pp_buffer (buffer)->digit_buffer);
2097 }
2098 else
2099 pp_wide_integer (buffer, TREE_INT_CST_LOW (node));
2100 break;
2101
2102 case REAL_CST:
2103 case FIXED_CST:
2104 case COMPLEX_CST:
2105 case STRING_CST:
2106 case VECTOR_CST:
2107 return 0;
2108
2109 case FUNCTION_DECL:
2110 case CONST_DECL:
2111 dump_ada_decl_name (buffer, node, limited_access);
2112 break;
2113
2114 case TYPE_DECL:
2115 if (DECL_IS_BUILTIN (node))
2116 {
2117 /* Don't print the declaration of built-in types. */
2118
2119 if (name_only)
2120 {
2121 /* If we're in the middle of a declaration, defaults to
2122 System.Address. */
2123 if (package_prefix)
2124 {
2125 append_withs ("System", false);
2126 pp_string (buffer, "System.Address");
2127 }
2128 else
2129 pp_string (buffer, "address");
2130 }
2131 break;
2132 }
2133
2134 if (name_only)
2135 dump_ada_decl_name (buffer, node, limited_access);
2136 else
2137 {
2138 if (is_tagged_type (TREE_TYPE (node)))
2139 {
2140 tree tmp = TYPE_FIELDS (TREE_TYPE (node));
2141 int first = 1;
2142
2143 /* Look for ancestors. */
2144 for (; tmp; tmp = TREE_CHAIN (tmp))
2145 {
2146 if (!DECL_NAME (tmp) && is_tagged_type (TREE_TYPE (tmp)))
2147 {
2148 if (first)
2149 {
2150 pp_string (buffer, "limited new ");
2151 first = 0;
2152 }
2153 else
2154 pp_string (buffer, " and ");
2155
2156 dump_ada_decl_name
2157 (buffer, TYPE_NAME (TREE_TYPE (tmp)), false);
2158 }
2159 }
2160
2161 pp_string (buffer, first ? "tagged limited " : " with ");
2162 }
2163 else if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node))
2164 && TYPE_METHODS (TREE_TYPE (node)))
2165 pp_string (buffer, "limited ");
2166
2167 dump_generic_ada_node
2168 (buffer, TREE_TYPE (node), type, cpp_check, spc, false, false);
2169 }
2170 break;
2171
2172 case VAR_DECL:
2173 case PARM_DECL:
2174 case FIELD_DECL:
2175 case NAMESPACE_DECL:
2176 dump_ada_decl_name (buffer, node, false);
2177 break;
2178
2179 default:
2180 /* Ignore other nodes (e.g. expressions). */
2181 return 0;
2182 }
2183
2184 return 1;
2185 }
2186
2187 /* Dump in BUFFER NODE's methods. CPP_CHECK is used to perform C++ queries on
2188 nodes. SPC is the indentation level. */
2189
2190 static void
2191 print_ada_methods (pretty_printer *buffer, tree node,
2192 int (*cpp_check)(tree, cpp_operation), int spc)
2193 {
2194 tree tmp = TYPE_METHODS (node);
2195 int res = 1;
2196
2197 if (tmp)
2198 {
2199 pp_semicolon (buffer);
2200
2201 for (; tmp; tmp = TREE_CHAIN (tmp))
2202 {
2203 if (res)
2204 {
2205 pp_newline (buffer);
2206 pp_newline (buffer);
2207 }
2208 res = print_ada_declaration (buffer, tmp, node, cpp_check, spc);
2209 }
2210 }
2211 }
2212
2213 /* Dump in BUFFER anonymous types nested inside T's definition.
2214 PARENT is the parent node of T. CPP_CHECK is used to perform C++ queries on
2215 nodes. SPC is the indentation level. */
2216
2217 static void
2218 dump_nested_types (pretty_printer *buffer, tree t, tree parent,
2219 int (*cpp_check)(tree, cpp_operation), int spc)
2220 {
2221 tree field, outer, decl;
2222
2223 /* Avoid recursing over the same tree. */
2224 if (TREE_VISITED (t))
2225 return;
2226
2227 /* Find possible anonymous arrays/unions/structs recursively. */
2228
2229 outer = TREE_TYPE (t);
2230
2231 if (outer == NULL_TREE)
2232 return;
2233
2234 field = TYPE_FIELDS (outer);
2235 while (field)
2236 {
2237 if ((TREE_TYPE (field) != outer
2238 || (TREE_CODE (TREE_TYPE (field)) == POINTER_TYPE
2239 && TREE_TYPE (TREE_TYPE (field)) != outer))
2240 && (!TYPE_NAME (TREE_TYPE (field))
2241 || (TREE_CODE (field) == TYPE_DECL
2242 && DECL_NAME (field) != DECL_NAME (t)
2243 && TYPE_NAME (TREE_TYPE (field)) != TYPE_NAME (outer))))
2244 {
2245 switch (TREE_CODE (TREE_TYPE (field)))
2246 {
2247 case POINTER_TYPE:
2248 decl = TREE_TYPE (TREE_TYPE (field));
2249
2250 if (TREE_CODE (decl) == FUNCTION_TYPE)
2251 for (decl = TREE_TYPE (decl);
2252 decl && TREE_CODE (decl) == POINTER_TYPE;
2253 decl = TREE_TYPE (decl));
2254
2255 decl = get_underlying_decl (decl);
2256
2257 if (decl
2258 && DECL_P (decl)
2259 && decl_sloc (decl, true) > decl_sloc (t, true)
2260 && DECL_SOURCE_FILE (decl) == DECL_SOURCE_FILE (t)
2261 && !TREE_VISITED (decl)
2262 && !DECL_IS_BUILTIN (decl)
2263 && (!RECORD_OR_UNION_TYPE_P (TREE_TYPE (decl))
2264 || TYPE_FIELDS (TREE_TYPE (decl))))
2265 {
2266 /* Generate forward declaration. */
2267
2268 pp_string (buffer, "type ");
2269 dump_generic_ada_node
2270 (buffer, decl, 0, cpp_check, spc, false, true);
2271 pp_semicolon (buffer);
2272 newline_and_indent (buffer, spc);
2273
2274 /* Ensure we do not generate duplicate forward
2275 declarations for this type. */
2276 TREE_VISITED (decl) = 1;
2277 }
2278 break;
2279
2280 case ARRAY_TYPE:
2281 /* Special case char arrays. */
2282 if (is_char_array (field))
2283 pp_string (buffer, "sub");
2284
2285 pp_string (buffer, "type ");
2286 dump_ada_double_name (buffer, parent, field, "_array is ");
2287 dump_ada_array_type (buffer, field, spc);
2288 pp_semicolon (buffer);
2289 newline_and_indent (buffer, spc);
2290 break;
2291
2292 case UNION_TYPE:
2293 TREE_VISITED (t) = 1;
2294 dump_nested_types (buffer, field, t, cpp_check, spc);
2295
2296 pp_string (buffer, "type ");
2297
2298 if (TYPE_NAME (TREE_TYPE (field)))
2299 {
2300 dump_generic_ada_node
2301 (buffer, TYPE_NAME (TREE_TYPE (field)), 0, cpp_check,
2302 spc, false, true);
2303 pp_string (buffer, " (discr : unsigned := 0) is ");
2304 print_ada_struct_decl
2305 (buffer, TREE_TYPE (field), t, cpp_check, spc, false);
2306
2307 pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
2308 dump_generic_ada_node
2309 (buffer, TREE_TYPE (field), 0, cpp_check,
2310 spc, false, true);
2311 pp_string (buffer, ");");
2312 newline_and_indent (buffer, spc);
2313
2314 pp_string (buffer, "pragma Unchecked_Union (");
2315 dump_generic_ada_node
2316 (buffer, TREE_TYPE (field), 0, cpp_check,
2317 spc, false, true);
2318 pp_string (buffer, ");");
2319 }
2320 else
2321 {
2322 dump_ada_double_name
2323 (buffer, parent, field,
2324 "_union (discr : unsigned := 0) is ");
2325 print_ada_struct_decl
2326 (buffer, TREE_TYPE (field), t, cpp_check, spc, false);
2327 pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
2328 dump_ada_double_name (buffer, parent, field, "_union);");
2329 newline_and_indent (buffer, spc);
2330
2331 pp_string (buffer, "pragma Unchecked_Union (");
2332 dump_ada_double_name (buffer, parent, field, "_union);");
2333 }
2334
2335 newline_and_indent (buffer, spc);
2336 break;
2337
2338 case RECORD_TYPE:
2339 if (TYPE_NAME (TREE_TYPE (t)) && !TREE_VISITED (t))
2340 {
2341 pp_string (buffer, "type ");
2342 dump_generic_ada_node
2343 (buffer, t, parent, 0, spc, false, true);
2344 pp_semicolon (buffer);
2345 newline_and_indent (buffer, spc);
2346 }
2347
2348 TREE_VISITED (t) = 1;
2349 dump_nested_types (buffer, field, t, cpp_check, spc);
2350 pp_string (buffer, "type ");
2351
2352 if (TYPE_NAME (TREE_TYPE (field)))
2353 {
2354 dump_generic_ada_node
2355 (buffer, TREE_TYPE (field), 0, cpp_check,
2356 spc, false, true);
2357 pp_string (buffer, " is ");
2358 print_ada_struct_decl
2359 (buffer, TREE_TYPE (field), t, cpp_check, spc, false);
2360 pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
2361 dump_generic_ada_node
2362 (buffer, TREE_TYPE (field), 0, cpp_check,
2363 spc, false, true);
2364 pp_string (buffer, ");");
2365 }
2366 else
2367 {
2368 dump_ada_double_name
2369 (buffer, parent, field, "_struct is ");
2370 print_ada_struct_decl
2371 (buffer, TREE_TYPE (field), t, cpp_check, spc, false);
2372 pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
2373 dump_ada_double_name (buffer, parent, field, "_struct);");
2374 }
2375
2376 newline_and_indent (buffer, spc);
2377 break;
2378
2379 default:
2380 break;
2381 }
2382 }
2383 field = TREE_CHAIN (field);
2384 }
2385 }
2386
2387 /* Dump in BUFFER destructor spec corresponding to T. */
2388
2389 static void
2390 print_destructor (pretty_printer *buffer, tree t)
2391 {
2392 const char *s = IDENTIFIER_POINTER (DECL_NAME (t));
2393
2394 if (*s == '_')
2395 for (s += 2; *s != ' '; s++)
2396 pp_character (buffer, *s);
2397 else
2398 {
2399 pp_string (buffer, "Delete_");
2400 pp_ada_tree_identifier (buffer, DECL_NAME (t), t, false);
2401 }
2402 }
2403
2404 /* Return the name of type T. */
2405
2406 static const char *
2407 type_name (tree t)
2408 {
2409 tree n = TYPE_NAME (t);
2410
2411 if (TREE_CODE (n) == IDENTIFIER_NODE)
2412 return IDENTIFIER_POINTER (n);
2413 else
2414 return IDENTIFIER_POINTER (DECL_NAME (n));
2415 }
2416
2417 /* Print in BUFFER the declaration of a variable T of type TYPE in Ada syntax.
2418 CPP_CHECK is used to perform C++ queries on nodes. SPC is the indentation
2419 level. Return 1 if a declaration was printed, 0 otherwise. */
2420
2421 static int
2422 print_ada_declaration (pretty_printer *buffer, tree t, tree type,
2423 int (*cpp_check)(tree, cpp_operation), int spc)
2424 {
2425 int is_var = 0, need_indent = 0;
2426 int is_class = false;
2427 tree name = TYPE_NAME (TREE_TYPE (t));
2428 tree decl_name = DECL_NAME (t);
2429 bool dump_internal = get_dump_file_info (TDI_ada)->flags & TDF_RAW;
2430 tree orig = NULL_TREE;
2431
2432 if (cpp_check && cpp_check (t, IS_TEMPLATE))
2433 return dump_ada_template (buffer, t, cpp_check, spc);
2434
2435 if (TREE_CODE (t) == CONST_DECL && TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE)
2436 /* Skip enumeral values: will be handled as part of the type itself. */
2437 return 0;
2438
2439 if (TREE_CODE (t) == TYPE_DECL)
2440 {
2441 orig = DECL_ORIGINAL_TYPE (t);
2442
2443 if (orig && TYPE_STUB_DECL (orig))
2444 {
2445 tree typ = TREE_TYPE (TYPE_STUB_DECL (orig));
2446
2447 if (TYPE_NAME (typ))
2448 {
2449 /* If types have same representation, and same name (ignoring
2450 casing), then ignore the second type. */
2451 if (type_name (typ) == type_name (TREE_TYPE (t))
2452 || !strcasecmp (type_name (typ), type_name (TREE_TYPE (t))))
2453 return 0;
2454
2455 INDENT (spc);
2456
2457 if (RECORD_OR_UNION_TYPE_P (typ) && !TYPE_FIELDS (typ))
2458 {
2459 pp_string (buffer, "-- skipped empty struct ");
2460 dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
2461 }
2462 else
2463 {
2464 pp_string (buffer, "subtype ");
2465 dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
2466 pp_string (buffer, " is ");
2467 dump_generic_ada_node
2468 (buffer, typ, type, 0, spc, false, true);
2469 pp_semicolon (buffer);
2470 }
2471 return 1;
2472 }
2473 }
2474
2475 /* Skip unnamed or anonymous structs/unions/enum types. */
2476 if (!orig && !decl_name && !name)
2477 {
2478 tree tmp;
2479 location_t sloc;
2480
2481 if (cpp_check || TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE)
2482 return 0;
2483
2484 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t)))
2485 {
2486 /* Search next items until finding a named type decl. */
2487 sloc = decl_sloc_common (t, true, true);
2488
2489 for (tmp = TREE_CHAIN (t); tmp; tmp = TREE_CHAIN (tmp))
2490 {
2491 if (TREE_CODE (tmp) == TYPE_DECL
2492 && (DECL_NAME (tmp) || TYPE_NAME (TREE_TYPE (tmp))))
2493 {
2494 /* If same sloc, it means we can ignore the anonymous
2495 struct. */
2496 if (decl_sloc_common (tmp, true, true) == sloc)
2497 return 0;
2498 else
2499 break;
2500 }
2501 }
2502 if (tmp == NULL)
2503 return 0;
2504 }
2505 }
2506
2507 if (!orig
2508 && TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE
2509 && decl_name
2510 && (*IDENTIFIER_POINTER (decl_name) == '.'
2511 || *IDENTIFIER_POINTER (decl_name) == '$'))
2512 /* Skip anonymous enum types (duplicates of real types). */
2513 return 0;
2514
2515 INDENT (spc);
2516
2517 switch (TREE_CODE (TREE_TYPE (t)))
2518 {
2519 case RECORD_TYPE:
2520 case UNION_TYPE:
2521 case QUAL_UNION_TYPE:
2522 /* Skip empty structs (typically forward references to real
2523 structs). */
2524 if (!TYPE_FIELDS (TREE_TYPE (t)))
2525 {
2526 pp_string (buffer, "-- skipped empty struct ");
2527 dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
2528 return 1;
2529 }
2530
2531 if (decl_name
2532 && (*IDENTIFIER_POINTER (decl_name) == '.'
2533 || *IDENTIFIER_POINTER (decl_name) == '$'))
2534 {
2535 pp_string (buffer, "-- skipped anonymous struct ");
2536 dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
2537 return 1;
2538 }
2539
2540 if (orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
2541 pp_string (buffer, "subtype ");
2542 else
2543 {
2544 dump_nested_types (buffer, t, t, cpp_check, spc);
2545
2546 if (TYPE_METHODS (TREE_TYPE (t))
2547 || has_static_fields (TREE_TYPE (t)))
2548 {
2549 is_class = true;
2550 pp_string (buffer, "package Class_");
2551 dump_generic_ada_node
2552 (buffer, t, type, 0, spc, false, true);
2553 pp_string (buffer, " is");
2554 spc += INDENT_INCR;
2555 newline_and_indent (buffer, spc);
2556 }
2557
2558 pp_string (buffer, "type ");
2559 }
2560 break;
2561
2562 case ARRAY_TYPE:
2563 case POINTER_TYPE:
2564 case REFERENCE_TYPE:
2565 if ((orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
2566 || is_char_array (t))
2567 pp_string (buffer, "subtype ");
2568 else
2569 pp_string (buffer, "type ");
2570 break;
2571
2572 case FUNCTION_TYPE:
2573 pp_string (buffer, "-- skipped function type ");
2574 dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
2575 return 1;
2576 break;
2577
2578 default:
2579 pp_string (buffer, "subtype ");
2580 }
2581 }
2582 else
2583 {
2584 if (!dump_internal
2585 && TREE_CODE (t) == VAR_DECL
2586 && decl_name
2587 && *IDENTIFIER_POINTER (decl_name) == '_')
2588 return 0;
2589
2590 need_indent = 1;
2591 }
2592
2593 /* Print the type and name. */
2594 if (TREE_CODE (TREE_TYPE (t)) == ARRAY_TYPE)
2595 {
2596 if (need_indent)
2597 INDENT (spc);
2598
2599 /* Print variable's name. */
2600 dump_generic_ada_node (buffer, t, type, cpp_check, spc, false, true);
2601
2602 if (TREE_CODE (t) == TYPE_DECL)
2603 {
2604 pp_string (buffer, " is ");
2605
2606 if (orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
2607 dump_generic_ada_node
2608 (buffer, TYPE_NAME (orig), type,
2609 cpp_check, spc, false, true);
2610 else
2611 dump_ada_array_type (buffer, t, spc);
2612 }
2613 else
2614 {
2615 tree tmp = TYPE_NAME (TREE_TYPE (t));
2616
2617 if (spc == INDENT_INCR || TREE_STATIC (t))
2618 is_var = 1;
2619
2620 pp_string (buffer, " : ");
2621
2622 if (tmp)
2623 {
2624 if (TREE_CODE (TREE_TYPE (tmp)) != POINTER_TYPE
2625 && TREE_CODE (tmp) != INTEGER_TYPE)
2626 pp_string (buffer, "aliased ");
2627
2628 dump_generic_ada_node (buffer, tmp, type, 0, spc, false, true);
2629 }
2630 else
2631 {
2632 pp_string (buffer, "aliased ");
2633
2634 if (!type)
2635 dump_ada_array_type (buffer, t, spc);
2636 else
2637 dump_ada_double_name (buffer, type, t, "_array");
2638 }
2639 }
2640 }
2641 else if (TREE_CODE (t) == FUNCTION_DECL)
2642 {
2643 bool is_function = true, is_method, is_abstract_class = false;
2644 tree decl_name = DECL_NAME (t);
2645 int prev_in_function = in_function;
2646 bool is_abstract = false;
2647 bool is_constructor = false;
2648 bool is_destructor = false;
2649 bool is_copy_constructor = false;
2650
2651 if (!decl_name)
2652 return 0;
2653
2654 if (cpp_check)
2655 {
2656 is_abstract = cpp_check (t, IS_ABSTRACT);
2657 is_constructor = cpp_check (t, IS_CONSTRUCTOR);
2658 is_destructor = cpp_check (t, IS_DESTRUCTOR);
2659 is_copy_constructor = cpp_check (t, IS_COPY_CONSTRUCTOR);
2660 }
2661
2662 /* Skip __comp_dtor destructor which is redundant with the '~class()'
2663 destructor. */
2664 if (is_destructor
2665 && !strncmp (IDENTIFIER_POINTER (decl_name), "__comp", 6))
2666 return 0;
2667
2668 /* Skip copy constructors: some are internal only, and those that are
2669 not cannot be called easily from Ada anyway. */
2670 if (is_copy_constructor)
2671 return 0;
2672
2673 /* If this function has an entry in the dispatch table, we cannot
2674 omit it. */
2675 if (!dump_internal && !DECL_VINDEX (t)
2676 && *IDENTIFIER_POINTER (decl_name) == '_')
2677 {
2678 if (IDENTIFIER_POINTER (decl_name)[1] == '_')
2679 return 0;
2680
2681 INDENT (spc);
2682 pp_string (buffer, "-- skipped func ");
2683 pp_string (buffer, IDENTIFIER_POINTER (decl_name));
2684 return 1;
2685 }
2686
2687 if (need_indent)
2688 INDENT (spc);
2689
2690 if (is_constructor)
2691 pp_string (buffer, "function New_");
2692 else if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t))))
2693 {
2694 is_function = false;
2695 pp_string (buffer, "procedure ");
2696 }
2697 else
2698 pp_string (buffer, "function ");
2699
2700 in_function = is_function;
2701 is_method = TREE_CODE (TREE_TYPE (t)) == METHOD_TYPE;
2702
2703 if (is_destructor)
2704 print_destructor (buffer, t);
2705 else
2706 dump_ada_decl_name (buffer, t, false);
2707
2708 dump_ada_function_declaration
2709 (buffer, t, is_method, is_constructor, is_destructor, spc);
2710 in_function = prev_in_function;
2711
2712 if (is_function)
2713 {
2714 pp_string (buffer, " return ");
2715
2716 if (is_constructor)
2717 {
2718 dump_ada_decl_name (buffer, t, false);
2719 }
2720 else
2721 {
2722 dump_generic_ada_node
2723 (buffer, TREE_TYPE (TREE_TYPE (t)), type, cpp_check,
2724 spc, false, true);
2725 }
2726 }
2727
2728 if (is_constructor && cpp_check && type
2729 && AGGREGATE_TYPE_P (type)
2730 && TYPE_METHODS (type))
2731 {
2732 tree tmp = TYPE_METHODS (type);
2733
2734 for (; tmp; tmp = TREE_CHAIN (tmp))
2735 if (cpp_check (tmp, IS_ABSTRACT))
2736 {
2737 is_abstract_class = 1;
2738 break;
2739 }
2740 }
2741
2742 if (is_abstract || is_abstract_class)
2743 pp_string (buffer, " is abstract");
2744
2745 pp_semicolon (buffer);
2746 pp_string (buffer, " -- ");
2747 dump_sloc (buffer, t);
2748
2749 if (is_abstract)
2750 return 1;
2751
2752 newline_and_indent (buffer, spc);
2753
2754 if (is_constructor)
2755 {
2756 pp_string (buffer, "pragma CPP_Constructor (New_");
2757 dump_ada_decl_name (buffer, t, false);
2758 pp_string (buffer, ", \"");
2759 pp_asm_name (buffer, t);
2760 pp_string (buffer, "\");");
2761 }
2762 else if (is_destructor)
2763 {
2764 pp_string (buffer, "pragma Import (CPP, ");
2765 print_destructor (buffer, t);
2766 pp_string (buffer, ", \"");
2767 pp_asm_name (buffer, t);
2768 pp_string (buffer, "\");");
2769 }
2770 else
2771 {
2772 dump_ada_import (buffer, t);
2773 }
2774
2775 return 1;
2776 }
2777 else if (TREE_CODE (t) == TYPE_DECL && !DECL_ORIGINAL_TYPE (t))
2778 {
2779 int is_interface = 0;
2780 int is_abstract_record = 0;
2781
2782 if (need_indent)
2783 INDENT (spc);
2784
2785 /* Anonymous structs/unions */
2786 dump_generic_ada_node
2787 (buffer, TREE_TYPE (t), t, cpp_check, spc, false, true);
2788
2789 if (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE
2790 || TREE_CODE (TREE_TYPE (t)) == QUAL_UNION_TYPE)
2791 {
2792 pp_string (buffer, " (discr : unsigned := 0)");
2793 }
2794
2795 pp_string (buffer, " is ");
2796
2797 /* Check whether we have an Ada interface compatible class. */
2798 if (cpp_check && AGGREGATE_TYPE_P (TREE_TYPE (t))
2799 && TYPE_METHODS (TREE_TYPE (t)))
2800 {
2801 int num_fields = 0;
2802 tree tmp = TYPE_FIELDS (TREE_TYPE (t));
2803
2804 /* Check that there are no fields other than the virtual table. */
2805 for (; tmp; tmp = TREE_CHAIN (tmp))
2806 {
2807 if (TREE_CODE (tmp) == TYPE_DECL)
2808 continue;
2809 num_fields++;
2810 }
2811
2812 if (num_fields == 1)
2813 is_interface = 1;
2814
2815 /* Also check that there are only virtual methods. */
2816 for (tmp = TYPE_METHODS (TREE_TYPE (t)); tmp; tmp = TREE_CHAIN (tmp))
2817 {
2818 if (cpp_check (tmp, IS_ABSTRACT))
2819 is_abstract_record = 1;
2820 else
2821 is_interface = 0;
2822 }
2823 }
2824
2825 if (is_interface)
2826 {
2827 pp_string (buffer, "limited interface; -- ");
2828 dump_sloc (buffer, t);
2829 newline_and_indent (buffer, spc);
2830 pp_string (buffer, "pragma Import (CPP, ");
2831 dump_generic_ada_node
2832 (buffer, TYPE_NAME (TREE_TYPE (t)), type, cpp_check,
2833 spc, false, true);
2834 pp_character (buffer, ')');
2835
2836 print_ada_methods (buffer, TREE_TYPE (t), cpp_check, spc);
2837 }
2838 else
2839 {
2840 if (is_abstract_record)
2841 pp_string (buffer, "abstract ");
2842 dump_generic_ada_node (buffer, t, t, cpp_check, spc, false, false);
2843 }
2844 }
2845 else
2846 {
2847 if (need_indent)
2848 INDENT (spc);
2849
2850 if (TREE_CODE (t) == FIELD_DECL && DECL_NAME (t))
2851 check_name (buffer, t);
2852
2853 /* Print variable/type's name. */
2854 dump_generic_ada_node (buffer, t, t, cpp_check, spc, false, true);
2855
2856 if (TREE_CODE (t) == TYPE_DECL)
2857 {
2858 tree orig = DECL_ORIGINAL_TYPE (t);
2859 int is_subtype = orig && TYPE_NAME (orig) && orig != TREE_TYPE (t);
2860
2861 if (!is_subtype
2862 && (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE
2863 || TREE_CODE (TREE_TYPE (t)) == QUAL_UNION_TYPE))
2864 pp_string (buffer, " (discr : unsigned := 0)");
2865
2866 pp_string (buffer, " is ");
2867
2868 dump_generic_ada_node
2869 (buffer, orig, t, cpp_check, spc, false, is_subtype);
2870 }
2871 else
2872 {
2873 if (spc == INDENT_INCR || TREE_STATIC (t))
2874 is_var = 1;
2875
2876 pp_string (buffer, " : ");
2877
2878 /* Print type declaration. */
2879
2880 if (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE
2881 && !TYPE_NAME (TREE_TYPE (t)))
2882 {
2883 dump_ada_double_name (buffer, type, t, "_union");
2884 }
2885 else if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t)))
2886 {
2887 if (TREE_CODE (TREE_TYPE (t)) == RECORD_TYPE)
2888 pp_string (buffer, "aliased ");
2889
2890 dump_generic_ada_node
2891 (buffer, TREE_TYPE (t), t, cpp_check, spc, false, true);
2892 }
2893 else
2894 {
2895 if (TREE_CODE (TREE_TYPE (t)) != POINTER_TYPE
2896 && (TYPE_NAME (TREE_TYPE (t))
2897 || TREE_CODE (TREE_TYPE (t)) != INTEGER_TYPE))
2898 pp_string (buffer, "aliased ");
2899
2900 dump_generic_ada_node
2901 (buffer, TREE_TYPE (t), TREE_TYPE (t), cpp_check,
2902 spc, false, true);
2903 }
2904 }
2905 }
2906
2907 if (is_class)
2908 {
2909 spc -= 3;
2910 newline_and_indent (buffer, spc);
2911 pp_string (buffer, "end;");
2912 newline_and_indent (buffer, spc);
2913 pp_string (buffer, "use Class_");
2914 dump_generic_ada_node (buffer, t, type, 0, spc, false, true);
2915 pp_semicolon (buffer);
2916 pp_newline (buffer);
2917
2918 /* All needed indentation/newline performed already, so return 0. */
2919 return 0;
2920 }
2921 else
2922 {
2923 pp_string (buffer, "; -- ");
2924 dump_sloc (buffer, t);
2925 }
2926
2927 if (is_var)
2928 {
2929 newline_and_indent (buffer, spc);
2930 dump_ada_import (buffer, t);
2931 }
2932
2933 return 1;
2934 }
2935
2936 /* Prints in BUFFER a structure NODE of type TYPE: name, fields, and methods
2937 with Ada syntax. CPP_CHECK is used to perform C++ queries on nodes. SPC
2938 is the indentation level. If DISPLAY_CONVENTION is true, also print the
2939 pragma Convention for NODE. */
2940
2941 static void
2942 print_ada_struct_decl (pretty_printer *buffer, tree node, tree type,
2943 int (*cpp_check)(tree, cpp_operation), int spc,
2944 bool display_convention)
2945 {
2946 tree tmp;
2947 int is_union =
2948 TREE_CODE (node) == UNION_TYPE || TREE_CODE (node) == QUAL_UNION_TYPE;
2949 char buf [16];
2950 int field_num = 0;
2951 int field_spc = spc + INDENT_INCR;
2952 int need_semicolon;
2953
2954 bitfield_used = false;
2955
2956 if (!TYPE_FIELDS (node))
2957 pp_string (buffer, "null record;");
2958 else
2959 {
2960 pp_string (buffer, "record");
2961
2962 /* Print the contents of the structure. */
2963
2964 if (is_union)
2965 {
2966 newline_and_indent (buffer, spc + INDENT_INCR);
2967 pp_string (buffer, "case discr is");
2968 field_spc = spc + INDENT_INCR * 3;
2969 }
2970
2971 pp_newline (buffer);
2972
2973 /* Print the non-static fields of the structure. */
2974 for (tmp = TYPE_FIELDS (node); tmp; tmp = TREE_CHAIN (tmp))
2975 {
2976 /* Add parent field if needed. */
2977 if (!DECL_NAME (tmp))
2978 {
2979 if (!is_tagged_type (TREE_TYPE (tmp)))
2980 {
2981 if (!TYPE_NAME (TREE_TYPE (tmp)))
2982 print_ada_declaration
2983 (buffer, tmp, type, cpp_check, field_spc);
2984 else
2985 {
2986 INDENT (field_spc);
2987
2988 if (field_num == 0)
2989 pp_string (buffer, "parent : ");
2990 else
2991 {
2992 sprintf (buf, "field_%d : ", field_num + 1);
2993 pp_string (buffer, buf);
2994 }
2995 dump_ada_decl_name
2996 (buffer, TYPE_NAME (TREE_TYPE (tmp)), false);
2997 pp_semicolon (buffer);
2998 }
2999 pp_newline (buffer);
3000 field_num++;
3001 }
3002 }
3003 /* Avoid printing the structure recursively. */
3004 else if ((TREE_TYPE (tmp) != node
3005 || (TREE_CODE (TREE_TYPE (tmp)) == POINTER_TYPE
3006 && TREE_TYPE (TREE_TYPE (tmp)) != node))
3007 && TREE_CODE (tmp) != TYPE_DECL
3008 && !TREE_STATIC (tmp))
3009 {
3010 /* Skip internal virtual table field. */
3011 if (strncmp (IDENTIFIER_POINTER (DECL_NAME (tmp)), "_vptr", 5))
3012 {
3013 if (is_union)
3014 {
3015 if (TREE_CHAIN (tmp)
3016 && TREE_TYPE (TREE_CHAIN (tmp)) != node
3017 && TREE_CODE (TREE_CHAIN (tmp)) != TYPE_DECL)
3018 sprintf (buf, "when %d =>", field_num);
3019 else
3020 sprintf (buf, "when others =>");
3021
3022 INDENT (spc + INDENT_INCR * 2);
3023 pp_string (buffer, buf);
3024 pp_newline (buffer);
3025 }
3026
3027 if (print_ada_declaration (buffer,
3028 tmp, type, cpp_check, field_spc))
3029 {
3030 pp_newline (buffer);
3031 field_num++;
3032 }
3033 }
3034 }
3035 }
3036
3037 if (is_union)
3038 {
3039 INDENT (spc + INDENT_INCR);
3040 pp_string (buffer, "end case;");
3041 pp_newline (buffer);
3042 }
3043
3044 if (field_num == 0)
3045 {
3046 INDENT (spc + INDENT_INCR);
3047 pp_string (buffer, "null;");
3048 pp_newline (buffer);
3049 }
3050
3051 INDENT (spc);
3052 pp_string (buffer, "end record;");
3053 }
3054
3055 newline_and_indent (buffer, spc);
3056
3057 if (!display_convention)
3058 return;
3059
3060 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (type)))
3061 {
3062 if (TYPE_METHODS (TREE_TYPE (type)))
3063 pp_string (buffer, "pragma Import (CPP, ");
3064 else
3065 pp_string (buffer, "pragma Convention (C_Pass_By_Copy, ");
3066 }
3067 else
3068 pp_string (buffer, "pragma Convention (C, ");
3069
3070 package_prefix = false;
3071 dump_generic_ada_node
3072 (buffer, TREE_TYPE (type), type, cpp_check, spc, false, true);
3073 package_prefix = true;
3074 pp_character (buffer, ')');
3075
3076 if (is_union)
3077 {
3078 pp_semicolon (buffer);
3079 newline_and_indent (buffer, spc);
3080 pp_string (buffer, "pragma Unchecked_Union (");
3081
3082 dump_generic_ada_node
3083 (buffer, TREE_TYPE (type), type, cpp_check, spc, false, true);
3084 pp_character (buffer, ')');
3085 }
3086
3087 if (bitfield_used)
3088 {
3089 pp_semicolon (buffer);
3090 newline_and_indent (buffer, spc);
3091 pp_string (buffer, "pragma Pack (");
3092 dump_generic_ada_node
3093 (buffer, TREE_TYPE (type), type, cpp_check, spc, false, true);
3094 pp_character (buffer, ')');
3095 bitfield_used = false;
3096 }
3097
3098 print_ada_methods (buffer, node, cpp_check, spc);
3099
3100 /* Print the static fields of the structure, if any. */
3101 need_semicolon = TYPE_METHODS (node) == NULL_TREE;
3102 for (tmp = TYPE_FIELDS (node); tmp; tmp = TREE_CHAIN (tmp))
3103 {
3104 if (DECL_NAME (tmp) && TREE_STATIC (tmp))
3105 {
3106 if (need_semicolon)
3107 {
3108 need_semicolon = false;
3109 pp_semicolon (buffer);
3110 }
3111 pp_newline (buffer);
3112 pp_newline (buffer);
3113 print_ada_declaration (buffer, tmp, type, cpp_check, spc);
3114 }
3115 }
3116 }
3117
3118 /* Dump all the declarations in SOURCE_FILE to an Ada spec.
3119 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3120 nodes for SOURCE_FILE. CPP_CHECK is used to perform C++ queries on
3121 nodes. */
3122
3123 static void
3124 dump_ads (const char *source_file,
3125 void (*collect_all_refs)(const char *),
3126 int (*cpp_check)(tree, cpp_operation))
3127 {
3128 char *ads_name;
3129 char *pkg_name;
3130 char *s;
3131 FILE *f;
3132
3133 pkg_name = get_ada_package (source_file);
3134
3135 /* Construct the the .ads filename and package name. */
3136 ads_name = xstrdup (pkg_name);
3137
3138 for (s = ads_name; *s; s++)
3139 *s = TOLOWER (*s);
3140
3141 ads_name = reconcat (ads_name, ads_name, ".ads", NULL);
3142
3143 /* Write out the .ads file. */
3144 f = fopen (ads_name, "w");
3145 if (f)
3146 {
3147 pretty_printer pp;
3148
3149 pp_construct (&pp, NULL, 0);
3150 pp_needs_newline (&pp) = true;
3151 pp.buffer->stream = f;
3152
3153 /* Dump all relevant macros. */
3154 dump_ada_macros (&pp, source_file);
3155
3156 /* Reset the table of withs for this file. */
3157 reset_ada_withs ();
3158
3159 (*collect_all_refs) (source_file);
3160
3161 /* Dump all references. */
3162 dump_ada_nodes (&pp, source_file, cpp_check);
3163
3164 /* Dump withs. */
3165 dump_ada_withs (f);
3166
3167 fprintf (f, "\npackage %s is\n\n", pkg_name);
3168 pp_write_text_to_stream (&pp);
3169 /* ??? need to free pp */
3170 fprintf (f, "end %s;\n", pkg_name);
3171 fclose (f);
3172 }
3173
3174 free (ads_name);
3175 free (pkg_name);
3176 }
3177
3178 static const char **source_refs = NULL;
3179 static int source_refs_used = 0;
3180 static int source_refs_allocd = 0;
3181
3182 /* Add an entry for FILENAME to the table SOURCE_REFS. */
3183
3184 void
3185 collect_source_ref (const char *filename)
3186 {
3187 int i;
3188
3189 if (!filename)
3190 return;
3191
3192 if (source_refs_allocd == 0)
3193 {
3194 source_refs_allocd = 1024;
3195 source_refs = XNEWVEC (const char *, source_refs_allocd);
3196 }
3197
3198 for (i = 0; i < source_refs_used; i++)
3199 if (filename == source_refs [i])
3200 return;
3201
3202 if (source_refs_used == source_refs_allocd)
3203 {
3204 source_refs_allocd *= 2;
3205 source_refs = XRESIZEVEC (const char *, source_refs, source_refs_allocd);
3206 }
3207
3208 source_refs [source_refs_used++] = filename;
3209 }
3210
3211 /* Main entry point: dump all Ada specs corresponding to SOURCE_REFS
3212 using callbacks COLLECT_ALL_REFS and CPP_CHECK.
3213 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3214 nodes for a given source file.
3215 CPP_CHECK is used to perform C++ queries on nodes, or NULL for the C
3216 front-end. */
3217
3218 void
3219 dump_ada_specs (void (*collect_all_refs)(const char *),
3220 int (*cpp_check)(tree, cpp_operation))
3221 {
3222 int i;
3223
3224 /* Iterate over the list of files to dump specs for */
3225 for (i = 0; i < source_refs_used; i++)
3226 dump_ads (source_refs [i], collect_all_refs, cpp_check);
3227
3228 /* Free files table. */
3229 free (source_refs);
3230 }
GCC graphite test results