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