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