Branch data 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-2025 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 : 336516 : count_ada_macro (cpp_reader *pfile ATTRIBUTE_UNUSED, cpp_hashnode *node,
227 : : void *v ATTRIBUTE_UNUSED)
228 : : {
229 : 336516 : 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 : 336516 : 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 : 336516 : store_ada_macro (cpp_reader *pfile ATTRIBUTE_UNUSED,
245 : : cpp_hashnode *node, void *macros)
246 : : {
247 : 336516 : 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 : 336516 : 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 : 253031 : for (n = t; n; n = TREE_CHAIN (n))
770 : 252773 : if (!DECL_IS_UNDECLARED_BUILTIN (n)
771 : 318 : && TREE_CODE (n) != NAMESPACE_DECL
772 : 253091 : && 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 : 253031 : for (n = t; n; n = TREE_CHAIN (n))
780 : 252773 : if (!DECL_IS_UNDECLARED_BUILTIN (n)
781 : 318 : && TREE_CODE (n) != NAMESPACE_DECL
782 : 253091 : && 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 : 155 : TREE_VISITED (*tp) = 0;
794 : : else
795 : 157 : *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 : 1579 : get_underlying_decl (tree type)
1073 : : {
1074 : 1579 : if (!type)
1075 : : return NULL_TREE;
1076 : :
1077 : : /* type is a declaration. */
1078 : 1479 : if (DECL_P (type))
1079 : : return type;
1080 : :
1081 : 554 : if (TYPE_P (type))
1082 : : {
1083 : : /* Strip qualifiers but do not look through typedefs. */
1084 : 554 : if (TYPE_QUALS_NO_ADDR_SPACE (type))
1085 : 8 : type = TYPE_MAIN_VARIANT (type);
1086 : :
1087 : : /* type is a typedef. */
1088 : 554 : if (TYPE_NAME (type) && DECL_P (TYPE_NAME (type)))
1089 : 311 : return TYPE_NAME (type);
1090 : :
1091 : : /* TYPE_STUB_DECL has been set for type. */
1092 : 243 : if (TYPE_STUB_DECL (type))
1093 : 74 : 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 : && !strcmp (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (node))),
2259 : : "__int128")))
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 : 105 : dump_ada_node (pp, ref_type, ref_type, spc, is_access,
2446 : : true);
2447 : : }
2448 : : }
2449 : : }
2450 : : break;
2451 : :
2452 : 0 : case ARRAY_TYPE:
2453 : 0 : if (name_only)
2454 : 0 : dump_ada_node (pp, TYPE_NAME (node), node, spc, limited_access,
2455 : : true);
2456 : : else
2457 : 0 : dump_ada_array_type (pp, node, spc);
2458 : : break;
2459 : :
2460 : 414 : case RECORD_TYPE:
2461 : 414 : case UNION_TYPE:
2462 : 414 : if (name_only)
2463 : 304 : dump_ada_node (pp, TYPE_NAME (node), node, spc, limited_access,
2464 : : true);
2465 : : else
2466 : 110 : dump_ada_structure (pp, node, type, false, spc);
2467 : : break;
2468 : :
2469 : 82 : case INTEGER_CST:
2470 : : /* We treat the upper half of the sizetype range as negative. This
2471 : : is consistent with the internal treatment and makes it possible
2472 : : to generate the (0 .. -1) range for flexible array members. */
2473 : 82 : if (TREE_TYPE (node) == sizetype)
2474 : 40 : node = fold_convert (ssizetype, node);
2475 : 82 : if (tree_fits_shwi_p (node))
2476 : 82 : pp_wide_integer (pp, tree_to_shwi (node));
2477 : 0 : else if (tree_fits_uhwi_p (node))
2478 : 0 : pp_unsigned_wide_integer (pp, tree_to_uhwi (node));
2479 : : else
2480 : : {
2481 : 0 : wide_int val = wi::to_wide (node);
2482 : 0 : int i;
2483 : 0 : if (wi::neg_p (val))
2484 : : {
2485 : 0 : pp_minus (pp);
2486 : 0 : val = -val;
2487 : : }
2488 : 0 : sprintf (pp_buffer (pp)->m_digit_buffer,
2489 : : "16#%" HOST_WIDE_INT_PRINT "x",
2490 : 0 : val.elt (val.get_len () - 1));
2491 : 0 : for (i = val.get_len () - 2; i >= 0; i--)
2492 : 0 : sprintf (pp_buffer (pp)->m_digit_buffer,
2493 : : HOST_WIDE_INT_PRINT_PADDED_HEX, val.elt (i));
2494 : 0 : pp_string (pp, pp_buffer (pp)->m_digit_buffer);
2495 : 0 : }
2496 : : break;
2497 : :
2498 : : case REAL_CST:
2499 : : case FIXED_CST:
2500 : : case COMPLEX_CST:
2501 : : case STRING_CST:
2502 : : case VECTOR_CST:
2503 : : return 0;
2504 : :
2505 : 577 : case TYPE_DECL:
2506 : 577 : if (DECL_IS_UNDECLARED_BUILTIN (node))
2507 : : {
2508 : : /* Don't print the declaration of built-in types. */
2509 : 0 : if (name_only)
2510 : : {
2511 : : /* If we're in the middle of a declaration, defaults to
2512 : : System.Address. */
2513 : 0 : if (package_prefix)
2514 : : {
2515 : 0 : append_withs ("System", false);
2516 : 0 : pp_string (pp, "System.Address");
2517 : : }
2518 : : else
2519 : 0 : pp_string (pp, "address");
2520 : : }
2521 : : }
2522 : 577 : else if (name_only)
2523 : 465 : dump_ada_decl_name (pp, node, limited_access);
2524 : : else
2525 : : {
2526 : 112 : if (is_tagged_type (TREE_TYPE (node)))
2527 : : {
2528 : 12 : int first = true;
2529 : :
2530 : : /* Look for ancestors. */
2531 : 12 : for (tree fld = TYPE_FIELDS (TREE_TYPE (node));
2532 : 90 : fld;
2533 : 78 : fld = TREE_CHAIN (fld))
2534 : : {
2535 : 78 : if (!DECL_NAME (fld) && is_tagged_type (TREE_TYPE (fld)))
2536 : : {
2537 : 3 : if (first)
2538 : : {
2539 : 3 : pp_string (pp, "limited new ");
2540 : 3 : first = false;
2541 : : }
2542 : : else
2543 : 0 : pp_string (pp, " and ");
2544 : :
2545 : 3 : dump_ada_decl_name (pp, TYPE_NAME (TREE_TYPE (fld)),
2546 : : false);
2547 : : }
2548 : : }
2549 : :
2550 : 15 : pp_string (pp, first ? "tagged limited " : " with ");
2551 : : }
2552 : 100 : else if (has_nontrivial_methods (TREE_TYPE (node)))
2553 : 3 : pp_string (pp, "limited ");
2554 : :
2555 : 112 : dump_ada_node (pp, TREE_TYPE (node), type, spc, false, false);
2556 : : }
2557 : : break;
2558 : :
2559 : 138 : case FUNCTION_DECL:
2560 : 138 : case CONST_DECL:
2561 : 138 : case VAR_DECL:
2562 : 138 : case PARM_DECL:
2563 : 138 : case FIELD_DECL:
2564 : 138 : case NAMESPACE_DECL:
2565 : 138 : dump_ada_decl_name (pp, node, false);
2566 : 138 : break;
2567 : :
2568 : : default:
2569 : : /* Ignore other nodes (e.g. expressions). */
2570 : : return 0;
2571 : : }
2572 : :
2573 : : return 1;
2574 : : }
2575 : :
2576 : : /* Dump in PP NODE's methods. SPC is the indentation level. Return 1 if
2577 : : methods were printed, 0 otherwise. */
2578 : :
2579 : : static int
2580 : 113 : dump_ada_methods (pretty_printer *pp, tree node, int spc)
2581 : : {
2582 : 113 : if (!has_nontrivial_methods (node))
2583 : : return 0;
2584 : :
2585 : 24 : pp_semicolon (pp);
2586 : :
2587 : 24 : int res = 1;
2588 : 183 : for (tree fld = TYPE_FIELDS (node); fld; fld = DECL_CHAIN (fld))
2589 : 159 : if (TREE_CODE (fld) == FUNCTION_DECL)
2590 : : {
2591 : 114 : if (res)
2592 : : {
2593 : 45 : pp_newline (pp);
2594 : 45 : pp_newline (pp);
2595 : : }
2596 : :
2597 : 114 : res = dump_ada_declaration (pp, fld, node, spc);
2598 : : }
2599 : :
2600 : : return 1;
2601 : : }
2602 : :
2603 : : /* Dump in PP a forward declaration for TYPE present inside T.
2604 : : SPC is the indentation level. */
2605 : :
2606 : : static void
2607 : 366 : dump_forward_type (pretty_printer *pp, tree type, tree t, int spc)
2608 : : {
2609 : 416 : tree decl = get_underlying_decl (type);
2610 : :
2611 : : /* Anonymous pointer and function types. */
2612 : 416 : if (!decl)
2613 : : {
2614 : 165 : if (TREE_CODE (type) == POINTER_TYPE)
2615 : 50 : dump_forward_type (pp, TREE_TYPE (type), t, spc);
2616 : 115 : else if (TREE_CODE (type) == FUNCTION_TYPE)
2617 : : {
2618 : 70 : function_args_iterator args_iter;
2619 : 70 : tree arg;
2620 : 70 : dump_forward_type (pp, TREE_TYPE (type), t, spc);
2621 : 219 : FOREACH_FUNCTION_ARGS (type, arg, args_iter)
2622 : 149 : dump_forward_type (pp, arg, t, spc);
2623 : : }
2624 : 115 : return;
2625 : : }
2626 : :
2627 : 251 : if (DECL_IS_UNDECLARED_BUILTIN (decl) || TREE_VISITED (decl))
2628 : : return;
2629 : :
2630 : : /* Forward declarations are only needed within a given file. */
2631 : 24 : if (DECL_SOURCE_FILE (decl) != DECL_SOURCE_FILE (t))
2632 : : return;
2633 : :
2634 : 24 : if (TREE_CODE (type) == FUNCTION_TYPE)
2635 : : return;
2636 : :
2637 : : /* Generate an incomplete type declaration. */
2638 : 24 : pp_string (pp, "type ");
2639 : 24 : dump_ada_node (pp, decl, NULL_TREE, spc, false, true);
2640 : 24 : pp_semicolon (pp);
2641 : 24 : newline_and_indent (pp, spc);
2642 : :
2643 : : /* Only one incomplete declaration is legal for a given type. */
2644 : 24 : TREE_VISITED (decl) = 1;
2645 : : }
2646 : :
2647 : : /* Bitmap of anonymous types already dumped. Anonymous array types are shared
2648 : : throughout the compilation so it needs to be global. */
2649 : :
2650 : : static bitmap dumped_anonymous_types;
2651 : :
2652 : : static void dump_nested_type (pretty_printer *, tree, tree, int);
2653 : :
2654 : : /* Dump in PP anonymous types nested inside T's definition. PARENT is the
2655 : : parent node of T. DUMPED_TYPES is the bitmap of already dumped types. SPC
2656 : : is the indentation level.
2657 : :
2658 : : In C anonymous nested tagged types have no name whereas in C++ they have
2659 : : one. In C their TYPE_DECL is at top level whereas in C++ it is nested.
2660 : : In both languages untagged types (pointers and arrays) have no name.
2661 : : In C++ the nested TYPE_DECLs can come after their associated FIELD_DECL.
2662 : :
2663 : : Therefore, in order to have a common processing for both languages, we
2664 : : disregard anonymous TYPE_DECLs at top level and here we make a first
2665 : : pass on the nested TYPE_DECLs and a second pass on the unnamed types. */
2666 : :
2667 : : static void
2668 : 139 : dump_nested_types (pretty_printer *pp, tree t, int spc)
2669 : : {
2670 : 139 : tree type, field;
2671 : :
2672 : : /* Find possible anonymous pointers/arrays/structs/unions recursively. */
2673 : 139 : type = TREE_TYPE (t);
2674 : 139 : if (!type)
2675 : : return;
2676 : :
2677 : 1280 : for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
2678 : 1141 : if (TREE_CODE (field) == TYPE_DECL
2679 : 147 : && DECL_NAME (field) != DECL_NAME (t)
2680 : 39 : && !DECL_ORIGINAL_TYPE (field)
2681 : 1177 : && TYPE_NAME (TREE_TYPE (field)) != TYPE_NAME (type))
2682 : 36 : dump_nested_type (pp, field, t, spc);
2683 : :
2684 : 1280 : for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
2685 : 1141 : if (TREE_CODE (field) == FIELD_DECL && !TYPE_NAME (TREE_TYPE (field)))
2686 : 53 : dump_nested_type (pp, field, t, spc);
2687 : : }
2688 : :
2689 : : /* Dump in PP the anonymous type of FIELD inside T. SPC is the indentation
2690 : : level. */
2691 : :
2692 : : static void
2693 : 93 : dump_nested_type (pretty_printer *pp, tree field, tree t, int spc)
2694 : : {
2695 : 93 : tree field_type = TREE_TYPE (field);
2696 : 93 : tree decl, tmp;
2697 : :
2698 : 93 : switch (TREE_CODE (field_type))
2699 : : {
2700 : 24 : case POINTER_TYPE:
2701 : 24 : tmp = TREE_TYPE (field_type);
2702 : 24 : dump_forward_type (pp, tmp, t, spc);
2703 : 24 : break;
2704 : :
2705 : 23 : case ARRAY_TYPE:
2706 : : /* Anonymous array types are shared. */
2707 : 23 : if (!bitmap_set_bit (dumped_anonymous_types, TYPE_UID (field_type)))
2708 : : return;
2709 : :
2710 : 23 : tmp = strip_array_types (field_type);
2711 : 23 : decl = get_underlying_decl (tmp);
2712 : 23 : if (decl
2713 : 19 : && !DECL_NAME (decl)
2714 : 4 : && DECL_SOURCE_FILE (decl) == DECL_SOURCE_FILE (t)
2715 : 27 : && !TREE_VISITED (decl))
2716 : : {
2717 : : /* Generate full declaration. */
2718 : 4 : dump_nested_type (pp, decl, t, spc);
2719 : 4 : TREE_VISITED (decl) = 1;
2720 : : }
2721 : 19 : else if (!decl && TREE_CODE (tmp) == POINTER_TYPE)
2722 : 4 : dump_forward_type (pp, TREE_TYPE (tmp), t, spc);
2723 : :
2724 : : /* Special case char arrays. */
2725 : 23 : if (is_char_array (field_type))
2726 : 0 : pp_string (pp, "subtype ");
2727 : : else
2728 : 23 : pp_string (pp, "type ");
2729 : :
2730 : 23 : dump_anonymous_type_name (pp, field_type);
2731 : 23 : pp_string (pp, " is ");
2732 : 23 : dump_ada_array_type (pp, field_type, spc);
2733 : 23 : pp_semicolon (pp);
2734 : 23 : newline_and_indent (pp, spc);
2735 : 23 : break;
2736 : :
2737 : 14 : case ENUMERAL_TYPE:
2738 : 14 : if (is_simple_enum (field_type))
2739 : 7 : pp_string (pp, "type ");
2740 : : else
2741 : 7 : pp_string (pp, "subtype ");
2742 : :
2743 : 14 : if (TYPE_NAME (field_type))
2744 : 12 : dump_ada_node (pp, field_type, NULL_TREE, spc, false, true);
2745 : : else
2746 : 2 : dump_anonymous_type_name (pp, field_type);
2747 : 14 : pp_string (pp, " is ");
2748 : 14 : dump_ada_enum_type (pp, field_type, NULL_TREE, spc);
2749 : 14 : pp_semicolon (pp);
2750 : 14 : newline_and_indent (pp, spc);
2751 : 14 : break;
2752 : :
2753 : 32 : case RECORD_TYPE:
2754 : 32 : case UNION_TYPE:
2755 : 32 : dump_nested_types (pp, field, spc);
2756 : :
2757 : 32 : pp_string (pp, "type ");
2758 : :
2759 : 32 : if (TYPE_NAME (field_type))
2760 : 24 : dump_ada_node (pp, field_type, NULL_TREE, spc, false, true);
2761 : : else
2762 : 8 : dump_anonymous_type_name (pp, field_type);
2763 : :
2764 : 32 : if (TREE_CODE (field_type) == UNION_TYPE)
2765 : 4 : pp_string (pp, " (discr : unsigned := 0)");
2766 : :
2767 : 32 : pp_string (pp, " is ");
2768 : 32 : dump_ada_structure (pp, field_type, t, true, spc);
2769 : 32 : pp_semicolon (pp);
2770 : 32 : newline_and_indent (pp, spc);
2771 : 32 : break;
2772 : :
2773 : : default:
2774 : : break;
2775 : : }
2776 : : }
2777 : :
2778 : : /* Hash table of overloaded names that we cannot support. It is needed even
2779 : : in Ada 2012 because we merge different types, e.g. void * and const void *
2780 : : in System.Address, so we cannot have overloading for them in Ada. */
2781 : :
2782 : : struct overloaded_name_hash {
2783 : : hashval_t hash;
2784 : : tree name;
2785 : : unsigned int n;
2786 : : };
2787 : :
2788 : : struct overloaded_name_hasher : delete_ptr_hash<overloaded_name_hash>
2789 : : {
2790 : 726 : static inline hashval_t hash (overloaded_name_hash *t)
2791 : 726 : { return t->hash; }
2792 : 798 : static inline bool equal (overloaded_name_hash *a, overloaded_name_hash *b)
2793 : 798 : { return a->name == b->name; }
2794 : : };
2795 : :
2796 : : typedef hash_table<overloaded_name_hasher> htable_t;
2797 : :
2798 : : static htable_t *overloaded_names;
2799 : :
2800 : : /* Add an overloaded NAME with N occurrences to TABLE. */
2801 : :
2802 : : static void
2803 : 1260 : add_name (const char *name, unsigned int n, htable_t *table)
2804 : : {
2805 : 1260 : struct overloaded_name_hash in, *h, **slot;
2806 : 1260 : tree id = get_identifier (name);
2807 : 1260 : hashval_t hash = htab_hash_pointer (id);
2808 : 1260 : in.hash = hash;
2809 : 1260 : in.name = id;
2810 : 1260 : slot = table->find_slot_with_hash (&in, hash, INSERT);
2811 : 1260 : h = new overloaded_name_hash;
2812 : 1260 : h->hash = hash;
2813 : 1260 : h->name = id;
2814 : 1260 : h->n = n;
2815 : 1260 : *slot = h;
2816 : 1260 : }
2817 : :
2818 : : /* Initialize the table with the problematic overloaded names. */
2819 : :
2820 : : static htable_t *
2821 : 90 : init_overloaded_names (void)
2822 : : {
2823 : 90 : static const char *names[] =
2824 : : /* The overloaded names from the /usr/include/string.h file. */
2825 : : { "memchr", "rawmemchr", "memrchr", "strchr", "strrchr", "strchrnul",
2826 : : "strpbrk", "strstr", "strcasestr", "index", "rindex", "basename" };
2827 : :
2828 : 90 : htable_t *table = new htable_t (64);
2829 : :
2830 : 1170 : for (unsigned int i = 0; i < ARRAY_SIZE (names); i++)
2831 : 1080 : add_name (names[i], 0, table);
2832 : :
2833 : : /* Consider that sigaction() is overloaded by struct sigaction for QNX. */
2834 : 90 : add_name ("sigaction", 1, table);
2835 : :
2836 : : /* Consider that stat() is overloaded by struct stat for QNX. */
2837 : 90 : add_name ("stat", 1, table);
2838 : :
2839 : 90 : return table;
2840 : : }
2841 : :
2842 : : /* Return the overloading index of NAME or 0 if NAME is not overloaded. */
2843 : :
2844 : : static unsigned int
2845 : 95 : overloading_index (tree name)
2846 : : {
2847 : 95 : struct overloaded_name_hash in, *h;
2848 : 95 : hashval_t hash = htab_hash_pointer (name);
2849 : 95 : in.hash = hash;
2850 : 95 : in.name = name;
2851 : 95 : h = overloaded_names->find_with_hash (&in, hash);
2852 : 95 : return h ? ++h->n : 0;
2853 : : }
2854 : :
2855 : : /* Dump in PP constructor spec corresponding to T for TYPE. */
2856 : :
2857 : : static void
2858 : 24 : print_constructor (pretty_printer *pp, tree t, tree type)
2859 : : {
2860 : 24 : tree decl_name = DECL_NAME (TYPE_NAME (type));
2861 : :
2862 : 24 : pp_string (pp, "New_");
2863 : 24 : pp_ada_tree_identifier (pp, decl_name, t, false);
2864 : 24 : }
2865 : :
2866 : : /* Dump in PP destructor spec corresponding to T. */
2867 : :
2868 : : static void
2869 : 0 : print_destructor (pretty_printer *pp, tree t, tree type)
2870 : : {
2871 : 0 : tree decl_name = DECL_NAME (TYPE_NAME (type));
2872 : :
2873 : 0 : pp_string (pp, "Delete_");
2874 : 0 : if (startswith (IDENTIFIER_POINTER (DECL_NAME (t)), "__dt_del"))
2875 : 0 : pp_string (pp, "And_Free_");
2876 : 0 : pp_ada_tree_identifier (pp, decl_name, t, false);
2877 : 0 : }
2878 : :
2879 : : /* Dump in PP assignment operator spec corresponding to T. */
2880 : :
2881 : : static void
2882 : 0 : print_assignment_operator (pretty_printer *pp, tree t, tree type)
2883 : : {
2884 : 0 : tree decl_name = DECL_NAME (TYPE_NAME (type));
2885 : :
2886 : 0 : pp_string (pp, "Assign_");
2887 : 0 : pp_ada_tree_identifier (pp, decl_name, t, false);
2888 : 0 : }
2889 : :
2890 : : /* Return the name of type T. */
2891 : :
2892 : : static const char *
2893 : 56 : type_name (tree t)
2894 : : {
2895 : 56 : tree n = TYPE_NAME (t);
2896 : :
2897 : 56 : if (TREE_CODE (n) == IDENTIFIER_NODE)
2898 : 4 : return IDENTIFIER_POINTER (n);
2899 : : else
2900 : 52 : return IDENTIFIER_POINTER (DECL_NAME (n));
2901 : : }
2902 : :
2903 : : /* Dump in PP the declaration of object T of type TYPE in Ada syntax.
2904 : : SPC is the indentation level. Return 1 if a declaration was printed,
2905 : : 0 otherwise. */
2906 : :
2907 : : static int
2908 : 553 : dump_ada_declaration (pretty_printer *pp, tree t, tree type, int spc)
2909 : : {
2910 : 553 : bool is_var = false;
2911 : 553 : bool need_indent = false;
2912 : 553 : bool is_class = false;
2913 : 553 : tree name = TYPE_NAME (TREE_TYPE (t));
2914 : 553 : tree decl_name = DECL_NAME (t);
2915 : 553 : tree orig = NULL_TREE;
2916 : :
2917 : 553 : if (cpp_check && cpp_check (t, IS_TEMPLATE))
2918 : 9 : return dump_ada_template (pp, t, spc);
2919 : :
2920 : : /* Skip enumeral values: will be handled as part of the type itself. */
2921 : 544 : if (TREE_CODE (t) == CONST_DECL && TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE)
2922 : : return 0;
2923 : :
2924 : 504 : if (TREE_CODE (t) == TYPE_DECL)
2925 : : {
2926 : 175 : orig = DECL_ORIGINAL_TYPE (t);
2927 : :
2928 : : /* This is a typedef. */
2929 : 175 : if (orig && TYPE_STUB_DECL (orig))
2930 : : {
2931 : 22 : tree stub = TYPE_STUB_DECL (orig);
2932 : :
2933 : : /* If this is a typedef of a named type, then output it as a subtype
2934 : : declaration. ??? Use a derived type declaration instead. */
2935 : 22 : if (TYPE_NAME (orig))
2936 : : {
2937 : : /* If the types have the same name (ignoring casing), then ignore
2938 : : the second type, but forward declare the first if need be. */
2939 : 20 : if (type_name (orig) == type_name (TREE_TYPE (t))
2940 : 20 : || !strcasecmp (type_name (orig), type_name (TREE_TYPE (t))))
2941 : : {
2942 : 4 : if (RECORD_OR_UNION_TYPE_P (orig) && !TREE_VISITED (stub))
2943 : : {
2944 : 0 : INDENT (spc);
2945 : 0 : dump_forward_type (pp, orig, t, 0);
2946 : : }
2947 : :
2948 : 4 : TREE_VISITED (t) = 1;
2949 : 4 : return 0;
2950 : : }
2951 : :
2952 : 64 : INDENT (spc);
2953 : :
2954 : 16 : if (RECORD_OR_UNION_TYPE_P (orig) && !TREE_VISITED (stub))
2955 : 4 : dump_forward_type (pp, orig, t, spc);
2956 : :
2957 : 16 : pp_string (pp, "subtype ");
2958 : 16 : dump_ada_node (pp, t, type, spc, false, true);
2959 : 16 : pp_string (pp, " is ");
2960 : 16 : dump_ada_node (pp, orig, type, spc, false, true);
2961 : 16 : pp_string (pp, "; -- ");
2962 : 16 : dump_sloc (pp, t);
2963 : :
2964 : 16 : TREE_VISITED (t) = 1;
2965 : 16 : return 1;
2966 : : }
2967 : :
2968 : : /* This is a typedef of an anonymous type. We'll output the full
2969 : : type declaration of the anonymous type with the typedef'ed name
2970 : : below. Prevent forward declarations for the anonymous type to
2971 : : be emitted from now on. */
2972 : 2 : TREE_VISITED (stub) = 1;
2973 : : }
2974 : :
2975 : : /* Skip unnamed or anonymous structs/unions/enum types. */
2976 : 155 : if (!orig
2977 : 145 : && (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t))
2978 : 19 : || TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE)
2979 : 145 : && !decl_name
2980 : 300 : && !name)
2981 : : return 0;
2982 : :
2983 : : /* Skip duplicates of structs/unions/enum types built in C++. */
2984 : 141 : if (!orig
2985 : 131 : && (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t))
2986 : 15 : || TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE)
2987 : 131 : && decl_name
2988 : 249 : && (*IDENTIFIER_POINTER (decl_name) == '.'
2989 : 96 : || *IDENTIFIER_POINTER (decl_name) == '$'))
2990 : : return 0;
2991 : :
2992 : 516 : INDENT (spc);
2993 : :
2994 : 129 : switch (TREE_CODE (TREE_TYPE (t)))
2995 : : {
2996 : 111 : case RECORD_TYPE:
2997 : 111 : case UNION_TYPE:
2998 : 111 : if (!COMPLETE_TYPE_P (TREE_TYPE (t)))
2999 : : {
3000 : 4 : pp_string (pp, "type ");
3001 : 4 : dump_ada_node (pp, t, type, spc, false, true);
3002 : 4 : pp_string (pp, " is null record; -- incomplete struct");
3003 : 4 : TREE_VISITED (t) = 1;
3004 : 4 : return 1;
3005 : : }
3006 : :
3007 : : /* Packed record layout is not fully supported. */
3008 : 107 : if (TYPE_PACKED (TREE_TYPE (t)))
3009 : : {
3010 : 4 : warning_at (DECL_SOURCE_LOCATION (t), 0, "packed layout");
3011 : 4 : pp_string (pp, "pragma Compile_Time_Warning (True, ");
3012 : 4 : pp_string (pp, "\"packed layout may be incorrect\");");
3013 : 4 : newline_and_indent (pp, spc);
3014 : 4 : packed_layout = true;
3015 : : }
3016 : :
3017 : 107 : if (orig && TYPE_NAME (orig))
3018 : 0 : pp_string (pp, "subtype ");
3019 : : else
3020 : : {
3021 : 107 : if (separate_class_package (t))
3022 : : {
3023 : 18 : is_class = true;
3024 : 18 : pp_string (pp, "package Class_");
3025 : 18 : dump_ada_node (pp, t, type, spc, false, true);
3026 : 18 : pp_string (pp, " is");
3027 : 18 : spc += INDENT_INCR;
3028 : 18 : newline_and_indent (pp, spc);
3029 : : }
3030 : :
3031 : 107 : dump_nested_types (pp, t, spc);
3032 : :
3033 : 107 : pp_string (pp, "type ");
3034 : : }
3035 : : break;
3036 : :
3037 : 8 : case POINTER_TYPE:
3038 : 8 : case REFERENCE_TYPE:
3039 : 8 : dump_forward_type (pp, TREE_TYPE (TREE_TYPE (t)), t, spc);
3040 : 8 : if (orig && TYPE_NAME (orig))
3041 : 0 : pp_string (pp, "subtype ");
3042 : : else
3043 : 8 : pp_string (pp, "type ");
3044 : : break;
3045 : :
3046 : 0 : case ARRAY_TYPE:
3047 : 0 : if ((orig && TYPE_NAME (orig)) || is_char_array (TREE_TYPE (t)))
3048 : 0 : pp_string (pp, "subtype ");
3049 : : else
3050 : 0 : pp_string (pp, "type ");
3051 : : break;
3052 : :
3053 : 0 : case FUNCTION_TYPE:
3054 : 0 : pp_string (pp, "-- skipped function type ");
3055 : 0 : dump_ada_node (pp, t, type, spc, false, true);
3056 : 0 : return 1;
3057 : :
3058 : 10 : case ENUMERAL_TYPE:
3059 : 1 : if ((orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
3060 : 11 : || !is_simple_enum (TREE_TYPE (t)))
3061 : 5 : pp_string (pp, "subtype ");
3062 : : else
3063 : 5 : pp_string (pp, "type ");
3064 : : break;
3065 : :
3066 : 0 : default:
3067 : 0 : pp_string (pp, "subtype ");
3068 : : }
3069 : :
3070 : 125 : TREE_VISITED (t) = 1;
3071 : : }
3072 : : else
3073 : : {
3074 : 329 : if (VAR_P (t)
3075 : 29 : && decl_name
3076 : 358 : && *IDENTIFIER_POINTER (decl_name) == '_')
3077 : : return 0;
3078 : :
3079 : : need_indent = true;
3080 : : }
3081 : :
3082 : : /* Print the type and name. */
3083 : 439 : if (TREE_CODE (TREE_TYPE (t)) == ARRAY_TYPE)
3084 : : {
3085 : 23 : if (need_indent)
3086 : 161 : INDENT (spc);
3087 : :
3088 : : /* Print variable's name. */
3089 : 23 : dump_ada_node (pp, t, type, spc, false, true);
3090 : :
3091 : 23 : if (TREE_CODE (t) == TYPE_DECL)
3092 : : {
3093 : 0 : pp_string (pp, " is ");
3094 : :
3095 : 0 : if (orig && TYPE_NAME (orig))
3096 : 0 : dump_ada_node (pp, TYPE_NAME (orig), type, spc, false, true);
3097 : : else
3098 : 0 : dump_ada_array_type (pp, TREE_TYPE (t), spc);
3099 : : }
3100 : : else
3101 : : {
3102 : 23 : if (spc == INDENT_INCR || TREE_STATIC (t))
3103 : 0 : is_var = true;
3104 : :
3105 : 23 : pp_string (pp, " : ");
3106 : :
3107 : 23 : if (TREE_CODE (TREE_TYPE (TREE_TYPE (t))) != POINTER_TYPE
3108 : 23 : && !packed_layout)
3109 : 19 : pp_string (pp, "aliased ");
3110 : :
3111 : 23 : if (TYPE_NAME (TREE_TYPE (t)))
3112 : 0 : dump_ada_node (pp, TREE_TYPE (t), type, spc, false, true);
3113 : 23 : else if (type)
3114 : 23 : dump_anonymous_type_name (pp, TREE_TYPE (t));
3115 : : else
3116 : 0 : dump_ada_array_type (pp, TREE_TYPE (t), spc);
3117 : : }
3118 : : }
3119 : 416 : else if (TREE_CODE (t) == FUNCTION_DECL)
3120 : : {
3121 : 176 : tree decl_name = DECL_NAME (t);
3122 : 176 : bool is_abstract_class = false;
3123 : 176 : bool is_method = TREE_CODE (TREE_TYPE (t)) == METHOD_TYPE;
3124 : 176 : bool is_abstract = false;
3125 : 176 : bool is_assignment_operator = false;
3126 : 176 : bool is_constructor = false;
3127 : 176 : bool is_destructor = false;
3128 : 176 : bool is_copy_constructor = false;
3129 : 176 : bool is_move_constructor = false;
3130 : :
3131 : 176 : if (!decl_name)
3132 : : return 0;
3133 : :
3134 : 176 : if (cpp_check)
3135 : : {
3136 : 165 : is_abstract = cpp_check (t, IS_ABSTRACT);
3137 : 165 : is_assignment_operator = cpp_check (t, IS_ASSIGNMENT_OPERATOR);
3138 : 165 : is_constructor = cpp_check (t, IS_CONSTRUCTOR);
3139 : 165 : is_destructor = cpp_check (t, IS_DESTRUCTOR);
3140 : 165 : is_copy_constructor = cpp_check (t, IS_COPY_CONSTRUCTOR);
3141 : 165 : is_move_constructor = cpp_check (t, IS_MOVE_CONSTRUCTOR);
3142 : : }
3143 : :
3144 : : /* Skip copy constructors and C++11 move constructors: some are internal
3145 : : only and those that are not cannot be called easily from Ada. */
3146 : 165 : if (is_copy_constructor || is_move_constructor)
3147 : : return 0;
3148 : :
3149 : 146 : if (is_constructor || is_destructor)
3150 : : {
3151 : : /* ??? Skip implicit constructors/destructors for now. */
3152 : 51 : if (DECL_ARTIFICIAL (t))
3153 : : return 0;
3154 : :
3155 : : /* Only consider complete constructors and deleting destructors. */
3156 : 36 : if (!startswith (IDENTIFIER_POINTER (decl_name), "__ct_comp")
3157 : 24 : && !startswith (IDENTIFIER_POINTER (decl_name), "__dt_comp")
3158 : 60 : && !startswith (IDENTIFIER_POINTER (decl_name), "__dt_del"))
3159 : : return 0;
3160 : : }
3161 : :
3162 : 95 : else if (is_assignment_operator)
3163 : : {
3164 : : /* ??? Skip implicit or non-method assignment operators for now. */
3165 : 0 : if (DECL_ARTIFICIAL (t) || !is_method)
3166 : : return 0;
3167 : : }
3168 : :
3169 : : /* If this function has an entry in the vtable, we cannot omit it. */
3170 : 169 : else if (!DECL_VINDEX (t) && *IDENTIFIER_POINTER (decl_name) == '_')
3171 : : {
3172 : 0 : INDENT (spc);
3173 : 0 : pp_string (pp, "-- skipped func ");
3174 : 0 : pp_string (pp, IDENTIFIER_POINTER (decl_name));
3175 : 0 : return 1;
3176 : : }
3177 : :
3178 : 563 : INDENT (spc);
3179 : :
3180 : 107 : dump_forward_type (pp, TREE_TYPE (t), t, spc);
3181 : :
3182 : 107 : if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t))) && !is_constructor)
3183 : 18 : pp_string (pp, "procedure ");
3184 : : else
3185 : 89 : pp_string (pp, "function ");
3186 : :
3187 : 107 : if (is_constructor)
3188 : 12 : print_constructor (pp, t, type);
3189 : 95 : else if (is_destructor)
3190 : 0 : print_destructor (pp, t, type);
3191 : 95 : else if (is_assignment_operator)
3192 : 0 : print_assignment_operator (pp, t, type);
3193 : : else
3194 : : {
3195 : 95 : const unsigned int suffix = overloading_index (decl_name);
3196 : 95 : pp_ada_tree_identifier (pp, decl_name, t, false);
3197 : 95 : if (suffix > 1)
3198 : 0 : pp_decimal_int (pp, suffix);
3199 : : }
3200 : :
3201 : 107 : dump_ada_function_declaration
3202 : 107 : (pp, t, is_method, is_constructor, is_destructor, spc);
3203 : :
3204 : 107 : if (is_constructor && RECORD_OR_UNION_TYPE_P (type))
3205 : 105 : for (tree fld = TYPE_FIELDS (type); fld; fld = DECL_CHAIN (fld))
3206 : 93 : if (TREE_CODE (fld) == FUNCTION_DECL && cpp_check (fld, IS_ABSTRACT))
3207 : : {
3208 : : is_abstract_class = true;
3209 : : break;
3210 : : }
3211 : :
3212 : 107 : if (is_abstract || is_abstract_class)
3213 : 3 : pp_string (pp, " is abstract");
3214 : :
3215 : 107 : if (is_abstract || !DECL_ASSEMBLER_NAME (t))
3216 : : {
3217 : 3 : pp_semicolon (pp);
3218 : 3 : pp_string (pp, " -- ");
3219 : 3 : dump_sloc (pp, t);
3220 : : }
3221 : 104 : else if (is_constructor)
3222 : : {
3223 : 12 : pp_semicolon (pp);
3224 : 12 : pp_string (pp, " -- ");
3225 : 12 : dump_sloc (pp, t);
3226 : :
3227 : 12 : newline_and_indent (pp, spc);
3228 : 12 : pp_string (pp, "pragma CPP_Constructor (");
3229 : 12 : print_constructor (pp, t, type);
3230 : 12 : pp_string (pp, ", \"");
3231 : 12 : pp_asm_name (pp, t);
3232 : 12 : pp_string (pp, "\");");
3233 : : }
3234 : : else
3235 : : {
3236 : 92 : pp_string (pp, " -- ");
3237 : 92 : dump_sloc (pp, t);
3238 : :
3239 : 92 : newline_and_indent (pp, spc);
3240 : 92 : dump_ada_import (pp, t, spc);
3241 : : }
3242 : :
3243 : 107 : return 1;
3244 : : }
3245 : 240 : else if (TREE_CODE (t) == TYPE_DECL && !orig)
3246 : : {
3247 : 115 : bool is_interface = false;
3248 : 115 : bool is_abstract_record = false;
3249 : :
3250 : : /* Anonymous structs/unions. */
3251 : 115 : dump_ada_node (pp, TREE_TYPE (t), t, spc, false, true);
3252 : :
3253 : 115 : if (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE)
3254 : 0 : pp_string (pp, " (discr : unsigned := 0)");
3255 : :
3256 : 115 : pp_string (pp, " is ");
3257 : :
3258 : : /* Check whether we have an Ada interface compatible class.
3259 : : That is only have a vtable non-static data member and no
3260 : : non-abstract methods. */
3261 : 115 : if (cpp_check
3262 : 115 : && RECORD_OR_UNION_TYPE_P (TREE_TYPE (t)))
3263 : : {
3264 : 87 : bool has_fields = false;
3265 : :
3266 : : /* Check that there are no fields other than the virtual table. */
3267 : 87 : for (tree fld = TYPE_FIELDS (TREE_TYPE (t));
3268 : 960 : fld;
3269 : 873 : fld = TREE_CHAIN (fld))
3270 : : {
3271 : 873 : if (TREE_CODE (fld) == FIELD_DECL)
3272 : : {
3273 : 87 : if (!has_fields && DECL_VIRTUAL_P (fld))
3274 : : is_interface = true;
3275 : : else
3276 : : is_interface = false;
3277 : : has_fields = true;
3278 : : }
3279 : 786 : else if (TREE_CODE (fld) == FUNCTION_DECL
3280 : 786 : && !DECL_ARTIFICIAL (fld))
3281 : : {
3282 : 57 : if (cpp_check (fld, IS_ABSTRACT))
3283 : : is_abstract_record = true;
3284 : : else
3285 : 54 : is_interface = false;
3286 : : }
3287 : : }
3288 : : }
3289 : :
3290 : 115 : TREE_VISITED (t) = 1;
3291 : 115 : if (is_interface)
3292 : : {
3293 : 3 : pp_string (pp, "limited interface -- ");
3294 : 3 : dump_sloc (pp, t);
3295 : 3 : newline_and_indent (pp, spc);
3296 : 3 : pp_string (pp, "with Import => True,");
3297 : 3 : newline_and_indent (pp, spc + 5);
3298 : 3 : pp_string (pp, "Convention => CPP");
3299 : :
3300 : 3 : dump_ada_methods (pp, TREE_TYPE (t), spc);
3301 : : }
3302 : : else
3303 : : {
3304 : 112 : if (is_abstract_record)
3305 : 0 : pp_string (pp, "abstract ");
3306 : 112 : dump_ada_node (pp, t, t, spc, false, false);
3307 : : }
3308 : : }
3309 : : else
3310 : : {
3311 : 125 : if (need_indent)
3312 : 805 : INDENT (spc);
3313 : :
3314 : 125 : if ((TREE_CODE (t) == FIELD_DECL || VAR_P (t))
3315 : 125 : && DECL_NAME (t))
3316 : 115 : check_type_name_conflict (pp, t);
3317 : :
3318 : : /* Print variable/type's name. */
3319 : 125 : dump_ada_node (pp, t, t, spc, false, true);
3320 : :
3321 : 125 : if (TREE_CODE (t) == TYPE_DECL)
3322 : : {
3323 : 10 : const bool is_subtype = TYPE_NAME (orig);
3324 : :
3325 : 10 : if (!is_subtype && TREE_CODE (TREE_TYPE (t)) == UNION_TYPE)
3326 : 0 : pp_string (pp, " (discr : unsigned := 0)");
3327 : :
3328 : 10 : pp_string (pp, " is ");
3329 : :
3330 : 10 : dump_ada_node (pp, orig, t, spc, false, is_subtype);
3331 : : }
3332 : : else
3333 : : {
3334 : 115 : if (spc == INDENT_INCR || TREE_STATIC (t))
3335 : 14 : is_var = true;
3336 : :
3337 : 115 : pp_string (pp, " : ");
3338 : :
3339 : 115 : if (TREE_CODE (TREE_TYPE (t)) != POINTER_TYPE
3340 : 103 : && (TYPE_NAME (TREE_TYPE (t))
3341 : 8 : || (TREE_CODE (TREE_TYPE (t)) != INTEGER_TYPE
3342 : 8 : && TREE_CODE (TREE_TYPE (t)) != ENUMERAL_TYPE))
3343 : 215 : && !packed_layout)
3344 : 92 : pp_string (pp, "aliased ");
3345 : :
3346 : 115 : if (TREE_READONLY (t) && TREE_CODE (t) != FIELD_DECL)
3347 : 0 : pp_string (pp, "constant ");
3348 : :
3349 : 115 : if (TYPE_NAME (TREE_TYPE (t))
3350 : 115 : || (!RECORD_OR_UNION_TYPE_P (TREE_TYPE (t))
3351 : 15 : && TREE_CODE (TREE_TYPE (t)) != ENUMERAL_TYPE))
3352 : 107 : dump_ada_node (pp, TREE_TYPE (t), t, spc, false, true);
3353 : 8 : else if (type)
3354 : 6 : dump_anonymous_type_name (pp, TREE_TYPE (t));
3355 : : }
3356 : : }
3357 : :
3358 : 263 : if (is_class)
3359 : : {
3360 : 18 : spc -= INDENT_INCR;
3361 : 18 : newline_and_indent (pp, spc);
3362 : 18 : pp_string (pp, "end;");
3363 : 18 : newline_and_indent (pp, spc);
3364 : 18 : pp_string (pp, "use Class_");
3365 : 18 : dump_ada_node (pp, t, type, spc, false, true);
3366 : 18 : pp_semicolon (pp);
3367 : 18 : pp_newline (pp);
3368 : :
3369 : : /* All needed indentation/newline performed already, so return 0. */
3370 : 18 : return 0;
3371 : : }
3372 : 245 : else if (is_var)
3373 : : {
3374 : 14 : pp_string (pp, " -- ");
3375 : 14 : dump_sloc (pp, t);
3376 : 14 : newline_and_indent (pp, spc);
3377 : 14 : dump_ada_import (pp, t, spc);
3378 : : }
3379 : :
3380 : : else
3381 : : {
3382 : 231 : pp_string (pp, "; -- ");
3383 : 231 : dump_sloc (pp, t);
3384 : : }
3385 : :
3386 : : return 1;
3387 : : }
3388 : :
3389 : : /* Dump in PP a structure NODE of type TYPE in Ada syntax. If NESTED is
3390 : : true, it's an anonymous nested type. SPC is the indentation level. */
3391 : :
3392 : : static void
3393 : 142 : dump_ada_structure (pretty_printer *pp, tree node, tree type, bool nested,
3394 : : int spc)
3395 : : {
3396 : 142 : const bool is_union = (TREE_CODE (node) == UNION_TYPE);
3397 : 142 : char buf[32];
3398 : 142 : int field_num = 0;
3399 : 142 : int field_spc = spc + INDENT_INCR;
3400 : 142 : int need_semicolon;
3401 : :
3402 : 142 : bitfield_used = false;
3403 : :
3404 : : /* Print the contents of the structure. */
3405 : 142 : pp_string (pp, "record");
3406 : :
3407 : 142 : if (is_union)
3408 : : {
3409 : 4 : newline_and_indent (pp, spc + INDENT_INCR);
3410 : 4 : pp_string (pp, "case discr is");
3411 : 4 : field_spc = spc + INDENT_INCR * 3;
3412 : : }
3413 : :
3414 : 142 : pp_newline (pp);
3415 : :
3416 : : /* Print the non-static fields of the structure. */
3417 : 1319 : for (tree tmp = TYPE_FIELDS (node); tmp; tmp = TREE_CHAIN (tmp))
3418 : : {
3419 : : /* Add parent field if needed. */
3420 : 1177 : if (!DECL_NAME (tmp))
3421 : : {
3422 : 3 : if (!is_tagged_type (TREE_TYPE (tmp)))
3423 : : {
3424 : 0 : if (!TYPE_NAME (TREE_TYPE (tmp)))
3425 : 0 : dump_ada_declaration (pp, tmp, type, field_spc);
3426 : : else
3427 : : {
3428 : 0 : INDENT (field_spc);
3429 : :
3430 : 0 : if (field_num == 0)
3431 : 0 : pp_string (pp, "parent : aliased ");
3432 : : else
3433 : : {
3434 : 0 : sprintf (buf, "field_%d : aliased ", field_num + 1);
3435 : 0 : pp_string (pp, buf);
3436 : : }
3437 : 0 : dump_ada_decl_name (pp, TYPE_NAME (TREE_TYPE (tmp)),
3438 : : false);
3439 : 0 : pp_semicolon (pp);
3440 : : }
3441 : :
3442 : 0 : pp_newline (pp);
3443 : 0 : field_num++;
3444 : : }
3445 : : }
3446 : 1174 : else if (TREE_CODE (tmp) == FIELD_DECL)
3447 : : {
3448 : : /* Skip internal virtual table field. */
3449 : 133 : if (!DECL_VIRTUAL_P (tmp))
3450 : : {
3451 : 124 : if (is_union)
3452 : : {
3453 : 4 : if (TREE_CHAIN (tmp)
3454 : 3 : && TREE_TYPE (TREE_CHAIN (tmp)) != node
3455 : 7 : && TREE_CODE (TREE_CHAIN (tmp)) != TYPE_DECL)
3456 : 0 : sprintf (buf, "when %d =>", field_num);
3457 : : else
3458 : 4 : sprintf (buf, "when others =>");
3459 : :
3460 : 40 : INDENT (spc + INDENT_INCR * 2);
3461 : 4 : pp_string (pp, buf);
3462 : 4 : pp_newline (pp);
3463 : : }
3464 : :
3465 : 124 : if (dump_ada_declaration (pp, tmp, type, field_spc))
3466 : : {
3467 : 124 : pp_newline (pp);
3468 : 124 : field_num++;
3469 : : }
3470 : : }
3471 : : }
3472 : : }
3473 : :
3474 : 142 : if (is_union)
3475 : : {
3476 : 28 : INDENT (spc + INDENT_INCR);
3477 : 4 : pp_string (pp, "end case;");
3478 : 4 : pp_newline (pp);
3479 : : }
3480 : :
3481 : 142 : if (field_num == 0)
3482 : : {
3483 : 257 : INDENT (spc + INDENT_INCR);
3484 : 29 : pp_string (pp, "null;");
3485 : 29 : pp_newline (pp);
3486 : : }
3487 : :
3488 : 631 : INDENT (spc);
3489 : 142 : pp_string (pp, "end record");
3490 : :
3491 : 142 : newline_and_indent (pp, spc);
3492 : :
3493 : : /* We disregard the methods for anonymous nested types. */
3494 : 142 : if (has_nontrivial_methods (node) && !nested)
3495 : : {
3496 : 21 : pp_string (pp, "with Import => True,");
3497 : 21 : newline_and_indent (pp, spc + 5);
3498 : 21 : pp_string (pp, "Convention => CPP");
3499 : : }
3500 : : else
3501 : 121 : pp_string (pp, "with Convention => C_Pass_By_Copy");
3502 : :
3503 : 142 : if (is_union)
3504 : : {
3505 : 4 : pp_comma (pp);
3506 : 4 : newline_and_indent (pp, spc + 5);
3507 : 4 : pp_string (pp, "Unchecked_Union => True");
3508 : : }
3509 : :
3510 : 142 : if (bitfield_used || packed_layout)
3511 : : {
3512 : 4 : char buf[32];
3513 : 4 : pp_comma (pp);
3514 : 4 : newline_and_indent (pp, spc + 5);
3515 : 4 : pp_string (pp, "Pack => True");
3516 : 4 : pp_comma (pp);
3517 : 4 : newline_and_indent (pp, spc + 5);
3518 : 4 : sprintf (buf, "Alignment => %d", TYPE_ALIGN (node) / BITS_PER_UNIT);
3519 : 4 : pp_string (pp, buf);
3520 : 4 : bitfield_used = false;
3521 : 4 : packed_layout = false;
3522 : : }
3523 : :
3524 : 142 : if (nested)
3525 : 32 : return;
3526 : :
3527 : 110 : need_semicolon = !dump_ada_methods (pp, node, spc);
3528 : :
3529 : : /* Print the static fields of the structure, if any. */
3530 : 1045 : for (tree tmp = TYPE_FIELDS (node); tmp; tmp = TREE_CHAIN (tmp))
3531 : : {
3532 : 935 : if (VAR_P (tmp) && DECL_NAME (tmp))
3533 : : {
3534 : 3 : if (need_semicolon)
3535 : : {
3536 : 0 : need_semicolon = false;
3537 : 0 : pp_semicolon (pp);
3538 : : }
3539 : 3 : pp_newline (pp);
3540 : 3 : pp_newline (pp);
3541 : 3 : dump_ada_declaration (pp, tmp, type, spc);
3542 : : }
3543 : : }
3544 : : }
3545 : :
3546 : : /* Dump all the declarations in SOURCE_FILE to an Ada spec.
3547 : : COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3548 : : nodes for SOURCE_FILE. CHECK is used to perform C++ queries on nodes. */
3549 : :
3550 : : static void
3551 : 90 : dump_ads (const char *source_file,
3552 : : void (*collect_all_refs)(const char *),
3553 : : int (*check)(tree, cpp_operation))
3554 : : {
3555 : 90 : char *ads_name;
3556 : 90 : char *pkg_name;
3557 : 90 : char *s;
3558 : 90 : FILE *f;
3559 : :
3560 : 90 : pkg_name = get_ada_package (source_file);
3561 : :
3562 : : /* Construct the .ads filename and package name. */
3563 : 90 : ads_name = xstrdup (pkg_name);
3564 : :
3565 : 1737 : for (s = ads_name; *s; s++)
3566 : 1557 : if (*s == '.')
3567 : 0 : *s = '-';
3568 : : else
3569 : 1557 : *s = TOLOWER (*s);
3570 : :
3571 : 90 : ads_name = reconcat (ads_name, ads_name, ".ads", NULL);
3572 : :
3573 : : /* Write out the .ads file. */
3574 : 90 : f = fopen (ads_name, "w");
3575 : 90 : if (f)
3576 : : {
3577 : 90 : pretty_printer pp;
3578 : :
3579 : 90 : pp_needs_newline (&pp) = true;
3580 : 90 : pp.set_output_stream (f);
3581 : :
3582 : : /* Dump all relevant macros. */
3583 : 90 : dump_ada_macros (&pp, source_file);
3584 : :
3585 : : /* Reset the table of withs for this file. */
3586 : 90 : reset_ada_withs ();
3587 : :
3588 : 90 : (*collect_all_refs) (source_file);
3589 : :
3590 : : /* Dump all references. */
3591 : 90 : cpp_check = check;
3592 : 90 : dump_ada_nodes (&pp, source_file);
3593 : :
3594 : : /* We require Ada 2012 syntax, so generate corresponding pragma. */
3595 : 90 : fputs ("pragma Ada_2012;\n\n", f);
3596 : :
3597 : : /* Disable style checks and warnings on unused entities since this file
3598 : : is auto-generated and always has a with clause for Interfaces.C. */
3599 : 90 : fputs ("pragma Style_Checks (Off);\n", f);
3600 : 90 : fputs ("pragma Warnings (Off, \"-gnatwu\");\n\n", f);
3601 : :
3602 : : /* Dump withs. */
3603 : 90 : dump_ada_withs (f);
3604 : :
3605 : 90 : fprintf (f, "\npackage %s is\n\n", pkg_name);
3606 : 90 : pp_write_text_to_stream (&pp);
3607 : : /* ??? need to free pp */
3608 : 90 : fprintf (f, "end %s;\n\n", pkg_name);
3609 : :
3610 : 90 : fputs ("pragma Style_Checks (On);\n", f);
3611 : 90 : fputs ("pragma Warnings (On, \"-gnatwu\");\n", f);
3612 : 90 : fclose (f);
3613 : 90 : }
3614 : :
3615 : 90 : free (ads_name);
3616 : 90 : free (pkg_name);
3617 : 90 : }
3618 : :
3619 : : static const char **source_refs = NULL;
3620 : : static int source_refs_used = 0;
3621 : : static int source_refs_allocd = 0;
3622 : :
3623 : : /* Add an entry for FILENAME to the table SOURCE_REFS. */
3624 : :
3625 : : void
3626 : 405 : collect_source_ref (const char *filename)
3627 : : {
3628 : 405 : int i;
3629 : :
3630 : 405 : if (!filename)
3631 : : return;
3632 : :
3633 : 405 : if (source_refs_allocd == 0)
3634 : : {
3635 : 90 : source_refs_allocd = 1024;
3636 : 90 : source_refs = XNEWVEC (const char *, source_refs_allocd);
3637 : : }
3638 : :
3639 : 405 : for (i = 0; i < source_refs_used; i++)
3640 : 315 : if (filename == source_refs[i])
3641 : : return;
3642 : :
3643 : 90 : if (source_refs_used == source_refs_allocd)
3644 : : {
3645 : 0 : source_refs_allocd *= 2;
3646 : 0 : source_refs = XRESIZEVEC (const char *, source_refs, source_refs_allocd);
3647 : : }
3648 : :
3649 : 90 : source_refs[source_refs_used++] = filename;
3650 : : }
3651 : :
3652 : : /* Main entry point: dump all Ada specs corresponding to SOURCE_REFS
3653 : : using callbacks COLLECT_ALL_REFS and CHECK.
3654 : : COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3655 : : nodes for a given source file.
3656 : : CHECK is used to perform C++ queries on nodes, or NULL for the C
3657 : : front-end. */
3658 : :
3659 : : void
3660 : 90 : dump_ada_specs (void (*collect_all_refs)(const char *),
3661 : : int (*check)(tree, cpp_operation))
3662 : : {
3663 : 90 : bitmap_obstack_initialize (NULL);
3664 : :
3665 : 90 : overloaded_names = init_overloaded_names ();
3666 : :
3667 : : /* Iterate over the list of files to dump specs for. */
3668 : 180 : for (int i = 0; i < source_refs_used; i++)
3669 : : {
3670 : 90 : dumped_anonymous_types = BITMAP_ALLOC (NULL);
3671 : 90 : dump_ads (source_refs[i], collect_all_refs, check);
3672 : 90 : BITMAP_FREE (dumped_anonymous_types);
3673 : : }
3674 : :
3675 : : /* Free various tables. */
3676 : 90 : free (source_refs);
3677 : 90 : delete overloaded_names;
3678 : :
3679 : 90 : bitmap_obstack_release (NULL);
3680 : 90 : }
|
