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