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