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