1af526226Smrg /* Print GENERIC declaration (functions, variables, types) trees coming from
2af526226Smrg the C and C++ front-ends as well as macros in Ada syntax.
3*8d286336Smrg Copyright (C) 2010-2020 Free Software Foundation, Inc.
4af526226Smrg Adapted from tree-pretty-print.c by Arnaud Charlet <charlet@adacore.com>
5af526226Smrg
6af526226Smrg This file is part of GCC.
7af526226Smrg
8af526226Smrg GCC is free software; you can redistribute it and/or modify it under
9af526226Smrg the terms of the GNU General Public License as published by the Free
10af526226Smrg Software Foundation; either version 3, or (at your option) any later
11af526226Smrg version.
12af526226Smrg
13af526226Smrg GCC is distributed in the hope that it will be useful, but WITHOUT ANY
14af526226Smrg WARRANTY; without even the implied warranty of MERCHANTABILITY or
15af526226Smrg FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16af526226Smrg for more details.
17af526226Smrg
18af526226Smrg You should have received a copy of the GNU General Public License
19af526226Smrg along with GCC; see the file COPYING3. If not see
20af526226Smrg <http://www.gnu.org/licenses/>. */
21af526226Smrg
22af526226Smrg #include "config.h"
23af526226Smrg #include "system.h"
24af526226Smrg #include "coretypes.h"
25af526226Smrg #include "tm.h"
2681418a27Smrg #include "stringpool.h"
27af526226Smrg #include "tree.h"
28af526226Smrg #include "c-ada-spec.h"
2963aace61Smrg #include "fold-const.h"
30af526226Smrg #include "c-pragma.h"
3181418a27Smrg #include "diagnostic.h"
323903d7f3Smrg #include "stringpool.h"
333903d7f3Smrg #include "attribs.h"
34*8d286336Smrg #include "bitmap.h"
35af526226Smrg
36af526226Smrg /* Local functions, macros and variables. */
373903d7f3Smrg static int dump_ada_node (pretty_printer *, tree, tree, int, bool, bool);
383903d7f3Smrg static int dump_ada_declaration (pretty_printer *, tree, tree, int);
3981418a27Smrg static void dump_ada_structure (pretty_printer *, tree, tree, bool, int);
4081418a27Smrg static char *to_ada_name (const char *, bool *);
41af526226Smrg
425ef59e75Smrg #define INDENT(SPACE) \
435ef59e75Smrg do { int i; for (i = 0; i<SPACE; i++) pp_space (buffer); } while (0)
44af526226Smrg
45af526226Smrg #define INDENT_INCR 3
46af526226Smrg
475ef59e75Smrg /* Global hook used to perform C++ queries on nodes. */
485ef59e75Smrg static int (*cpp_check) (tree, cpp_operation) = NULL;
495ef59e75Smrg
503903d7f3Smrg /* Global variables used in macro-related callbacks. */
513903d7f3Smrg static int max_ada_macros;
523903d7f3Smrg static int store_ada_macro_index;
533903d7f3Smrg static const char *macro_source_file;
545ef59e75Smrg
55af526226Smrg /* Given a cpp MACRO, compute the max length BUFFER_LEN of the macro, as well
56af526226Smrg as max length PARAM_LEN of arguments for fun_like macros, and also set
57af526226Smrg SUPPORTED to 0 if the macro cannot be mapped to an Ada construct. */
58af526226Smrg
59af526226Smrg static void
macro_length(const cpp_macro * macro,int * supported,int * buffer_len,int * param_len)60af526226Smrg macro_length (const cpp_macro *macro, int *supported, int *buffer_len,
61af526226Smrg int *param_len)
62af526226Smrg {
63af526226Smrg int i;
64af526226Smrg unsigned j;
65af526226Smrg
66af526226Smrg *supported = 1;
67af526226Smrg *buffer_len = 0;
68af526226Smrg *param_len = 0;
69af526226Smrg
70af526226Smrg if (macro->fun_like)
71af526226Smrg {
729c259053Smrg (*param_len)++;
73af526226Smrg for (i = 0; i < macro->paramc; i++)
74af526226Smrg {
7581418a27Smrg cpp_hashnode *param = macro->parm.params[i];
76af526226Smrg
77af526226Smrg *param_len += NODE_LEN (param);
78af526226Smrg
79af526226Smrg if (i + 1 < macro->paramc)
80af526226Smrg {
81af526226Smrg *param_len += 2; /* ", " */
82af526226Smrg }
83af526226Smrg else if (macro->variadic)
84af526226Smrg {
85af526226Smrg *supported = 0;
86af526226Smrg return;
87af526226Smrg }
88af526226Smrg }
89af526226Smrg *param_len += 2; /* ")\0" */
90af526226Smrg }
91af526226Smrg
92af526226Smrg for (j = 0; j < macro->count; j++)
93af526226Smrg {
9481418a27Smrg const cpp_token *token = ¯o->exp.tokens[j];
95af526226Smrg
96af526226Smrg if (token->flags & PREV_WHITE)
97af526226Smrg (*buffer_len)++;
98af526226Smrg
99af526226Smrg if (token->flags & STRINGIFY_ARG || token->flags & PASTE_LEFT)
100af526226Smrg {
101af526226Smrg *supported = 0;
102af526226Smrg return;
103af526226Smrg }
104af526226Smrg
105af526226Smrg if (token->type == CPP_MACRO_ARG)
106af526226Smrg *buffer_len +=
10781418a27Smrg NODE_LEN (macro->parm.params[token->val.macro_arg.arg_no - 1]);
108af526226Smrg else
109af526226Smrg /* Include enough extra space to handle e.g. special characters. */
110af526226Smrg *buffer_len += (cpp_token_len (token) + 1) * 8;
111af526226Smrg }
112af526226Smrg
113af526226Smrg (*buffer_len)++;
114af526226Smrg }
115af526226Smrg
1166a5c9aabSmrg /* Dump all digits/hex chars from NUMBER to BUFFER and return a pointer
1173903d7f3Smrg to the character after the last character written. If FLOAT_P is true,
1183903d7f3Smrg this is a floating-point number. */
1196a5c9aabSmrg
1206a5c9aabSmrg static unsigned char *
dump_number(unsigned char * number,unsigned char * buffer,bool float_p)1213903d7f3Smrg dump_number (unsigned char *number, unsigned char *buffer, bool float_p)
1226a5c9aabSmrg {
1236a5c9aabSmrg while (*number != '\0'
1243903d7f3Smrg && *number != (float_p ? 'F' : 'U')
1253903d7f3Smrg && *number != (float_p ? 'f' : 'u')
1266a5c9aabSmrg && *number != 'l'
1276a5c9aabSmrg && *number != 'L')
1286a5c9aabSmrg *buffer++ = *number++;
1296a5c9aabSmrg
1306a5c9aabSmrg return buffer;
1316a5c9aabSmrg }
1326a5c9aabSmrg
1336a5c9aabSmrg /* Handle escape character C and convert to an Ada character into BUFFER.
1346a5c9aabSmrg Return a pointer to the character after the last character written, or
1356a5c9aabSmrg NULL if the escape character is not supported. */
1366a5c9aabSmrg
1376a5c9aabSmrg static unsigned char *
handle_escape_character(unsigned char * buffer,char c)1386a5c9aabSmrg handle_escape_character (unsigned char *buffer, char c)
1396a5c9aabSmrg {
1406a5c9aabSmrg switch (c)
1416a5c9aabSmrg {
1426a5c9aabSmrg case '"':
1436a5c9aabSmrg *buffer++ = '"';
1446a5c9aabSmrg *buffer++ = '"';
1456a5c9aabSmrg break;
1466a5c9aabSmrg
1476a5c9aabSmrg case 'n':
1486a5c9aabSmrg strcpy ((char *) buffer, "\" & ASCII.LF & \"");
1496a5c9aabSmrg buffer += 16;
1506a5c9aabSmrg break;
1516a5c9aabSmrg
1526a5c9aabSmrg case 'r':
1536a5c9aabSmrg strcpy ((char *) buffer, "\" & ASCII.CR & \"");
1546a5c9aabSmrg buffer += 16;
1556a5c9aabSmrg break;
1566a5c9aabSmrg
1576a5c9aabSmrg case 't':
1586a5c9aabSmrg strcpy ((char *) buffer, "\" & ASCII.HT & \"");
1596a5c9aabSmrg buffer += 16;
1606a5c9aabSmrg break;
1616a5c9aabSmrg
1626a5c9aabSmrg default:
1636a5c9aabSmrg return NULL;
1646a5c9aabSmrg }
1656a5c9aabSmrg
1666a5c9aabSmrg return buffer;
1676a5c9aabSmrg }
1686a5c9aabSmrg
1693903d7f3Smrg /* Callback used to count the number of macros from cpp_forall_identifiers.
1703903d7f3Smrg PFILE and V are not used. NODE is the current macro to consider. */
1713903d7f3Smrg
1723903d7f3Smrg static int
count_ada_macro(cpp_reader * pfile ATTRIBUTE_UNUSED,cpp_hashnode * node,void * v ATTRIBUTE_UNUSED)1733903d7f3Smrg count_ada_macro (cpp_reader *pfile ATTRIBUTE_UNUSED, cpp_hashnode *node,
1743903d7f3Smrg void *v ATTRIBUTE_UNUSED)
1753903d7f3Smrg {
17681418a27Smrg if (cpp_user_macro_p (node) && *NODE_NAME (node) != '_')
17781418a27Smrg {
1783903d7f3Smrg const cpp_macro *macro = node->value.macro;
17981418a27Smrg if (macro->count && LOCATION_FILE (macro->line) == macro_source_file)
1803903d7f3Smrg max_ada_macros++;
18181418a27Smrg }
1823903d7f3Smrg
1833903d7f3Smrg return 1;
1843903d7f3Smrg }
1853903d7f3Smrg
1863903d7f3Smrg /* Callback used to store relevant macros from cpp_forall_identifiers.
1873903d7f3Smrg PFILE is not used. NODE is the current macro to store if relevant.
1883903d7f3Smrg MACROS is an array of cpp_hashnode* used to store NODE. */
1893903d7f3Smrg
1903903d7f3Smrg static int
store_ada_macro(cpp_reader * pfile ATTRIBUTE_UNUSED,cpp_hashnode * node,void * macros)1913903d7f3Smrg store_ada_macro (cpp_reader *pfile ATTRIBUTE_UNUSED,
1923903d7f3Smrg cpp_hashnode *node, void *macros)
1933903d7f3Smrg {
19481418a27Smrg if (cpp_user_macro_p (node) && *NODE_NAME (node) != '_')
19581418a27Smrg {
1963903d7f3Smrg const cpp_macro *macro = node->value.macro;
19781418a27Smrg if (macro->count
1983903d7f3Smrg && LOCATION_FILE (macro->line) == macro_source_file)
1993903d7f3Smrg ((cpp_hashnode **) macros)[store_ada_macro_index++] = node;
20081418a27Smrg }
2013903d7f3Smrg return 1;
2023903d7f3Smrg }
2033903d7f3Smrg
2043903d7f3Smrg /* Callback used to compare (during qsort) macros. NODE1 and NODE2 are the
2053903d7f3Smrg two macro nodes to compare. */
2063903d7f3Smrg
2073903d7f3Smrg static int
compare_macro(const void * node1,const void * node2)2083903d7f3Smrg compare_macro (const void *node1, const void *node2)
2093903d7f3Smrg {
2103903d7f3Smrg typedef const cpp_hashnode *const_hnode;
2113903d7f3Smrg
2123903d7f3Smrg const_hnode n1 = *(const const_hnode *) node1;
2133903d7f3Smrg const_hnode n2 = *(const const_hnode *) node2;
2143903d7f3Smrg
2153903d7f3Smrg return n1->value.macro->line - n2->value.macro->line;
2163903d7f3Smrg }
2173903d7f3Smrg
2183903d7f3Smrg /* Dump in PP all relevant macros appearing in FILE. */
219af526226Smrg
220af526226Smrg static void
dump_ada_macros(pretty_printer * pp,const char * file)2213903d7f3Smrg dump_ada_macros (pretty_printer *pp, const char* file)
222af526226Smrg {
2233903d7f3Smrg int num_macros = 0, prev_line = -1;
2243903d7f3Smrg cpp_hashnode **macros;
225af526226Smrg
2263903d7f3Smrg /* Initialize file-scope variables. */
2273903d7f3Smrg max_ada_macros = 0;
2283903d7f3Smrg store_ada_macro_index = 0;
2293903d7f3Smrg macro_source_file = file;
2303903d7f3Smrg
2313903d7f3Smrg /* Count all potentially relevant macros, and then sort them by sloc. */
2323903d7f3Smrg cpp_forall_identifiers (parse_in, count_ada_macro, NULL);
2333903d7f3Smrg macros = XALLOCAVEC (cpp_hashnode *, max_ada_macros);
2343903d7f3Smrg cpp_forall_identifiers (parse_in, store_ada_macro, macros);
2353903d7f3Smrg qsort (macros, max_ada_macros, sizeof (cpp_hashnode *), compare_macro);
2363903d7f3Smrg
2373903d7f3Smrg for (int j = 0; j < max_ada_macros; j++)
238af526226Smrg {
239af526226Smrg cpp_hashnode *node = macros[j];
240af526226Smrg const cpp_macro *macro = node->value.macro;
241af526226Smrg unsigned i;
242af526226Smrg int supported = 1, prev_is_one = 0, buffer_len, param_len;
243af526226Smrg int is_string = 0, is_char = 0;
244af526226Smrg char *ada_name;
2456a5c9aabSmrg unsigned char *s, *params, *buffer, *buf_param, *char_one = NULL, *tmp;
246af526226Smrg
247af526226Smrg macro_length (macro, &supported, &buffer_len, ¶m_len);
248af526226Smrg s = buffer = XALLOCAVEC (unsigned char, buffer_len);
249af526226Smrg params = buf_param = XALLOCAVEC (unsigned char, param_len);
250af526226Smrg
251af526226Smrg if (supported)
252af526226Smrg {
253af526226Smrg if (macro->fun_like)
254af526226Smrg {
255af526226Smrg *buf_param++ = '(';
256af526226Smrg for (i = 0; i < macro->paramc; i++)
257af526226Smrg {
25881418a27Smrg cpp_hashnode *param = macro->parm.params[i];
259af526226Smrg
260af526226Smrg memcpy (buf_param, NODE_NAME (param), NODE_LEN (param));
261af526226Smrg buf_param += NODE_LEN (param);
262af526226Smrg
263af526226Smrg if (i + 1 < macro->paramc)
264af526226Smrg {
265af526226Smrg *buf_param++ = ',';
266af526226Smrg *buf_param++ = ' ';
267af526226Smrg }
268af526226Smrg else if (macro->variadic)
269af526226Smrg {
270af526226Smrg supported = 0;
271af526226Smrg break;
272af526226Smrg }
273af526226Smrg }
274af526226Smrg *buf_param++ = ')';
275af526226Smrg *buf_param = '\0';
276af526226Smrg }
277af526226Smrg
278af526226Smrg for (i = 0; supported && i < macro->count; i++)
279af526226Smrg {
28081418a27Smrg const cpp_token *token = ¯o->exp.tokens[i];
281af526226Smrg int is_one = 0;
282af526226Smrg
283af526226Smrg if (token->flags & PREV_WHITE)
284af526226Smrg *buffer++ = ' ';
285af526226Smrg
286af526226Smrg if (token->flags & STRINGIFY_ARG || token->flags & PASTE_LEFT)
287af526226Smrg {
288af526226Smrg supported = 0;
289af526226Smrg break;
290af526226Smrg }
291af526226Smrg
292af526226Smrg switch (token->type)
293af526226Smrg {
294af526226Smrg case CPP_MACRO_ARG:
295af526226Smrg {
296af526226Smrg cpp_hashnode *param =
29781418a27Smrg macro->parm.params[token->val.macro_arg.arg_no - 1];
298af526226Smrg memcpy (buffer, NODE_NAME (param), NODE_LEN (param));
299af526226Smrg buffer += NODE_LEN (param);
300af526226Smrg }
301af526226Smrg break;
302af526226Smrg
303af526226Smrg case CPP_EQ_EQ: *buffer++ = '='; break;
304af526226Smrg case CPP_GREATER: *buffer++ = '>'; break;
305af526226Smrg case CPP_LESS: *buffer++ = '<'; break;
306af526226Smrg case CPP_PLUS: *buffer++ = '+'; break;
307af526226Smrg case CPP_MINUS: *buffer++ = '-'; break;
308af526226Smrg case CPP_MULT: *buffer++ = '*'; break;
309af526226Smrg case CPP_DIV: *buffer++ = '/'; break;
310af526226Smrg case CPP_COMMA: *buffer++ = ','; break;
311af526226Smrg case CPP_OPEN_SQUARE:
312af526226Smrg case CPP_OPEN_PAREN: *buffer++ = '('; break;
313af526226Smrg case CPP_CLOSE_SQUARE: /* fallthrough */
314af526226Smrg case CPP_CLOSE_PAREN: *buffer++ = ')'; break;
315af526226Smrg case CPP_DEREF: /* fallthrough */
316af526226Smrg case CPP_SCOPE: /* fallthrough */
317af526226Smrg case CPP_DOT: *buffer++ = '.'; break;
318af526226Smrg
319af526226Smrg case CPP_EQ: *buffer++ = ':'; *buffer++ = '='; break;
320af526226Smrg case CPP_NOT_EQ: *buffer++ = '/'; *buffer++ = '='; break;
321af526226Smrg case CPP_GREATER_EQ: *buffer++ = '>'; *buffer++ = '='; break;
322af526226Smrg case CPP_LESS_EQ: *buffer++ = '<'; *buffer++ = '='; break;
323af526226Smrg
324af526226Smrg case CPP_NOT:
325af526226Smrg *buffer++ = 'n'; *buffer++ = 'o'; *buffer++ = 't'; break;
326af526226Smrg case CPP_MOD:
327af526226Smrg *buffer++ = 'm'; *buffer++ = 'o'; *buffer++ = 'd'; break;
328af526226Smrg case CPP_AND:
329af526226Smrg *buffer++ = 'a'; *buffer++ = 'n'; *buffer++ = 'd'; break;
330af526226Smrg case CPP_OR:
331af526226Smrg *buffer++ = 'o'; *buffer++ = 'r'; break;
332af526226Smrg case CPP_XOR:
333af526226Smrg *buffer++ = 'x'; *buffer++ = 'o'; *buffer++ = 'r'; break;
334af526226Smrg case CPP_AND_AND:
335af526226Smrg strcpy ((char *) buffer, " and then ");
336af526226Smrg buffer += 10;
337af526226Smrg break;
338af526226Smrg case CPP_OR_OR:
339af526226Smrg strcpy ((char *) buffer, " or else ");
340af526226Smrg buffer += 9;
341af526226Smrg break;
342af526226Smrg
343af526226Smrg case CPP_PADDING:
344af526226Smrg *buffer++ = ' ';
345af526226Smrg is_one = prev_is_one;
346af526226Smrg break;
347af526226Smrg
3483903d7f3Smrg case CPP_COMMENT:
3493903d7f3Smrg break;
350af526226Smrg
351af526226Smrg case CPP_WSTRING:
352af526226Smrg case CPP_STRING16:
353af526226Smrg case CPP_STRING32:
354af526226Smrg case CPP_UTF8STRING:
355af526226Smrg case CPP_WCHAR:
356af526226Smrg case CPP_CHAR16:
357af526226Smrg case CPP_CHAR32:
35863aace61Smrg case CPP_UTF8CHAR:
359af526226Smrg case CPP_NAME:
360af526226Smrg if (!macro->fun_like)
361af526226Smrg supported = 0;
362af526226Smrg else
3633903d7f3Smrg buffer
3643903d7f3Smrg = cpp_spell_token (parse_in, token, buffer, false);
365af526226Smrg break;
366af526226Smrg
3676a5c9aabSmrg case CPP_STRING:
3683903d7f3Smrg if (is_string)
3693903d7f3Smrg {
3703903d7f3Smrg *buffer++ = '&';
3713903d7f3Smrg *buffer++ = ' ';
3723903d7f3Smrg }
3733903d7f3Smrg else
3746a5c9aabSmrg is_string = 1;
3756a5c9aabSmrg {
3766a5c9aabSmrg const unsigned char *s = token->val.str.text;
3776a5c9aabSmrg
3786a5c9aabSmrg for (; *s; s++)
3796a5c9aabSmrg if (*s == '\\')
3806a5c9aabSmrg {
3816a5c9aabSmrg s++;
3826a5c9aabSmrg buffer = handle_escape_character (buffer, *s);
3836a5c9aabSmrg if (buffer == NULL)
3846a5c9aabSmrg {
3856a5c9aabSmrg supported = 0;
3866a5c9aabSmrg break;
3876a5c9aabSmrg }
3886a5c9aabSmrg }
3896a5c9aabSmrg else
3906a5c9aabSmrg *buffer++ = *s;
3916a5c9aabSmrg }
3926a5c9aabSmrg break;
3936a5c9aabSmrg
394af526226Smrg case CPP_CHAR:
395af526226Smrg is_char = 1;
396af526226Smrg {
397af526226Smrg unsigned chars_seen;
398af526226Smrg int ignored;
399af526226Smrg cppchar_t c;
400af526226Smrg
401af526226Smrg c = cpp_interpret_charconst (parse_in, token,
402af526226Smrg &chars_seen, &ignored);
403af526226Smrg if (c >= 32 && c <= 126)
404af526226Smrg {
405af526226Smrg *buffer++ = '\'';
406af526226Smrg *buffer++ = (char) c;
407af526226Smrg *buffer++ = '\'';
408af526226Smrg }
409af526226Smrg else
410af526226Smrg {
411af526226Smrg chars_seen = sprintf
412af526226Smrg ((char *) buffer, "Character'Val (%d)", (int) c);
413af526226Smrg buffer += chars_seen;
414af526226Smrg }
415af526226Smrg }
416af526226Smrg break;
417af526226Smrg
4186a5c9aabSmrg case CPP_NUMBER:
4196a5c9aabSmrg tmp = cpp_token_as_text (parse_in, token);
4206a5c9aabSmrg
4216a5c9aabSmrg switch (*tmp)
4226a5c9aabSmrg {
4236a5c9aabSmrg case '0':
4246a5c9aabSmrg switch (tmp[1])
4256a5c9aabSmrg {
4266a5c9aabSmrg case '\0':
4276a5c9aabSmrg case 'l':
4286a5c9aabSmrg case 'L':
4296a5c9aabSmrg case 'u':
4306a5c9aabSmrg case 'U':
4316a5c9aabSmrg *buffer++ = '0';
4326a5c9aabSmrg break;
4336a5c9aabSmrg
4346a5c9aabSmrg case 'x':
4356a5c9aabSmrg case 'X':
4366a5c9aabSmrg *buffer++ = '1';
4376a5c9aabSmrg *buffer++ = '6';
4386a5c9aabSmrg *buffer++ = '#';
4393903d7f3Smrg buffer = dump_number (tmp + 2, buffer, false);
4406a5c9aabSmrg *buffer++ = '#';
4416a5c9aabSmrg break;
4426a5c9aabSmrg
4436a5c9aabSmrg case 'b':
4446a5c9aabSmrg case 'B':
4456a5c9aabSmrg *buffer++ = '2';
4466a5c9aabSmrg *buffer++ = '#';
4473903d7f3Smrg buffer = dump_number (tmp + 2, buffer, false);
4486a5c9aabSmrg *buffer++ = '#';
4496a5c9aabSmrg break;
4506a5c9aabSmrg
4516a5c9aabSmrg default:
4523903d7f3Smrg /* Dump floating-point constant unmodified. */
4536a5c9aabSmrg if (strchr ((const char *)tmp, '.'))
4543903d7f3Smrg buffer = dump_number (tmp, buffer, true);
4556a5c9aabSmrg else
4566a5c9aabSmrg {
4576a5c9aabSmrg *buffer++ = '8';
4586a5c9aabSmrg *buffer++ = '#';
4593903d7f3Smrg buffer
4603903d7f3Smrg = dump_number (tmp + 1, buffer, false);
4616a5c9aabSmrg *buffer++ = '#';
4626a5c9aabSmrg }
4636a5c9aabSmrg break;
4646a5c9aabSmrg }
4656a5c9aabSmrg break;
4666a5c9aabSmrg
4676a5c9aabSmrg case '1':
4683903d7f3Smrg if (tmp[1] == '\0'
4693903d7f3Smrg || tmp[1] == 'u'
4703903d7f3Smrg || tmp[1] == 'U'
4713903d7f3Smrg || tmp[1] == 'l'
4723903d7f3Smrg || tmp[1] == 'L')
4736a5c9aabSmrg {
4746a5c9aabSmrg is_one = 1;
4756a5c9aabSmrg char_one = buffer;
4766a5c9aabSmrg *buffer++ = '1';
4775306d544Smrg break;
4783903d7f3Smrg }
4793903d7f3Smrg /* fallthrough */
4806a5c9aabSmrg
4816a5c9aabSmrg default:
4823903d7f3Smrg buffer
4833903d7f3Smrg = dump_number (tmp, buffer,
4843903d7f3Smrg strchr ((const char *)tmp, '.'));
4856a5c9aabSmrg break;
4866a5c9aabSmrg }
4876a5c9aabSmrg break;
4886a5c9aabSmrg
489af526226Smrg case CPP_LSHIFT:
490af526226Smrg if (prev_is_one)
491af526226Smrg {
492af526226Smrg /* Replace "1 << N" by "2 ** N" */
493af526226Smrg *char_one = '2';
494af526226Smrg *buffer++ = '*';
495af526226Smrg *buffer++ = '*';
496af526226Smrg break;
497af526226Smrg }
498af526226Smrg /* fallthrough */
499af526226Smrg
500af526226Smrg case CPP_RSHIFT:
501af526226Smrg case CPP_COMPL:
502af526226Smrg case CPP_QUERY:
503af526226Smrg case CPP_EOF:
504af526226Smrg case CPP_PLUS_EQ:
505af526226Smrg case CPP_MINUS_EQ:
506af526226Smrg case CPP_MULT_EQ:
507af526226Smrg case CPP_DIV_EQ:
508af526226Smrg case CPP_MOD_EQ:
509af526226Smrg case CPP_AND_EQ:
510af526226Smrg case CPP_OR_EQ:
511af526226Smrg case CPP_XOR_EQ:
512af526226Smrg case CPP_RSHIFT_EQ:
513af526226Smrg case CPP_LSHIFT_EQ:
514af526226Smrg case CPP_PRAGMA:
515af526226Smrg case CPP_PRAGMA_EOL:
516af526226Smrg case CPP_HASH:
517af526226Smrg case CPP_PASTE:
518af526226Smrg case CPP_OPEN_BRACE:
519af526226Smrg case CPP_CLOSE_BRACE:
520af526226Smrg case CPP_SEMICOLON:
521af526226Smrg case CPP_ELLIPSIS:
522af526226Smrg case CPP_PLUS_PLUS:
523af526226Smrg case CPP_MINUS_MINUS:
524af526226Smrg case CPP_DEREF_STAR:
525af526226Smrg case CPP_DOT_STAR:
526af526226Smrg case CPP_ATSIGN:
527af526226Smrg case CPP_HEADER_NAME:
528af526226Smrg case CPP_AT_NAME:
529af526226Smrg case CPP_OTHER:
530af526226Smrg case CPP_OBJC_STRING:
531af526226Smrg default:
532af526226Smrg if (!macro->fun_like)
533af526226Smrg supported = 0;
534af526226Smrg else
535af526226Smrg buffer = cpp_spell_token (parse_in, token, buffer, false);
536af526226Smrg break;
537af526226Smrg }
538af526226Smrg
539af526226Smrg prev_is_one = is_one;
540af526226Smrg }
541af526226Smrg
542af526226Smrg if (supported)
543af526226Smrg *buffer = '\0';
544af526226Smrg }
545af526226Smrg
546af526226Smrg if (macro->fun_like && supported)
547af526226Smrg {
548af526226Smrg char *start = (char *) s;
549af526226Smrg int is_function = 0;
550af526226Smrg
551af526226Smrg pp_string (pp, " -- arg-macro: ");
552af526226Smrg
553af526226Smrg if (*start == '(' && buffer[-1] == ')')
554af526226Smrg {
555af526226Smrg start++;
556af526226Smrg buffer[-1] = '\0';
557af526226Smrg is_function = 1;
558af526226Smrg pp_string (pp, "function ");
559af526226Smrg }
560af526226Smrg else
561af526226Smrg {
562af526226Smrg pp_string (pp, "procedure ");
563af526226Smrg }
564af526226Smrg
565af526226Smrg pp_string (pp, (const char *) NODE_NAME (node));
566af526226Smrg pp_space (pp);
567af526226Smrg pp_string (pp, (char *) params);
568af526226Smrg pp_newline (pp);
569af526226Smrg pp_string (pp, " -- ");
570af526226Smrg
571af526226Smrg if (is_function)
572af526226Smrg {
573af526226Smrg pp_string (pp, "return ");
574af526226Smrg pp_string (pp, start);
575af526226Smrg pp_semicolon (pp);
576af526226Smrg }
577af526226Smrg else
578af526226Smrg pp_string (pp, start);
579af526226Smrg
580af526226Smrg pp_newline (pp);
581af526226Smrg }
582af526226Smrg else if (supported)
583af526226Smrg {
584af526226Smrg expanded_location sloc = expand_location (macro->line);
585af526226Smrg
58663aace61Smrg if (sloc.line != prev_line + 1 && prev_line > 0)
587af526226Smrg pp_newline (pp);
588af526226Smrg
589af526226Smrg num_macros++;
590af526226Smrg prev_line = sloc.line;
591af526226Smrg
592af526226Smrg pp_string (pp, " ");
59381418a27Smrg ada_name = to_ada_name ((const char *) NODE_NAME (node), NULL);
594af526226Smrg pp_string (pp, ada_name);
595af526226Smrg free (ada_name);
596af526226Smrg pp_string (pp, " : ");
597af526226Smrg
598af526226Smrg if (is_string)
599af526226Smrg pp_string (pp, "aliased constant String");
600af526226Smrg else if (is_char)
601af526226Smrg pp_string (pp, "aliased constant Character");
602af526226Smrg else
603af526226Smrg pp_string (pp, "constant");
604af526226Smrg
605af526226Smrg pp_string (pp, " := ");
606af526226Smrg pp_string (pp, (char *) s);
607af526226Smrg
608af526226Smrg if (is_string)
609af526226Smrg pp_string (pp, " & ASCII.NUL");
610af526226Smrg
611af526226Smrg pp_string (pp, "; -- ");
612af526226Smrg pp_string (pp, sloc.file);
6135ef59e75Smrg pp_colon (pp);
614af526226Smrg pp_scalar (pp, "%d", sloc.line);
615af526226Smrg pp_newline (pp);
616af526226Smrg }
617af526226Smrg else
618af526226Smrg {
619af526226Smrg pp_string (pp, " -- unsupported macro: ");
620af526226Smrg pp_string (pp, (const char *) cpp_macro_definition (parse_in, node));
621af526226Smrg pp_newline (pp);
622af526226Smrg }
623af526226Smrg }
624af526226Smrg
625af526226Smrg if (num_macros > 0)
626af526226Smrg pp_newline (pp);
627af526226Smrg }
628af526226Smrg
629af526226Smrg /* Current source file being handled. */
6303903d7f3Smrg static const char *current_source_file;
631af526226Smrg
632af526226Smrg /* Return sloc of DECL, using sloc of last field if LAST is true. */
633af526226Smrg
634*8d286336Smrg static location_t
decl_sloc(const_tree decl,bool last)635af526226Smrg decl_sloc (const_tree decl, bool last)
636af526226Smrg {
63763aace61Smrg tree field;
63863aace61Smrg
63963aace61Smrg /* Compare the declaration of struct-like types based on the sloc of their
64063aace61Smrg last field (if LAST is true), so that more nested types collate before
64163aace61Smrg less nested ones. */
64263aace61Smrg if (TREE_CODE (decl) == TYPE_DECL
64363aace61Smrg && !DECL_ORIGINAL_TYPE (decl)
64463aace61Smrg && RECORD_OR_UNION_TYPE_P (TREE_TYPE (decl))
64563aace61Smrg && (field = TYPE_FIELDS (TREE_TYPE (decl))))
64663aace61Smrg {
64763aace61Smrg if (last)
64863aace61Smrg while (DECL_CHAIN (field))
64963aace61Smrg field = DECL_CHAIN (field);
65063aace61Smrg return DECL_SOURCE_LOCATION (field);
65163aace61Smrg }
65263aace61Smrg
65363aace61Smrg return DECL_SOURCE_LOCATION (decl);
654af526226Smrg }
655af526226Smrg
656af526226Smrg /* Compare two locations LHS and RHS. */
657af526226Smrg
658af526226Smrg static int
compare_location(location_t lhs,location_t rhs)659af526226Smrg compare_location (location_t lhs, location_t rhs)
660af526226Smrg {
661af526226Smrg expanded_location xlhs = expand_location (lhs);
662af526226Smrg expanded_location xrhs = expand_location (rhs);
663af526226Smrg
664af526226Smrg if (xlhs.file != xrhs.file)
665af526226Smrg return filename_cmp (xlhs.file, xrhs.file);
666af526226Smrg
667af526226Smrg if (xlhs.line != xrhs.line)
668af526226Smrg return xlhs.line - xrhs.line;
669af526226Smrg
670af526226Smrg if (xlhs.column != xrhs.column)
671af526226Smrg return xlhs.column - xrhs.column;
672af526226Smrg
673af526226Smrg return 0;
674af526226Smrg }
675af526226Smrg
676af526226Smrg /* Compare two declarations (LP and RP) by their source location. */
677af526226Smrg
678af526226Smrg static int
compare_node(const void * lp,const void * rp)679af526226Smrg compare_node (const void *lp, const void *rp)
680af526226Smrg {
681af526226Smrg const_tree lhs = *((const tree *) lp);
682af526226Smrg const_tree rhs = *((const tree *) rp);
68381418a27Smrg const int ret
68481418a27Smrg = compare_location (decl_sloc (lhs, true), decl_sloc (rhs, true));
685af526226Smrg
68681418a27Smrg return ret ? ret : DECL_UID (lhs) - DECL_UID (rhs);
687af526226Smrg }
688af526226Smrg
689af526226Smrg /* Compare two comments (LP and RP) by their source location. */
690af526226Smrg
691af526226Smrg static int
compare_comment(const void * lp,const void * rp)692af526226Smrg compare_comment (const void *lp, const void *rp)
693af526226Smrg {
694af526226Smrg const cpp_comment *lhs = (const cpp_comment *) lp;
695af526226Smrg const cpp_comment *rhs = (const cpp_comment *) rp;
696af526226Smrg
697af526226Smrg return compare_location (lhs->sloc, rhs->sloc);
698af526226Smrg }
699af526226Smrg
700af526226Smrg static tree *to_dump = NULL;
701af526226Smrg static int to_dump_count = 0;
702af526226Smrg
703af526226Smrg /* Collect a list of declarations from T relevant to SOURCE_FILE to be dumped
704af526226Smrg by a subsequent call to dump_ada_nodes. */
705af526226Smrg
706af526226Smrg void
collect_ada_nodes(tree t,const char * source_file)707af526226Smrg collect_ada_nodes (tree t, const char *source_file)
708af526226Smrg {
709af526226Smrg tree n;
710af526226Smrg int i = to_dump_count;
711af526226Smrg
71263aace61Smrg /* Count the likely relevant nodes: do not dump builtins (they are irrelevant
71363aace61Smrg in the context of bindings) and namespaces (we do not handle them properly
71463aace61Smrg yet). */
715af526226Smrg for (n = t; n; n = TREE_CHAIN (n))
716af526226Smrg if (!DECL_IS_BUILTIN (n)
71763aace61Smrg && TREE_CODE (n) != NAMESPACE_DECL
718af526226Smrg && LOCATION_FILE (decl_sloc (n, false)) == source_file)
719af526226Smrg to_dump_count++;
720af526226Smrg
721af526226Smrg /* Allocate sufficient storage for all nodes. */
722af526226Smrg to_dump = XRESIZEVEC (tree, to_dump, to_dump_count);
723af526226Smrg
724af526226Smrg /* Store the relevant nodes. */
725af526226Smrg for (n = t; n; n = TREE_CHAIN (n))
726af526226Smrg if (!DECL_IS_BUILTIN (n)
72763aace61Smrg && TREE_CODE (n) != NAMESPACE_DECL
728af526226Smrg && LOCATION_FILE (decl_sloc (n, false)) == source_file)
729af526226Smrg to_dump[i++] = n;
730af526226Smrg }
731af526226Smrg
732af526226Smrg /* Call back for walk_tree to clear the TREE_VISITED flag of TP. */
733af526226Smrg
734af526226Smrg static tree
unmark_visited_r(tree * tp,int * walk_subtrees ATTRIBUTE_UNUSED,void * data ATTRIBUTE_UNUSED)735af526226Smrg unmark_visited_r (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED,
736af526226Smrg void *data ATTRIBUTE_UNUSED)
737af526226Smrg {
738af526226Smrg if (TREE_VISITED (*tp))
739af526226Smrg TREE_VISITED (*tp) = 0;
740af526226Smrg else
741af526226Smrg *walk_subtrees = 0;
742af526226Smrg
743af526226Smrg return NULL_TREE;
744af526226Smrg }
745af526226Smrg
7463903d7f3Smrg /* Print a COMMENT to the output stream PP. */
7473903d7f3Smrg
7483903d7f3Smrg static void
print_comment(pretty_printer * pp,const char * comment)7493903d7f3Smrg print_comment (pretty_printer *pp, const char *comment)
7503903d7f3Smrg {
7513903d7f3Smrg int len = strlen (comment);
7523903d7f3Smrg char *str = XALLOCAVEC (char, len + 1);
7533903d7f3Smrg char *tok;
7543903d7f3Smrg bool extra_newline = false;
7553903d7f3Smrg
7563903d7f3Smrg memcpy (str, comment, len + 1);
7573903d7f3Smrg
7583903d7f3Smrg /* Trim C/C++ comment indicators. */
7593903d7f3Smrg if (str[len - 2] == '*' && str[len - 1] == '/')
7603903d7f3Smrg {
7613903d7f3Smrg str[len - 2] = ' ';
7623903d7f3Smrg str[len - 1] = '\0';
7633903d7f3Smrg }
7643903d7f3Smrg str += 2;
7653903d7f3Smrg
7663903d7f3Smrg tok = strtok (str, "\n");
7673903d7f3Smrg while (tok) {
7683903d7f3Smrg pp_string (pp, " --");
7693903d7f3Smrg pp_string (pp, tok);
7703903d7f3Smrg pp_newline (pp);
7713903d7f3Smrg tok = strtok (NULL, "\n");
7723903d7f3Smrg
7733903d7f3Smrg /* Leave a blank line after multi-line comments. */
7743903d7f3Smrg if (tok)
7753903d7f3Smrg extra_newline = true;
7763903d7f3Smrg }
7773903d7f3Smrg
7783903d7f3Smrg if (extra_newline)
7793903d7f3Smrg pp_newline (pp);
7803903d7f3Smrg }
7813903d7f3Smrg
782af526226Smrg /* Dump nodes into PP relevant to SOURCE_FILE, as collected by previous calls
7835ef59e75Smrg to collect_ada_nodes. */
784af526226Smrg
785af526226Smrg static void
dump_ada_nodes(pretty_printer * pp,const char * source_file)7865ef59e75Smrg dump_ada_nodes (pretty_printer *pp, const char *source_file)
787af526226Smrg {
788af526226Smrg int i, j;
789af526226Smrg cpp_comment_table *comments;
790af526226Smrg
791af526226Smrg /* Sort the table of declarations to dump by sloc. */
792af526226Smrg qsort (to_dump, to_dump_count, sizeof (tree), compare_node);
793af526226Smrg
794af526226Smrg /* Fetch the table of comments. */
795af526226Smrg comments = cpp_get_comments (parse_in);
796af526226Smrg
797af526226Smrg /* Sort the comments table by sloc. */
7985ef59e75Smrg if (comments->count > 1)
799af526226Smrg qsort (comments->entries, comments->count, sizeof (cpp_comment),
800af526226Smrg compare_comment);
801af526226Smrg
802af526226Smrg /* Interleave comments and declarations in line number order. */
803af526226Smrg i = j = 0;
804af526226Smrg do
805af526226Smrg {
806af526226Smrg /* Advance j until comment j is in this file. */
807af526226Smrg while (j != comments->count
808af526226Smrg && LOCATION_FILE (comments->entries[j].sloc) != source_file)
809af526226Smrg j++;
810af526226Smrg
811af526226Smrg /* Advance j until comment j is not a duplicate. */
812af526226Smrg while (j < comments->count - 1
813af526226Smrg && !compare_comment (&comments->entries[j],
814af526226Smrg &comments->entries[j + 1]))
815af526226Smrg j++;
816af526226Smrg
817af526226Smrg /* Write decls until decl i collates after comment j. */
818af526226Smrg while (i != to_dump_count)
819af526226Smrg {
820af526226Smrg if (j == comments->count
821af526226Smrg || LOCATION_LINE (decl_sloc (to_dump[i], false))
822af526226Smrg < LOCATION_LINE (comments->entries[j].sloc))
8233903d7f3Smrg {
8243903d7f3Smrg current_source_file = source_file;
8253903d7f3Smrg
8263903d7f3Smrg if (dump_ada_declaration (pp, to_dump[i++], NULL_TREE,
8273903d7f3Smrg INDENT_INCR))
8283903d7f3Smrg {
8293903d7f3Smrg pp_newline (pp);
8303903d7f3Smrg pp_newline (pp);
8313903d7f3Smrg }
8323903d7f3Smrg }
833af526226Smrg else
834af526226Smrg break;
835af526226Smrg }
836af526226Smrg
837af526226Smrg /* Write comment j, if there is one. */
838af526226Smrg if (j != comments->count)
839af526226Smrg print_comment (pp, comments->entries[j++].comment);
840af526226Smrg
841af526226Smrg } while (i != to_dump_count || j != comments->count);
842af526226Smrg
843af526226Smrg /* Clear the TREE_VISITED flag over each subtree we've dumped. */
844af526226Smrg for (i = 0; i < to_dump_count; i++)
845af526226Smrg walk_tree (&to_dump[i], unmark_visited_r, NULL, NULL);
846af526226Smrg
847af526226Smrg /* Finalize the to_dump table. */
848af526226Smrg if (to_dump)
849af526226Smrg {
850af526226Smrg free (to_dump);
851af526226Smrg to_dump = NULL;
852af526226Smrg to_dump_count = 0;
853af526226Smrg }
854af526226Smrg }
855af526226Smrg
856af526226Smrg /* Dump a newline and indent BUFFER by SPC chars. */
857af526226Smrg
858af526226Smrg static void
newline_and_indent(pretty_printer * buffer,int spc)859af526226Smrg newline_and_indent (pretty_printer *buffer, int spc)
860af526226Smrg {
861af526226Smrg pp_newline (buffer);
862af526226Smrg INDENT (spc);
863af526226Smrg }
864af526226Smrg
8653903d7f3Smrg struct with { char *s; const char *in_file; bool limited; };
866af526226Smrg static struct with *withs = NULL;
867af526226Smrg static int withs_max = 4096;
868af526226Smrg static int with_len = 0;
869af526226Smrg
870af526226Smrg /* Record a "with" clause on package S (a limited with if LIMITED_ACCESS is
871af526226Smrg true), if not already done. */
872af526226Smrg
873af526226Smrg static void
append_withs(const char * s,bool limited_access)8743903d7f3Smrg append_withs (const char *s, bool limited_access)
875af526226Smrg {
876af526226Smrg int i;
877af526226Smrg
878af526226Smrg if (withs == NULL)
879af526226Smrg withs = XNEWVEC (struct with, withs_max);
880af526226Smrg
881af526226Smrg if (with_len == withs_max)
882af526226Smrg {
883af526226Smrg withs_max *= 2;
884af526226Smrg withs = XRESIZEVEC (struct with, withs, withs_max);
885af526226Smrg }
886af526226Smrg
887af526226Smrg for (i = 0; i < with_len; i++)
888af526226Smrg if (!strcmp (s, withs[i].s)
8893903d7f3Smrg && current_source_file == withs[i].in_file)
890af526226Smrg {
891af526226Smrg withs[i].limited &= limited_access;
892af526226Smrg return;
893af526226Smrg }
894af526226Smrg
895af526226Smrg withs[with_len].s = xstrdup (s);
8963903d7f3Smrg withs[with_len].in_file = current_source_file;
897af526226Smrg withs[with_len].limited = limited_access;
898af526226Smrg with_len++;
899af526226Smrg }
900af526226Smrg
901af526226Smrg /* Reset "with" clauses. */
902af526226Smrg
903af526226Smrg static void
reset_ada_withs(void)904af526226Smrg reset_ada_withs (void)
905af526226Smrg {
906af526226Smrg int i;
907af526226Smrg
908af526226Smrg if (!withs)
909af526226Smrg return;
910af526226Smrg
911af526226Smrg for (i = 0; i < with_len; i++)
912af526226Smrg free (withs[i].s);
913af526226Smrg free (withs);
914af526226Smrg withs = NULL;
915af526226Smrg withs_max = 4096;
916af526226Smrg with_len = 0;
917af526226Smrg }
918af526226Smrg
919af526226Smrg /* Dump "with" clauses in F. */
920af526226Smrg
921af526226Smrg static void
dump_ada_withs(FILE * f)922af526226Smrg dump_ada_withs (FILE *f)
923af526226Smrg {
924af526226Smrg int i;
925af526226Smrg
926af526226Smrg fprintf (f, "with Interfaces.C; use Interfaces.C;\n");
927af526226Smrg
928af526226Smrg for (i = 0; i < with_len; i++)
929af526226Smrg fprintf
930af526226Smrg (f, "%swith %s;\n", withs[i].limited ? "limited " : "", withs[i].s);
931af526226Smrg }
932af526226Smrg
933af526226Smrg /* Return suitable Ada package name from FILE. */
934af526226Smrg
935af526226Smrg static char *
get_ada_package(const char * file)936af526226Smrg get_ada_package (const char *file)
937af526226Smrg {
938af526226Smrg const char *base;
939af526226Smrg char *res;
940af526226Smrg const char *s;
941af526226Smrg int i;
942af526226Smrg size_t plen;
943af526226Smrg
944af526226Smrg s = strstr (file, "/include/");
945af526226Smrg if (s)
946af526226Smrg base = s + 9;
947af526226Smrg else
948af526226Smrg base = lbasename (file);
949af526226Smrg
950af526226Smrg if (ada_specs_parent == NULL)
951af526226Smrg plen = 0;
952af526226Smrg else
953af526226Smrg plen = strlen (ada_specs_parent) + 1;
954af526226Smrg
955af526226Smrg res = XNEWVEC (char, plen + strlen (base) + 1);
956af526226Smrg if (ada_specs_parent != NULL) {
957af526226Smrg strcpy (res, ada_specs_parent);
958af526226Smrg res[plen - 1] = '.';
959af526226Smrg }
960af526226Smrg
961af526226Smrg for (i = plen; *base; base++, i++)
962af526226Smrg switch (*base)
963af526226Smrg {
964af526226Smrg case '+':
965af526226Smrg res[i] = 'p';
966af526226Smrg break;
967af526226Smrg
968af526226Smrg case '.':
969af526226Smrg case '-':
970af526226Smrg case '_':
971af526226Smrg case '/':
972af526226Smrg case '\\':
973af526226Smrg res[i] = (i == 0 || res[i - 1] == '.' || res[i - 1] == '_') ? 'u' : '_';
974af526226Smrg break;
975af526226Smrg
976af526226Smrg default:
977af526226Smrg res[i] = *base;
978af526226Smrg break;
979af526226Smrg }
980af526226Smrg res[i] = '\0';
981af526226Smrg
982af526226Smrg return res;
983af526226Smrg }
984af526226Smrg
985af526226Smrg static const char *ada_reserved[] = {
986af526226Smrg "abort", "abs", "abstract", "accept", "access", "aliased", "all", "and",
987af526226Smrg "array", "at", "begin", "body", "case", "constant", "declare", "delay",
988af526226Smrg "delta", "digits", "do", "else", "elsif", "end", "entry", "exception",
989af526226Smrg "exit", "for", "function", "generic", "goto", "if", "in", "interface", "is",
990af526226Smrg "limited", "loop", "mod", "new", "not", "null", "others", "out", "of", "or",
991af526226Smrg "overriding", "package", "pragma", "private", "procedure", "protected",
992af526226Smrg "raise", "range", "record", "rem", "renames", "requeue", "return", "reverse",
993af526226Smrg "select", "separate", "subtype", "synchronized", "tagged", "task",
994af526226Smrg "terminate", "then", "type", "until", "use", "when", "while", "with", "xor",
995af526226Smrg NULL};
996af526226Smrg
997af526226Smrg /* ??? would be nice to specify this list via a config file, so that users
998af526226Smrg can create their own dictionary of conflicts. */
999af526226Smrg static const char *c_duplicates[] = {
1000af526226Smrg /* system will cause troubles with System.Address. */
1001af526226Smrg "system",
1002af526226Smrg
1003af526226Smrg /* The following values have other definitions with same name/other
1004af526226Smrg casing. */
1005af526226Smrg "funmap",
1006af526226Smrg "rl_vi_fWord",
1007af526226Smrg "rl_vi_bWord",
1008af526226Smrg "rl_vi_eWord",
1009af526226Smrg "rl_readline_version",
1010af526226Smrg "_Vx_ushort",
1011af526226Smrg "USHORT",
1012af526226Smrg "XLookupKeysym",
1013af526226Smrg NULL};
1014af526226Smrg
1015af526226Smrg /* Return a declaration tree corresponding to TYPE. */
1016af526226Smrg
1017af526226Smrg static tree
get_underlying_decl(tree type)1018af526226Smrg get_underlying_decl (tree type)
1019af526226Smrg {
10206a5c9aabSmrg if (!type)
1021af526226Smrg return NULL_TREE;
1022af526226Smrg
1023af526226Smrg /* type is a declaration. */
1024af526226Smrg if (DECL_P (type))
10256a5c9aabSmrg return type;
1026af526226Smrg
102781418a27Smrg if (TYPE_P (type))
102881418a27Smrg {
102981418a27Smrg /* Strip qualifiers but do not look through typedefs. */
103081418a27Smrg if (TYPE_QUALS_NO_ADDR_SPACE (type))
103181418a27Smrg type = TYPE_MAIN_VARIANT (type);
103281418a27Smrg
1033af526226Smrg /* type is a typedef. */
103481418a27Smrg if (TYPE_NAME (type) && DECL_P (TYPE_NAME (type)))
10356a5c9aabSmrg return TYPE_NAME (type);
1036af526226Smrg
1037af526226Smrg /* TYPE_STUB_DECL has been set for type. */
103881418a27Smrg if (TYPE_STUB_DECL (type))
10396a5c9aabSmrg return TYPE_STUB_DECL (type);
104081418a27Smrg }
1041af526226Smrg
10426a5c9aabSmrg return NULL_TREE;
1043af526226Smrg }
1044af526226Smrg
1045af526226Smrg /* Return whether TYPE has static fields. */
1046af526226Smrg
10475ef59e75Smrg static bool
has_static_fields(const_tree type)1048af526226Smrg has_static_fields (const_tree type)
1049af526226Smrg {
105081418a27Smrg if (!type || !RECORD_OR_UNION_TYPE_P (type) || !COMPLETE_TYPE_P (type))
10515ef59e75Smrg return false;
10525ef59e75Smrg
10533903d7f3Smrg for (tree fld = TYPE_FIELDS (type); fld; fld = TREE_CHAIN (fld))
10543903d7f3Smrg if (TREE_CODE (fld) == VAR_DECL && DECL_NAME (fld))
1055af526226Smrg return true;
10565ef59e75Smrg
1057af526226Smrg return false;
1058af526226Smrg }
1059af526226Smrg
1060af526226Smrg /* Return whether TYPE corresponds to an Ada tagged type (has a dispatch
1061af526226Smrg table). */
1062af526226Smrg
10635ef59e75Smrg static bool
is_tagged_type(const_tree type)1064af526226Smrg is_tagged_type (const_tree type)
1065af526226Smrg {
106681418a27Smrg if (!type || !RECORD_OR_UNION_TYPE_P (type) || !COMPLETE_TYPE_P (type))
1067af526226Smrg return false;
1068af526226Smrg
10693903d7f3Smrg for (tree fld = TYPE_FIELDS (type); fld; fld = TREE_CHAIN (fld))
10703903d7f3Smrg if (TREE_CODE (fld) == FUNCTION_DECL && DECL_VINDEX (fld))
10715ef59e75Smrg return true;
10725ef59e75Smrg
10735ef59e75Smrg return false;
10745ef59e75Smrg }
10755ef59e75Smrg
10765ef59e75Smrg /* Return whether TYPE has non-trivial methods, i.e. methods that do something
10775ef59e75Smrg for the objects of TYPE. In C++, all classes have implicit special methods,
10785ef59e75Smrg e.g. constructors and destructors, but they can be trivial if the type is
10795ef59e75Smrg sufficiently simple. */
10805ef59e75Smrg
10815ef59e75Smrg static bool
has_nontrivial_methods(tree type)10825ef59e75Smrg has_nontrivial_methods (tree type)
10835ef59e75Smrg {
108481418a27Smrg if (!type || !RECORD_OR_UNION_TYPE_P (type) || !COMPLETE_TYPE_P (type))
10855ef59e75Smrg return false;
10865ef59e75Smrg
10875ef59e75Smrg /* Only C++ types can have methods. */
10885ef59e75Smrg if (!cpp_check)
10895ef59e75Smrg return false;
10905ef59e75Smrg
10915ef59e75Smrg /* A non-trivial type has non-trivial special methods. */
10925ef59e75Smrg if (!cpp_check (type, IS_TRIVIAL))
10935ef59e75Smrg return true;
10945ef59e75Smrg
10955ef59e75Smrg /* If there are user-defined methods, they are deemed non-trivial. */
10963903d7f3Smrg for (tree fld = TYPE_FIELDS (type); fld; fld = DECL_CHAIN (fld))
10973903d7f3Smrg if (TREE_CODE (fld) == FUNCTION_DECL && !DECL_ARTIFICIAL (fld))
1098af526226Smrg return true;
1099af526226Smrg
1100af526226Smrg return false;
1101af526226Smrg }
1102af526226Smrg
11033903d7f3Smrg #define INDEX_LENGTH 8
11043903d7f3Smrg
11053903d7f3Smrg /* Generate a legal Ada name from a C/C++ NAME and return a malloc'ed string.
110681418a27Smrg SPACE_FOUND, if not NULL, is used to indicate whether a space was found in
110781418a27Smrg NAME. */
1108af526226Smrg
1109af526226Smrg static char *
to_ada_name(const char * name,bool * space_found)111081418a27Smrg to_ada_name (const char *name, bool *space_found)
1111af526226Smrg {
1112af526226Smrg const char **names;
11133903d7f3Smrg const int len = strlen (name);
1114af526226Smrg int j, len2 = 0;
11153903d7f3Smrg bool found = false;
111681418a27Smrg char *s = XNEWVEC (char, len * 2 + 5);
1117af526226Smrg char c;
1118af526226Smrg
1119af526226Smrg if (space_found)
1120af526226Smrg *space_found = false;
1121af526226Smrg
11223903d7f3Smrg /* Add "c_" prefix if name is an Ada reserved word. */
1123af526226Smrg for (names = ada_reserved; *names; names++)
1124af526226Smrg if (!strcasecmp (name, *names))
1125af526226Smrg {
1126af526226Smrg s[len2++] = 'c';
1127af526226Smrg s[len2++] = '_';
1128af526226Smrg found = true;
1129af526226Smrg break;
1130af526226Smrg }
1131af526226Smrg
1132af526226Smrg if (!found)
11333903d7f3Smrg /* Add "c_" prefix if name is a potential case sensitive duplicate. */
1134af526226Smrg for (names = c_duplicates; *names; names++)
1135af526226Smrg if (!strcmp (name, *names))
1136af526226Smrg {
1137af526226Smrg s[len2++] = 'c';
1138af526226Smrg s[len2++] = '_';
1139af526226Smrg found = true;
1140af526226Smrg break;
1141af526226Smrg }
1142af526226Smrg
1143af526226Smrg for (j = 0; name[j] == '_'; j++)
1144af526226Smrg s[len2++] = 'u';
1145af526226Smrg
1146af526226Smrg if (j > 0)
1147af526226Smrg s[len2++] = '_';
1148af526226Smrg else if (*name == '.' || *name == '$')
1149af526226Smrg {
1150af526226Smrg s[0] = 'a';
1151af526226Smrg s[1] = 'n';
1152af526226Smrg s[2] = 'o';
1153af526226Smrg s[3] = 'n';
1154af526226Smrg len2 = 4;
1155af526226Smrg j++;
1156af526226Smrg }
1157af526226Smrg
1158af526226Smrg /* Replace unsuitable characters for Ada identifiers. */
1159af526226Smrg for (; j < len; j++)
1160af526226Smrg switch (name[j])
1161af526226Smrg {
1162af526226Smrg case ' ':
1163af526226Smrg if (space_found)
1164af526226Smrg *space_found = true;
1165af526226Smrg s[len2++] = '_';
1166af526226Smrg break;
1167af526226Smrg
1168af526226Smrg /* ??? missing some C++ operators. */
1169af526226Smrg case '=':
1170af526226Smrg s[len2++] = '_';
1171af526226Smrg
1172af526226Smrg if (name[j + 1] == '=')
1173af526226Smrg {
1174af526226Smrg j++;
1175af526226Smrg s[len2++] = 'e';
1176af526226Smrg s[len2++] = 'q';
1177af526226Smrg }
1178af526226Smrg else
1179af526226Smrg {
1180af526226Smrg s[len2++] = 'a';
1181af526226Smrg s[len2++] = 's';
1182af526226Smrg }
1183af526226Smrg break;
1184af526226Smrg
1185af526226Smrg case '!':
1186af526226Smrg s[len2++] = '_';
1187af526226Smrg if (name[j + 1] == '=')
1188af526226Smrg {
1189af526226Smrg j++;
1190af526226Smrg s[len2++] = 'n';
1191af526226Smrg s[len2++] = 'e';
1192af526226Smrg }
1193af526226Smrg break;
1194af526226Smrg
1195af526226Smrg case '~':
1196af526226Smrg s[len2++] = '_';
1197af526226Smrg s[len2++] = 't';
1198af526226Smrg s[len2++] = 'i';
1199af526226Smrg break;
1200af526226Smrg
1201af526226Smrg case '&':
1202af526226Smrg case '|':
1203af526226Smrg case '^':
1204af526226Smrg s[len2++] = '_';
1205af526226Smrg s[len2++] = name[j] == '&' ? 'a' : name[j] == '|' ? 'o' : 'x';
1206af526226Smrg
1207af526226Smrg if (name[j + 1] == '=')
1208af526226Smrg {
1209af526226Smrg j++;
1210af526226Smrg s[len2++] = 'e';
1211af526226Smrg }
1212af526226Smrg break;
1213af526226Smrg
1214af526226Smrg case '+':
1215af526226Smrg case '-':
1216af526226Smrg case '*':
1217af526226Smrg case '/':
1218af526226Smrg case '(':
1219af526226Smrg case '[':
1220af526226Smrg if (s[len2 - 1] != '_')
1221af526226Smrg s[len2++] = '_';
1222af526226Smrg
1223af526226Smrg switch (name[j + 1]) {
1224af526226Smrg case '\0':
1225af526226Smrg j++;
1226af526226Smrg switch (name[j - 1]) {
1227af526226Smrg case '+': s[len2++] = 'p'; break; /* + */
1228af526226Smrg case '-': s[len2++] = 'm'; break; /* - */
1229af526226Smrg case '*': s[len2++] = 't'; break; /* * */
1230af526226Smrg case '/': s[len2++] = 'd'; break; /* / */
1231af526226Smrg }
1232af526226Smrg break;
1233af526226Smrg
1234af526226Smrg case '=':
1235af526226Smrg j++;
1236af526226Smrg switch (name[j - 1]) {
1237af526226Smrg case '+': s[len2++] = 'p'; break; /* += */
1238af526226Smrg case '-': s[len2++] = 'm'; break; /* -= */
1239af526226Smrg case '*': s[len2++] = 't'; break; /* *= */
1240af526226Smrg case '/': s[len2++] = 'd'; break; /* /= */
1241af526226Smrg }
1242af526226Smrg s[len2++] = 'a';
1243af526226Smrg break;
1244af526226Smrg
1245af526226Smrg case '-': /* -- */
1246af526226Smrg j++;
1247af526226Smrg s[len2++] = 'm';
1248af526226Smrg s[len2++] = 'm';
1249af526226Smrg break;
1250af526226Smrg
1251af526226Smrg case '+': /* ++ */
1252af526226Smrg j++;
1253af526226Smrg s[len2++] = 'p';
1254af526226Smrg s[len2++] = 'p';
1255af526226Smrg break;
1256af526226Smrg
1257af526226Smrg case ')': /* () */
1258af526226Smrg j++;
1259af526226Smrg s[len2++] = 'o';
1260af526226Smrg s[len2++] = 'p';
1261af526226Smrg break;
1262af526226Smrg
1263af526226Smrg case ']': /* [] */
1264af526226Smrg j++;
1265af526226Smrg s[len2++] = 'o';
1266af526226Smrg s[len2++] = 'b';
1267af526226Smrg break;
1268af526226Smrg }
1269af526226Smrg
1270af526226Smrg break;
1271af526226Smrg
1272af526226Smrg case '<':
1273af526226Smrg case '>':
1274af526226Smrg c = name[j] == '<' ? 'l' : 'g';
1275af526226Smrg s[len2++] = '_';
1276af526226Smrg
1277af526226Smrg switch (name[j + 1]) {
1278af526226Smrg case '\0':
1279af526226Smrg s[len2++] = c;
1280af526226Smrg s[len2++] = 't';
1281af526226Smrg break;
1282af526226Smrg case '=':
1283af526226Smrg j++;
1284af526226Smrg s[len2++] = c;
1285af526226Smrg s[len2++] = 'e';
1286af526226Smrg break;
1287af526226Smrg case '>':
1288af526226Smrg j++;
1289af526226Smrg s[len2++] = 's';
1290af526226Smrg s[len2++] = 'r';
1291af526226Smrg break;
1292af526226Smrg case '<':
1293af526226Smrg j++;
1294af526226Smrg s[len2++] = 's';
1295af526226Smrg s[len2++] = 'l';
1296af526226Smrg break;
1297af526226Smrg default:
1298af526226Smrg break;
1299af526226Smrg }
1300af526226Smrg break;
1301af526226Smrg
1302af526226Smrg case '_':
1303af526226Smrg if (len2 && s[len2 - 1] == '_')
1304af526226Smrg s[len2++] = 'u';
1305af526226Smrg /* fall through */
1306af526226Smrg
1307af526226Smrg default:
1308af526226Smrg s[len2++] = name[j];
1309af526226Smrg }
1310af526226Smrg
1311af526226Smrg if (s[len2 - 1] == '_')
1312af526226Smrg s[len2++] = 'u';
1313af526226Smrg
1314af526226Smrg s[len2] = '\0';
1315af526226Smrg
1316af526226Smrg return s;
1317af526226Smrg }
1318af526226Smrg
1319af526226Smrg /* Return true if DECL refers to a C++ class type for which a
1320af526226Smrg separate enclosing package has been or should be generated. */
1321af526226Smrg
1322af526226Smrg static bool
separate_class_package(tree decl)1323af526226Smrg separate_class_package (tree decl)
1324af526226Smrg {
1325af526226Smrg tree type = TREE_TYPE (decl);
13265ef59e75Smrg return has_nontrivial_methods (type) || has_static_fields (type);
1327af526226Smrg }
1328af526226Smrg
1329af526226Smrg static bool package_prefix = true;
1330af526226Smrg
1331af526226Smrg /* Dump in BUFFER the name of an identifier NODE of type TYPE, following Ada
133281418a27Smrg syntax. LIMITED_ACCESS indicates whether NODE can be accessed through a
133381418a27Smrg limited 'with' clause rather than a regular 'with' clause. */
1334af526226Smrg
1335af526226Smrg static void
pp_ada_tree_identifier(pretty_printer * buffer,tree node,tree type,bool limited_access)1336af526226Smrg pp_ada_tree_identifier (pretty_printer *buffer, tree node, tree type,
133781418a27Smrg bool limited_access)
1338af526226Smrg {
1339af526226Smrg const char *name = IDENTIFIER_POINTER (node);
13403903d7f3Smrg bool space_found = false;
134181418a27Smrg char *s = to_ada_name (name, &space_found);
13423903d7f3Smrg tree decl = get_underlying_decl (type);
1343af526226Smrg
13443903d7f3Smrg /* If the entity comes from another file, generate a package prefix. */
1345af526226Smrg if (decl)
1346af526226Smrg {
1347af526226Smrg expanded_location xloc = expand_location (decl_sloc (decl, false));
1348af526226Smrg
1349af526226Smrg if (xloc.file && xloc.line)
1350af526226Smrg {
13513903d7f3Smrg if (xloc.file != current_source_file)
1352af526226Smrg {
1353af526226Smrg switch (TREE_CODE (type))
1354af526226Smrg {
1355af526226Smrg case ENUMERAL_TYPE:
1356af526226Smrg case INTEGER_TYPE:
1357af526226Smrg case REAL_TYPE:
1358af526226Smrg case FIXED_POINT_TYPE:
1359af526226Smrg case BOOLEAN_TYPE:
1360af526226Smrg case REFERENCE_TYPE:
1361af526226Smrg case POINTER_TYPE:
1362af526226Smrg case ARRAY_TYPE:
1363af526226Smrg case RECORD_TYPE:
1364af526226Smrg case UNION_TYPE:
1365af526226Smrg case TYPE_DECL:
1366af526226Smrg if (package_prefix)
1367af526226Smrg {
13685ef59e75Smrg char *s1 = get_ada_package (xloc.file);
1369af526226Smrg append_withs (s1, limited_access);
1370af526226Smrg pp_string (buffer, s1);
13715ef59e75Smrg pp_dot (buffer);
1372af526226Smrg free (s1);
1373af526226Smrg }
1374af526226Smrg break;
1375af526226Smrg default:
1376af526226Smrg break;
1377af526226Smrg }
1378af526226Smrg
13795ef59e75Smrg /* Generate the additional package prefix for C++ classes. */
1380af526226Smrg if (separate_class_package (decl))
1381af526226Smrg {
1382af526226Smrg pp_string (buffer, "Class_");
1383af526226Smrg pp_string (buffer, s);
13845ef59e75Smrg pp_dot (buffer);
1385af526226Smrg }
1386af526226Smrg }
1387af526226Smrg }
1388af526226Smrg }
1389af526226Smrg
1390af526226Smrg if (space_found)
1391af526226Smrg if (!strcmp (s, "short_int"))
1392af526226Smrg pp_string (buffer, "short");
1393af526226Smrg else if (!strcmp (s, "short_unsigned_int"))
1394af526226Smrg pp_string (buffer, "unsigned_short");
1395af526226Smrg else if (!strcmp (s, "unsigned_int"))
1396af526226Smrg pp_string (buffer, "unsigned");
1397af526226Smrg else if (!strcmp (s, "long_int"))
1398af526226Smrg pp_string (buffer, "long");
1399af526226Smrg else if (!strcmp (s, "long_unsigned_int"))
1400af526226Smrg pp_string (buffer, "unsigned_long");
1401af526226Smrg else if (!strcmp (s, "long_long_int"))
1402af526226Smrg pp_string (buffer, "Long_Long_Integer");
1403af526226Smrg else if (!strcmp (s, "long_long_unsigned_int"))
1404af526226Smrg {
1405af526226Smrg if (package_prefix)
1406af526226Smrg {
1407af526226Smrg append_withs ("Interfaces.C.Extensions", false);
1408af526226Smrg pp_string (buffer, "Extensions.unsigned_long_long");
1409af526226Smrg }
1410af526226Smrg else
1411af526226Smrg pp_string (buffer, "unsigned_long_long");
1412af526226Smrg }
1413af526226Smrg else
1414af526226Smrg pp_string(buffer, s);
1415af526226Smrg else
14163903d7f3Smrg if (!strcmp (s, "u_Bool") || !strcmp (s, "bool"))
1417af526226Smrg {
1418af526226Smrg if (package_prefix)
1419af526226Smrg {
1420af526226Smrg append_withs ("Interfaces.C.Extensions", false);
1421af526226Smrg pp_string (buffer, "Extensions.bool");
1422af526226Smrg }
1423af526226Smrg else
1424af526226Smrg pp_string (buffer, "bool");
1425af526226Smrg }
1426af526226Smrg else
1427af526226Smrg pp_string(buffer, s);
1428af526226Smrg
1429af526226Smrg free (s);
1430af526226Smrg }
1431af526226Smrg
1432af526226Smrg /* Dump in BUFFER the assembly name of T. */
1433af526226Smrg
1434af526226Smrg static void
pp_asm_name(pretty_printer * buffer,tree t)1435af526226Smrg pp_asm_name (pretty_printer *buffer, tree t)
1436af526226Smrg {
1437af526226Smrg tree name = DECL_ASSEMBLER_NAME (t);
1438af526226Smrg char *ada_name = XALLOCAVEC (char, IDENTIFIER_LENGTH (name) + 1), *s;
1439af526226Smrg const char *ident = IDENTIFIER_POINTER (name);
1440af526226Smrg
1441af526226Smrg for (s = ada_name; *ident; ident++)
1442af526226Smrg {
1443af526226Smrg if (*ident == ' ')
1444af526226Smrg break;
1445af526226Smrg else if (*ident != '*')
1446af526226Smrg *s++ = *ident;
1447af526226Smrg }
1448af526226Smrg
1449af526226Smrg *s = '\0';
1450af526226Smrg pp_string (buffer, ada_name);
1451af526226Smrg }
1452af526226Smrg
14533903d7f3Smrg /* Dump in BUFFER the name of a DECL node if set, in Ada syntax.
14543903d7f3Smrg LIMITED_ACCESS indicates whether NODE can be accessed via a
14553903d7f3Smrg limited 'with' clause rather than a regular 'with' clause. */
1456af526226Smrg
1457af526226Smrg static void
dump_ada_decl_name(pretty_printer * buffer,tree decl,bool limited_access)14583903d7f3Smrg dump_ada_decl_name (pretty_printer *buffer, tree decl, bool limited_access)
1459af526226Smrg {
1460af526226Smrg if (DECL_NAME (decl))
146181418a27Smrg pp_ada_tree_identifier (buffer, DECL_NAME (decl), decl, limited_access);
1462af526226Smrg else
1463af526226Smrg {
1464af526226Smrg tree type_name = TYPE_NAME (TREE_TYPE (decl));
1465af526226Smrg
1466af526226Smrg if (!type_name)
1467af526226Smrg {
1468af526226Smrg pp_string (buffer, "anon");
1469af526226Smrg if (TREE_CODE (decl) == FIELD_DECL)
1470af526226Smrg pp_scalar (buffer, "%d", DECL_UID (decl));
1471af526226Smrg else
1472af526226Smrg pp_scalar (buffer, "%d", TYPE_UID (TREE_TYPE (decl)));
1473af526226Smrg }
1474af526226Smrg else if (TREE_CODE (type_name) == IDENTIFIER_NODE)
147581418a27Smrg pp_ada_tree_identifier (buffer, type_name, decl, limited_access);
1476af526226Smrg }
1477af526226Smrg }
1478af526226Smrg
1479*8d286336Smrg /* Dump in BUFFER a name for the type T, which is a _TYPE without TYPE_NAME.
1480*8d286336Smrg PARENT is the parent node of T. */
1481af526226Smrg
1482af526226Smrg static void
dump_anonymous_type_name(pretty_printer * buffer,tree t,tree parent)1483*8d286336Smrg dump_anonymous_type_name (pretty_printer *buffer, tree t, tree parent)
1484af526226Smrg {
1485*8d286336Smrg if (DECL_NAME (parent))
1486*8d286336Smrg pp_ada_tree_identifier (buffer, DECL_NAME (parent), parent, false);
1487af526226Smrg else
1488af526226Smrg {
1489af526226Smrg pp_string (buffer, "anon");
1490*8d286336Smrg pp_scalar (buffer, "%d", TYPE_UID (TREE_TYPE (parent)));
1491af526226Smrg }
1492af526226Smrg
1493*8d286336Smrg switch (TREE_CODE (t))
149463aace61Smrg {
149563aace61Smrg case ARRAY_TYPE:
149663aace61Smrg pp_string (buffer, "_array");
149763aace61Smrg break;
14983903d7f3Smrg case ENUMERAL_TYPE:
14993903d7f3Smrg pp_string (buffer, "_enum");
15003903d7f3Smrg break;
150163aace61Smrg case RECORD_TYPE:
150263aace61Smrg pp_string (buffer, "_struct");
150363aace61Smrg break;
150463aace61Smrg case UNION_TYPE:
150563aace61Smrg pp_string (buffer, "_union");
150663aace61Smrg break;
150763aace61Smrg default:
150863aace61Smrg pp_string (buffer, "_unknown");
150963aace61Smrg break;
151063aace61Smrg }
1511*8d286336Smrg
1512*8d286336Smrg pp_scalar (buffer, "%d", TYPE_UID (t));
1513af526226Smrg }
1514af526226Smrg
151581418a27Smrg /* Dump in BUFFER aspect Import on a given node T. SPC is the current
151681418a27Smrg indentation level. */
1517af526226Smrg
1518af526226Smrg static void
dump_ada_import(pretty_printer * buffer,tree t,int spc)151981418a27Smrg dump_ada_import (pretty_printer *buffer, tree t, int spc)
1520af526226Smrg {
1521af526226Smrg const char *name = IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (t));
15223903d7f3Smrg const bool is_stdcall
15233903d7f3Smrg = TREE_CODE (t) == FUNCTION_DECL
15243903d7f3Smrg && lookup_attribute ("stdcall", TYPE_ATTRIBUTES (TREE_TYPE (t)));
1525af526226Smrg
152681418a27Smrg pp_string (buffer, "with Import => True, ");
1527af526226Smrg
152881418a27Smrg newline_and_indent (buffer, spc + 5);
152981418a27Smrg
153081418a27Smrg if (is_stdcall)
153181418a27Smrg pp_string (buffer, "Convention => Stdcall, ");
153281418a27Smrg else if (name[0] == '_' && name[1] == 'Z')
153381418a27Smrg pp_string (buffer, "Convention => CPP, ");
153481418a27Smrg else
153581418a27Smrg pp_string (buffer, "Convention => C, ");
153681418a27Smrg
153781418a27Smrg newline_and_indent (buffer, spc + 5);
153881418a27Smrg
153981418a27Smrg pp_string (buffer, "External_Name => \"");
1540af526226Smrg
1541af526226Smrg if (is_stdcall)
1542af526226Smrg pp_string (buffer, IDENTIFIER_POINTER (DECL_NAME (t)));
1543af526226Smrg else
1544af526226Smrg pp_asm_name (buffer, t);
1545af526226Smrg
154681418a27Smrg pp_string (buffer, "\";");
1547af526226Smrg }
1548af526226Smrg
1549af526226Smrg /* Check whether T and its type have different names, and append "the_"
1550af526226Smrg otherwise in BUFFER. */
1551af526226Smrg
1552af526226Smrg static void
check_name(pretty_printer * buffer,tree t)1553af526226Smrg check_name (pretty_printer *buffer, tree t)
1554af526226Smrg {
1555af526226Smrg const char *s;
1556af526226Smrg tree tmp = TREE_TYPE (t);
1557af526226Smrg
1558af526226Smrg while (TREE_CODE (tmp) == POINTER_TYPE && !TYPE_NAME (tmp))
1559af526226Smrg tmp = TREE_TYPE (tmp);
1560af526226Smrg
1561af526226Smrg if (TREE_CODE (tmp) != FUNCTION_TYPE)
1562af526226Smrg {
1563af526226Smrg if (TREE_CODE (tmp) == IDENTIFIER_NODE)
1564af526226Smrg s = IDENTIFIER_POINTER (tmp);
1565af526226Smrg else if (!TYPE_NAME (tmp))
1566af526226Smrg s = "";
1567af526226Smrg else if (TREE_CODE (TYPE_NAME (tmp)) == IDENTIFIER_NODE)
1568af526226Smrg s = IDENTIFIER_POINTER (TYPE_NAME (tmp));
1569af526226Smrg else
1570af526226Smrg s = IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp)));
1571af526226Smrg
1572af526226Smrg if (!strcasecmp (IDENTIFIER_POINTER (DECL_NAME (t)), s))
1573af526226Smrg pp_string (buffer, "the_");
1574af526226Smrg }
1575af526226Smrg }
1576af526226Smrg
15773903d7f3Smrg /* Dump in BUFFER a function declaration FUNC in Ada syntax.
1578af526226Smrg IS_METHOD indicates whether FUNC is a C++ method.
1579af526226Smrg IS_CONSTRUCTOR whether FUNC is a C++ constructor.
1580af526226Smrg IS_DESTRUCTOR whether FUNC is a C++ destructor.
1581af526226Smrg SPC is the current indentation level. */
1582af526226Smrg
15833903d7f3Smrg static void
dump_ada_function_declaration(pretty_printer * buffer,tree func,bool is_method,bool is_constructor,bool is_destructor,int spc)1584af526226Smrg dump_ada_function_declaration (pretty_printer *buffer, tree func,
15853903d7f3Smrg bool is_method, bool is_constructor,
15863903d7f3Smrg bool is_destructor, int spc)
1587af526226Smrg {
1588*8d286336Smrg tree type = TREE_TYPE (func);
1589*8d286336Smrg tree arg = TYPE_ARG_TYPES (type);
1590*8d286336Smrg tree t;
15916a5c9aabSmrg char buf[17];
1592*8d286336Smrg int num, num_args = 0, have_args = true, have_ellipsis = false;
1593af526226Smrg
1594af526226Smrg /* Compute number of arguments. */
1595af526226Smrg if (arg)
1596af526226Smrg {
1597af526226Smrg while (TREE_CHAIN (arg) && arg != error_mark_node)
1598af526226Smrg {
1599af526226Smrg num_args++;
1600af526226Smrg arg = TREE_CHAIN (arg);
1601af526226Smrg }
1602af526226Smrg
1603af526226Smrg if (TREE_CODE (TREE_VALUE (arg)) != VOID_TYPE)
1604af526226Smrg {
1605af526226Smrg num_args++;
1606af526226Smrg have_ellipsis = true;
1607af526226Smrg }
1608af526226Smrg }
1609af526226Smrg
1610af526226Smrg if (is_constructor)
1611af526226Smrg num_args--;
1612af526226Smrg
1613af526226Smrg if (is_destructor)
1614af526226Smrg num_args = 1;
1615af526226Smrg
1616af526226Smrg if (num_args > 2)
1617af526226Smrg newline_and_indent (buffer, spc + 1);
1618af526226Smrg
1619af526226Smrg if (num_args > 0)
1620af526226Smrg {
1621af526226Smrg pp_space (buffer);
16225ef59e75Smrg pp_left_paren (buffer);
1623af526226Smrg }
1624af526226Smrg
1625*8d286336Smrg /* For a function, see if we have the corresponding arguments. */
1626af526226Smrg if (TREE_CODE (func) == FUNCTION_DECL)
1627*8d286336Smrg {
1628af526226Smrg arg = DECL_ARGUMENTS (func);
1629*8d286336Smrg for (t = arg, num = 0; t; t = DECL_CHAIN (t))
1630*8d286336Smrg num++;
1631*8d286336Smrg if (num < num_args)
1632*8d286336Smrg arg = NULL_TREE;
1633*8d286336Smrg }
1634af526226Smrg else
1635af526226Smrg arg = NULL_TREE;
1636af526226Smrg
1637*8d286336Smrg /* Otherwise, only print the types. */
1638*8d286336Smrg if (!arg)
1639af526226Smrg {
1640af526226Smrg have_args = false;
1641*8d286336Smrg arg = TYPE_ARG_TYPES (type);
1642af526226Smrg }
1643af526226Smrg
1644af526226Smrg if (is_constructor)
1645af526226Smrg arg = TREE_CHAIN (arg);
1646af526226Smrg
1647*8d286336Smrg /* Print the argument names (if available) and types. */
1648af526226Smrg for (num = 1; num <= num_args; num++)
1649af526226Smrg {
1650af526226Smrg if (have_args)
1651af526226Smrg {
1652af526226Smrg if (DECL_NAME (arg))
1653af526226Smrg {
1654af526226Smrg check_name (buffer, arg);
165581418a27Smrg pp_ada_tree_identifier (buffer, DECL_NAME (arg), NULL_TREE,
16563903d7f3Smrg false);
1657af526226Smrg pp_string (buffer, " : ");
1658af526226Smrg }
1659af526226Smrg else
1660af526226Smrg {
1661af526226Smrg sprintf (buf, "arg%d : ", num);
1662af526226Smrg pp_string (buffer, buf);
1663af526226Smrg }
1664af526226Smrg
1665*8d286336Smrg dump_ada_node (buffer, TREE_TYPE (arg), type, spc, false, true);
1666af526226Smrg }
1667af526226Smrg else
1668af526226Smrg {
1669af526226Smrg sprintf (buf, "arg%d : ", num);
1670af526226Smrg pp_string (buffer, buf);
1671*8d286336Smrg dump_ada_node (buffer, TREE_VALUE (arg), type, spc, false, true);
1672af526226Smrg }
1673af526226Smrg
16746a5c9aabSmrg /* If the type is a pointer to a tagged type, we need to differentiate
16756a5c9aabSmrg virtual methods from the rest (non-virtual methods, static member
16766a5c9aabSmrg or regular functions) and import only them as primitive operations,
16776a5c9aabSmrg because they make up the virtual table which is mirrored on the Ada
16786a5c9aabSmrg side by the dispatch table. So we add 'Class to the type of every
16796a5c9aabSmrg parameter that is not the first one of a method which either has a
16806a5c9aabSmrg slot in the virtual table or is a constructor. */
16816a5c9aabSmrg if (TREE_TYPE (arg)
16826a5c9aabSmrg && POINTER_TYPE_P (TREE_TYPE (arg))
16836a5c9aabSmrg && is_tagged_type (TREE_TYPE (TREE_TYPE (arg)))
16846a5c9aabSmrg && !(num == 1 && is_method && (DECL_VINDEX (func) || is_constructor)))
1685af526226Smrg pp_string (buffer, "'Class");
1686af526226Smrg
1687af526226Smrg arg = TREE_CHAIN (arg);
1688af526226Smrg
1689af526226Smrg if (num < num_args)
1690af526226Smrg {
16915ef59e75Smrg pp_semicolon (buffer);
1692af526226Smrg
1693af526226Smrg if (num_args > 2)
1694af526226Smrg newline_and_indent (buffer, spc + INDENT_INCR);
1695af526226Smrg else
1696af526226Smrg pp_space (buffer);
1697af526226Smrg }
1698af526226Smrg }
1699af526226Smrg
1700af526226Smrg if (have_ellipsis)
1701af526226Smrg {
1702af526226Smrg pp_string (buffer, " -- , ...");
1703af526226Smrg newline_and_indent (buffer, spc + INDENT_INCR);
1704af526226Smrg }
1705af526226Smrg
1706af526226Smrg if (num_args > 0)
17075ef59e75Smrg pp_right_paren (buffer);
17083903d7f3Smrg
1709*8d286336Smrg if (is_constructor || !VOID_TYPE_P (TREE_TYPE (type)))
17103903d7f3Smrg {
17113903d7f3Smrg pp_string (buffer, " return ");
1712*8d286336Smrg tree rtype = is_constructor ? DECL_CONTEXT (func) : TREE_TYPE (type);
1713*8d286336Smrg dump_ada_node (buffer, rtype, rtype, spc, false, true);
17143903d7f3Smrg }
1715af526226Smrg }
1716af526226Smrg
1717af526226Smrg /* Dump in BUFFER all the domains associated with an array NODE,
17183903d7f3Smrg in Ada syntax. SPC is the current indentation level. */
1719af526226Smrg
1720af526226Smrg static void
dump_ada_array_domains(pretty_printer * buffer,tree node,int spc)1721af526226Smrg dump_ada_array_domains (pretty_printer *buffer, tree node, int spc)
1722af526226Smrg {
1723af526226Smrg int first = 1;
17245ef59e75Smrg pp_left_paren (buffer);
1725af526226Smrg
1726af526226Smrg for (; TREE_CODE (node) == ARRAY_TYPE; node = TREE_TYPE (node))
1727af526226Smrg {
1728af526226Smrg tree domain = TYPE_DOMAIN (node);
1729af526226Smrg
1730af526226Smrg if (domain)
1731af526226Smrg {
1732af526226Smrg tree min = TYPE_MIN_VALUE (domain);
1733af526226Smrg tree max = TYPE_MAX_VALUE (domain);
1734af526226Smrg
1735af526226Smrg if (!first)
1736af526226Smrg pp_string (buffer, ", ");
1737af526226Smrg first = 0;
1738af526226Smrg
1739af526226Smrg if (min)
17403903d7f3Smrg dump_ada_node (buffer, min, NULL_TREE, spc, false, true);
1741af526226Smrg pp_string (buffer, " .. ");
1742af526226Smrg
1743af526226Smrg /* If the upper bound is zero, gcc may generate a NULL_TREE
1744af526226Smrg for TYPE_MAX_VALUE rather than an integer_cst. */
1745af526226Smrg if (max)
17463903d7f3Smrg dump_ada_node (buffer, max, NULL_TREE, spc, false, true);
1747af526226Smrg else
1748af526226Smrg pp_string (buffer, "0");
1749af526226Smrg }
1750af526226Smrg else
1751af526226Smrg pp_string (buffer, "size_t");
1752af526226Smrg }
17535ef59e75Smrg pp_right_paren (buffer);
1754af526226Smrg }
1755af526226Smrg
1756af526226Smrg /* Dump in BUFFER file:line information related to NODE. */
1757af526226Smrg
1758af526226Smrg static void
dump_sloc(pretty_printer * buffer,tree node)1759af526226Smrg dump_sloc (pretty_printer *buffer, tree node)
1760af526226Smrg {
1761af526226Smrg expanded_location xloc;
1762af526226Smrg
1763af526226Smrg xloc.file = NULL;
1764af526226Smrg
176563aace61Smrg if (DECL_P (node))
1766af526226Smrg xloc = expand_location (DECL_SOURCE_LOCATION (node));
1767af526226Smrg else if (EXPR_HAS_LOCATION (node))
1768af526226Smrg xloc = expand_location (EXPR_LOCATION (node));
1769af526226Smrg
1770af526226Smrg if (xloc.file)
1771af526226Smrg {
1772af526226Smrg pp_string (buffer, xloc.file);
17735ef59e75Smrg pp_colon (buffer);
1774af526226Smrg pp_decimal_int (buffer, xloc.line);
1775af526226Smrg }
1776af526226Smrg }
1777af526226Smrg
17783903d7f3Smrg /* Return true if type T designates a 1-dimension array of "char". */
1779af526226Smrg
1780af526226Smrg static bool
is_char_array(tree t)1781af526226Smrg is_char_array (tree t)
1782af526226Smrg {
1783af526226Smrg int num_dim = 0;
1784af526226Smrg
17853903d7f3Smrg while (TREE_CODE (t) == ARRAY_TYPE)
1786af526226Smrg {
1787af526226Smrg num_dim++;
17883903d7f3Smrg t = TREE_TYPE (t);
1789af526226Smrg }
1790af526226Smrg
17913903d7f3Smrg return num_dim == 1
17923903d7f3Smrg && TREE_CODE (t) == INTEGER_TYPE
17933903d7f3Smrg && id_equal (DECL_NAME (TYPE_NAME (t)), "char");
1794af526226Smrg }
1795af526226Smrg
17963903d7f3Smrg /* Dump in BUFFER an array type NODE of type TYPE in Ada syntax. SPC is the
17973903d7f3Smrg indentation level. */
1798af526226Smrg
1799af526226Smrg static void
dump_ada_array_type(pretty_printer * buffer,tree node,tree type,int spc)18003903d7f3Smrg dump_ada_array_type (pretty_printer *buffer, tree node, tree type, int spc)
1801af526226Smrg {
18023903d7f3Smrg const bool char_array = is_char_array (node);
1803af526226Smrg
1804af526226Smrg /* Special case char arrays. */
1805af526226Smrg if (char_array)
1806af526226Smrg pp_string (buffer, "Interfaces.C.char_array ");
1807af526226Smrg else
1808af526226Smrg pp_string (buffer, "array ");
1809af526226Smrg
1810af526226Smrg /* Print the dimensions. */
18113903d7f3Smrg dump_ada_array_domains (buffer, node, spc);
1812af526226Smrg
1813*8d286336Smrg /* Print the component type. */
1814af526226Smrg if (!char_array)
1815af526226Smrg {
18163903d7f3Smrg tree tmp = node;
18173903d7f3Smrg while (TREE_CODE (tmp) == ARRAY_TYPE)
18183903d7f3Smrg tmp = TREE_TYPE (tmp);
18193903d7f3Smrg
1820af526226Smrg pp_string (buffer, " of ");
1821af526226Smrg
182263aace61Smrg if (TREE_CODE (tmp) != POINTER_TYPE)
1823af526226Smrg pp_string (buffer, "aliased ");
1824af526226Smrg
1825*8d286336Smrg if (TYPE_NAME (tmp)
1826*8d286336Smrg || (!RECORD_OR_UNION_TYPE_P (tmp)
1827*8d286336Smrg && TREE_CODE (tmp) != ENUMERAL_TYPE))
18283903d7f3Smrg dump_ada_node (buffer, tmp, node, spc, false, true);
1829*8d286336Smrg else if (type)
1830*8d286336Smrg dump_anonymous_type_name (buffer, tmp, type);
1831af526226Smrg }
1832af526226Smrg }
1833af526226Smrg
1834af526226Smrg /* Dump in BUFFER type names associated with a template, each prepended with
18355ef59e75Smrg '_'. TYPES is the TREE_PURPOSE of a DECL_TEMPLATE_INSTANTIATIONS. SPC is
18365ef59e75Smrg the indentation level. */
1837af526226Smrg
1838af526226Smrg static void
dump_template_types(pretty_printer * buffer,tree types,int spc)18395ef59e75Smrg dump_template_types (pretty_printer *buffer, tree types, int spc)
1840af526226Smrg {
18413903d7f3Smrg for (int i = 0; i < TREE_VEC_LENGTH (types); i++)
1842af526226Smrg {
1843af526226Smrg tree elem = TREE_VEC_ELT (types, i);
18445ef59e75Smrg pp_underscore (buffer);
18453903d7f3Smrg
18463903d7f3Smrg if (!dump_ada_node (buffer, elem, NULL_TREE, spc, false, true))
1847af526226Smrg {
1848af526226Smrg pp_string (buffer, "unknown");
1849af526226Smrg pp_scalar (buffer, "%lu", (unsigned long) TREE_HASH (elem));
1850af526226Smrg }
1851af526226Smrg }
1852af526226Smrg }
1853af526226Smrg
1854af526226Smrg /* Dump in BUFFER the contents of all class instantiations associated with
18555ef59e75Smrg a given template T. SPC is the indentation level. */
1856af526226Smrg
1857af526226Smrg static int
dump_ada_template(pretty_printer * buffer,tree t,int spc)18585ef59e75Smrg dump_ada_template (pretty_printer *buffer, tree t, int spc)
1859af526226Smrg {
18605ef59e75Smrg /* DECL_SIZE_UNIT is DECL_TEMPLATE_INSTANTIATIONS in this context. */
18615ef59e75Smrg tree inst = DECL_SIZE_UNIT (t);
18625ef59e75Smrg /* This emulates DECL_TEMPLATE_RESULT in this context. */
18635ef59e75Smrg struct tree_template_decl {
18645ef59e75Smrg struct tree_decl_common common;
18655ef59e75Smrg tree arguments;
18665ef59e75Smrg tree result;
18675ef59e75Smrg };
18685ef59e75Smrg tree result = ((struct tree_template_decl *) t)->result;
1869af526226Smrg int num_inst = 0;
1870af526226Smrg
1871af526226Smrg /* Don't look at template declarations declaring something coming from
1872af526226Smrg another file. This can occur for template friend declarations. */
1873af526226Smrg if (LOCATION_FILE (decl_sloc (result, false))
1874af526226Smrg != LOCATION_FILE (decl_sloc (t, false)))
1875af526226Smrg return 0;
1876af526226Smrg
187763aace61Smrg for (; inst && inst != error_mark_node; inst = TREE_CHAIN (inst))
1878af526226Smrg {
1879af526226Smrg tree types = TREE_PURPOSE (inst);
1880af526226Smrg tree instance = TREE_VALUE (inst);
1881af526226Smrg
1882af526226Smrg if (TREE_VEC_LENGTH (types) == 0)
1883af526226Smrg break;
1884af526226Smrg
18853903d7f3Smrg if (!RECORD_OR_UNION_TYPE_P (instance))
1886af526226Smrg break;
1887af526226Smrg
188863aace61Smrg /* We are interested in concrete template instantiations only: skip
188963aace61Smrg partially specialized nodes. */
189063aace61Smrg if (RECORD_OR_UNION_TYPE_P (instance)
189163aace61Smrg && cpp_check
189263aace61Smrg && cpp_check (instance, HAS_DEPENDENT_TEMPLATE_ARGS))
189363aace61Smrg continue;
189463aace61Smrg
1895af526226Smrg num_inst++;
1896af526226Smrg INDENT (spc);
1897af526226Smrg pp_string (buffer, "package ");
1898af526226Smrg package_prefix = false;
18993903d7f3Smrg dump_ada_node (buffer, instance, t, spc, false, true);
19005ef59e75Smrg dump_template_types (buffer, types, spc);
1901af526226Smrg pp_string (buffer, " is");
1902af526226Smrg spc += INDENT_INCR;
1903af526226Smrg newline_and_indent (buffer, spc);
1904af526226Smrg
1905af526226Smrg TREE_VISITED (get_underlying_decl (instance)) = 1;
1906af526226Smrg pp_string (buffer, "type ");
19073903d7f3Smrg dump_ada_node (buffer, instance, t, spc, false, true);
1908af526226Smrg package_prefix = true;
1909af526226Smrg
1910af526226Smrg if (is_tagged_type (instance))
1911af526226Smrg pp_string (buffer, " is tagged limited ");
1912af526226Smrg else
1913af526226Smrg pp_string (buffer, " is limited ");
1914af526226Smrg
19153903d7f3Smrg dump_ada_node (buffer, instance, t, spc, false, false);
1916af526226Smrg pp_newline (buffer);
1917af526226Smrg spc -= INDENT_INCR;
1918af526226Smrg newline_and_indent (buffer, spc);
1919af526226Smrg
1920af526226Smrg pp_string (buffer, "end;");
1921af526226Smrg newline_and_indent (buffer, spc);
1922af526226Smrg pp_string (buffer, "use ");
1923af526226Smrg package_prefix = false;
19243903d7f3Smrg dump_ada_node (buffer, instance, t, spc, false, true);
19255ef59e75Smrg dump_template_types (buffer, types, spc);
1926af526226Smrg package_prefix = true;
1927af526226Smrg pp_semicolon (buffer);
1928af526226Smrg pp_newline (buffer);
1929af526226Smrg pp_newline (buffer);
1930af526226Smrg }
1931af526226Smrg
1932af526226Smrg return num_inst > 0;
1933af526226Smrg }
1934af526226Smrg
1935af526226Smrg /* Return true if NODE is a simple enum types, that can be mapped to an
1936af526226Smrg Ada enum type directly. */
1937af526226Smrg
1938af526226Smrg static bool
is_simple_enum(tree node)1939af526226Smrg is_simple_enum (tree node)
1940af526226Smrg {
19415ef59e75Smrg HOST_WIDE_INT count = 0;
1942af526226Smrg
19433903d7f3Smrg for (tree value = TYPE_VALUES (node); value; value = TREE_CHAIN (value))
1944af526226Smrg {
1945af526226Smrg tree int_val = TREE_VALUE (value);
1946af526226Smrg
1947af526226Smrg if (TREE_CODE (int_val) != INTEGER_CST)
1948af526226Smrg int_val = DECL_INITIAL (int_val);
1949af526226Smrg
19505ef59e75Smrg if (!tree_fits_shwi_p (int_val))
1951af526226Smrg return false;
19525ef59e75Smrg else if (tree_to_shwi (int_val) != count)
1953af526226Smrg return false;
1954af526226Smrg
1955af526226Smrg count++;
1956af526226Smrg }
1957af526226Smrg
1958af526226Smrg return true;
1959af526226Smrg }
1960af526226Smrg
196181418a27Smrg /* Dump in BUFFER an enumeral type NODE in Ada syntax. SPC is the indentation
196281418a27Smrg level. */
19633903d7f3Smrg
19643903d7f3Smrg static void
dump_ada_enum_type(pretty_printer * buffer,tree node,int spc)196581418a27Smrg dump_ada_enum_type (pretty_printer *buffer, tree node, int spc)
19663903d7f3Smrg {
19673903d7f3Smrg if (is_simple_enum (node))
19683903d7f3Smrg {
19693903d7f3Smrg bool first = true;
19703903d7f3Smrg spc += INDENT_INCR;
19713903d7f3Smrg newline_and_indent (buffer, spc - 1);
19723903d7f3Smrg pp_left_paren (buffer);
19733903d7f3Smrg for (tree value = TYPE_VALUES (node); value; value = TREE_CHAIN (value))
19743903d7f3Smrg {
19753903d7f3Smrg if (first)
19763903d7f3Smrg first = false;
19773903d7f3Smrg else
19783903d7f3Smrg {
19793903d7f3Smrg pp_comma (buffer);
19803903d7f3Smrg newline_and_indent (buffer, spc);
19813903d7f3Smrg }
19823903d7f3Smrg
198381418a27Smrg pp_ada_tree_identifier (buffer, TREE_PURPOSE (value), node, false);
19843903d7f3Smrg }
198581418a27Smrg pp_string (buffer, ")");
19863903d7f3Smrg spc -= INDENT_INCR;
19873903d7f3Smrg newline_and_indent (buffer, spc);
198881418a27Smrg pp_string (buffer, "with Convention => C");
19893903d7f3Smrg }
19903903d7f3Smrg else
19913903d7f3Smrg {
19923903d7f3Smrg if (TYPE_UNSIGNED (node))
19933903d7f3Smrg pp_string (buffer, "unsigned");
19943903d7f3Smrg else
19953903d7f3Smrg pp_string (buffer, "int");
19963903d7f3Smrg for (tree value = TYPE_VALUES (node); value; value = TREE_CHAIN (value))
19973903d7f3Smrg {
19983903d7f3Smrg pp_semicolon (buffer);
19993903d7f3Smrg newline_and_indent (buffer, spc);
20003903d7f3Smrg
200181418a27Smrg pp_ada_tree_identifier (buffer, TREE_PURPOSE (value), node, false);
20023903d7f3Smrg pp_string (buffer, " : constant ");
20033903d7f3Smrg
20043903d7f3Smrg if (TYPE_UNSIGNED (node))
20053903d7f3Smrg pp_string (buffer, "unsigned");
20063903d7f3Smrg else
20073903d7f3Smrg pp_string (buffer, "int");
20083903d7f3Smrg
20093903d7f3Smrg pp_string (buffer, " := ");
20103903d7f3Smrg dump_ada_node (buffer,
20113903d7f3Smrg TREE_CODE (TREE_VALUE (value)) == INTEGER_CST
20123903d7f3Smrg ? TREE_VALUE (value)
20133903d7f3Smrg : DECL_INITIAL (TREE_VALUE (value)),
20143903d7f3Smrg node, spc, false, true);
20153903d7f3Smrg }
20163903d7f3Smrg }
20173903d7f3Smrg }
20183903d7f3Smrg
201981418a27Smrg /* Return true if NODE is the __float128/_Float128 type. */
202081418a27Smrg
202181418a27Smrg static bool
is_float128(tree node)202281418a27Smrg is_float128 (tree node)
202381418a27Smrg {
202481418a27Smrg if (!TYPE_NAME (node) || TREE_CODE (TYPE_NAME (node)) != TYPE_DECL)
202581418a27Smrg return false;
202681418a27Smrg
202781418a27Smrg tree name = DECL_NAME (TYPE_NAME (node));
202881418a27Smrg
202981418a27Smrg if (IDENTIFIER_POINTER (name) [0] != '_')
203081418a27Smrg return false;
203181418a27Smrg
203281418a27Smrg return id_equal (name, "__float128") || id_equal (name, "_Float128");
203381418a27Smrg }
203481418a27Smrg
2035af526226Smrg static bool bitfield_used = false;
2036af526226Smrg
2037af526226Smrg /* Recursively dump in BUFFER Ada declarations corresponding to NODE of type
20385ef59e75Smrg TYPE. SPC is the indentation level. LIMITED_ACCESS indicates whether NODE
20395ef59e75Smrg can be referenced via a "limited with" clause. NAME_ONLY indicates whether
20405ef59e75Smrg we should only dump the name of NODE, instead of its full declaration. */
2041af526226Smrg
2042af526226Smrg static int
dump_ada_node(pretty_printer * buffer,tree node,tree type,int spc,bool limited_access,bool name_only)20433903d7f3Smrg dump_ada_node (pretty_printer *buffer, tree node, tree type, int spc,
20443903d7f3Smrg bool limited_access, bool name_only)
2045af526226Smrg {
2046af526226Smrg if (node == NULL_TREE)
2047af526226Smrg return 0;
2048af526226Smrg
2049af526226Smrg switch (TREE_CODE (node))
2050af526226Smrg {
2051af526226Smrg case ERROR_MARK:
2052af526226Smrg pp_string (buffer, "<<< error >>>");
2053af526226Smrg return 0;
2054af526226Smrg
2055af526226Smrg case IDENTIFIER_NODE:
205681418a27Smrg pp_ada_tree_identifier (buffer, node, type, limited_access);
2057af526226Smrg break;
2058af526226Smrg
2059af526226Smrg case TREE_LIST:
2060af526226Smrg pp_string (buffer, "--- unexpected node: TREE_LIST");
2061af526226Smrg return 0;
2062af526226Smrg
2063af526226Smrg case TREE_BINFO:
20643903d7f3Smrg dump_ada_node (buffer, BINFO_TYPE (node), type, spc, limited_access,
20653903d7f3Smrg name_only);
20666a5c9aabSmrg return 0;
2067af526226Smrg
2068af526226Smrg case TREE_VEC:
2069af526226Smrg pp_string (buffer, "--- unexpected node: TREE_VEC");
2070af526226Smrg return 0;
2071af526226Smrg
20723903d7f3Smrg case NULLPTR_TYPE:
2073af526226Smrg case VOID_TYPE:
2074af526226Smrg if (package_prefix)
2075af526226Smrg {
2076af526226Smrg append_withs ("System", false);
2077af526226Smrg pp_string (buffer, "System.Address");
2078af526226Smrg }
2079af526226Smrg else
2080af526226Smrg pp_string (buffer, "address");
2081af526226Smrg break;
2082af526226Smrg
2083af526226Smrg case VECTOR_TYPE:
2084af526226Smrg pp_string (buffer, "<vector>");
2085af526226Smrg break;
2086af526226Smrg
2087af526226Smrg case COMPLEX_TYPE:
208881418a27Smrg if (is_float128 (TREE_TYPE (node)))
208981418a27Smrg {
209081418a27Smrg append_withs ("Interfaces.C.Extensions", false);
209181418a27Smrg pp_string (buffer, "Extensions.CFloat_128");
209281418a27Smrg }
209381418a27Smrg else
2094af526226Smrg pp_string (buffer, "<complex>");
2095af526226Smrg break;
2096af526226Smrg
2097af526226Smrg case ENUMERAL_TYPE:
2098af526226Smrg if (name_only)
20993903d7f3Smrg dump_ada_node (buffer, TYPE_NAME (node), node, spc, false, true);
2100af526226Smrg else
210181418a27Smrg dump_ada_enum_type (buffer, node, spc);
21025306d544Smrg break;
21030ffa2763Smrg
21045306d544Smrg case REAL_TYPE:
210581418a27Smrg if (is_float128 (node))
21063903d7f3Smrg {
21073903d7f3Smrg append_withs ("Interfaces.C.Extensions", false);
21083903d7f3Smrg pp_string (buffer, "Extensions.Float_128");
21093903d7f3Smrg break;
21103903d7f3Smrg }
21113903d7f3Smrg /* fallthrough */
21123903d7f3Smrg
21133903d7f3Smrg case INTEGER_TYPE:
2114af526226Smrg case FIXED_POINT_TYPE:
2115af526226Smrg case BOOLEAN_TYPE:
211681418a27Smrg if (TYPE_NAME (node)
211781418a27Smrg && !(TREE_CODE (TYPE_NAME (node)) == TYPE_DECL
211881418a27Smrg && !strcmp (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (node))),
211981418a27Smrg "__int128")))
2120af526226Smrg {
2121af526226Smrg if (TREE_CODE (TYPE_NAME (node)) == IDENTIFIER_NODE)
212281418a27Smrg pp_ada_tree_identifier (buffer, TYPE_NAME (node), node,
21233903d7f3Smrg limited_access);
2124af526226Smrg else if (TREE_CODE (TYPE_NAME (node)) == TYPE_DECL
2125af526226Smrg && DECL_NAME (TYPE_NAME (node)))
2126af526226Smrg dump_ada_decl_name (buffer, TYPE_NAME (node), limited_access);
2127af526226Smrg else
2128af526226Smrg pp_string (buffer, "<unnamed type>");
2129af526226Smrg }
2130af526226Smrg else if (TREE_CODE (node) == INTEGER_TYPE)
2131af526226Smrg {
2132af526226Smrg append_withs ("Interfaces.C.Extensions", false);
2133af526226Smrg bitfield_used = true;
2134af526226Smrg
2135af526226Smrg if (TYPE_PRECISION (node) == 1)
2136af526226Smrg pp_string (buffer, "Extensions.Unsigned_1");
2137af526226Smrg else
2138af526226Smrg {
21393903d7f3Smrg pp_string (buffer, TYPE_UNSIGNED (node)
2140af526226Smrg ? "Extensions.Unsigned_"
21413903d7f3Smrg : "Extensions.Signed_");
2142af526226Smrg pp_decimal_int (buffer, TYPE_PRECISION (node));
2143af526226Smrg }
2144af526226Smrg }
2145af526226Smrg else
2146af526226Smrg pp_string (buffer, "<unnamed type>");
2147af526226Smrg break;
2148af526226Smrg
2149af526226Smrg case POINTER_TYPE:
2150af526226Smrg case REFERENCE_TYPE:
2151af526226Smrg if (name_only && TYPE_NAME (node))
21523903d7f3Smrg dump_ada_node (buffer, TYPE_NAME (node), node, spc, limited_access,
21533903d7f3Smrg true);
2154af526226Smrg
2155af526226Smrg else if (TREE_CODE (TREE_TYPE (node)) == FUNCTION_TYPE)
2156af526226Smrg {
21573903d7f3Smrg if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (node))))
21585306d544Smrg pp_string (buffer, "access procedure");
21595306d544Smrg else
21605306d544Smrg pp_string (buffer, "access function");
21615306d544Smrg
21623903d7f3Smrg dump_ada_function_declaration (buffer, node, false, false, false,
21633903d7f3Smrg spc + INDENT_INCR);
2164af526226Smrg
2165af526226Smrg /* If we are dumping the full type, it means we are part of a
216681418a27Smrg type definition and need also a Convention C aspect. */
2167af526226Smrg if (!name_only)
2168af526226Smrg {
2169af526226Smrg newline_and_indent (buffer, spc);
217081418a27Smrg pp_string (buffer, "with Convention => C");
2171af526226Smrg }
2172af526226Smrg }
2173af526226Smrg else
2174af526226Smrg {
217581418a27Smrg const unsigned int quals = TYPE_QUALS (TREE_TYPE (node));
21763903d7f3Smrg bool is_access = false;
2177af526226Smrg
2178af526226Smrg if (VOID_TYPE_P (TREE_TYPE (node)))
2179af526226Smrg {
2180af526226Smrg if (!name_only)
2181af526226Smrg pp_string (buffer, "new ");
2182af526226Smrg if (package_prefix)
2183af526226Smrg {
2184af526226Smrg append_withs ("System", false);
2185af526226Smrg pp_string (buffer, "System.Address");
2186af526226Smrg }
2187af526226Smrg else
2188af526226Smrg pp_string (buffer, "address");
2189af526226Smrg }
2190af526226Smrg else
2191af526226Smrg {
2192af526226Smrg if (TREE_CODE (node) == POINTER_TYPE
2193af526226Smrg && TREE_CODE (TREE_TYPE (node)) == INTEGER_TYPE
21943903d7f3Smrg && id_equal (DECL_NAME (TYPE_NAME (TREE_TYPE (node))),
21953903d7f3Smrg "char"))
2196af526226Smrg {
2197af526226Smrg if (!name_only)
2198af526226Smrg pp_string (buffer, "new ");
2199af526226Smrg
2200af526226Smrg if (package_prefix)
2201af526226Smrg {
2202af526226Smrg pp_string (buffer, "Interfaces.C.Strings.chars_ptr");
2203af526226Smrg append_withs ("Interfaces.C.Strings", false);
2204af526226Smrg }
2205af526226Smrg else
2206af526226Smrg pp_string (buffer, "chars_ptr");
2207af526226Smrg }
2208af526226Smrg else
2209af526226Smrg {
2210af526226Smrg tree type_name = TYPE_NAME (TREE_TYPE (node));
2211af526226Smrg
22123903d7f3Smrg /* For now, handle access-to-access as System.Address. */
22133903d7f3Smrg if (TREE_CODE (TREE_TYPE (node)) == POINTER_TYPE)
2214af526226Smrg {
2215af526226Smrg if (package_prefix)
2216af526226Smrg {
2217af526226Smrg append_withs ("System", false);
2218af526226Smrg if (!name_only)
2219af526226Smrg pp_string (buffer, "new ");
2220af526226Smrg pp_string (buffer, "System.Address");
2221af526226Smrg }
2222af526226Smrg else
2223af526226Smrg pp_string (buffer, "address");
2224af526226Smrg return spc;
2225af526226Smrg }
2226af526226Smrg
2227af526226Smrg if (!package_prefix)
2228af526226Smrg pp_string (buffer, "access");
2229af526226Smrg else if (AGGREGATE_TYPE_P (TREE_TYPE (node)))
2230af526226Smrg {
2231af526226Smrg if (!type || TREE_CODE (type) != FUNCTION_DECL)
2232af526226Smrg {
2233af526226Smrg pp_string (buffer, "access ");
2234af526226Smrg is_access = true;
2235af526226Smrg
2236af526226Smrg if (quals & TYPE_QUAL_CONST)
2237af526226Smrg pp_string (buffer, "constant ");
2238af526226Smrg else if (!name_only)
2239af526226Smrg pp_string (buffer, "all ");
2240af526226Smrg }
2241af526226Smrg else if (quals & TYPE_QUAL_CONST)
2242af526226Smrg pp_string (buffer, "in ");
2243af526226Smrg else
2244af526226Smrg {
2245af526226Smrg is_access = true;
2246af526226Smrg pp_string (buffer, "access ");
2247af526226Smrg /* ??? should be configurable: access or in out. */
2248af526226Smrg }
2249af526226Smrg }
2250af526226Smrg else
2251af526226Smrg {
2252af526226Smrg is_access = true;
2253af526226Smrg pp_string (buffer, "access ");
2254af526226Smrg
2255af526226Smrg if (!name_only)
2256af526226Smrg pp_string (buffer, "all ");
2257af526226Smrg }
2258af526226Smrg
225963aace61Smrg if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node)) && type_name)
22603903d7f3Smrg dump_ada_node (buffer, type_name, TREE_TYPE (node), spc,
22613903d7f3Smrg is_access, true);
2262af526226Smrg else
22633903d7f3Smrg dump_ada_node (buffer, TREE_TYPE (node), TREE_TYPE (node),
22643903d7f3Smrg spc, false, true);
2265af526226Smrg }
2266af526226Smrg }
2267af526226Smrg }
2268af526226Smrg break;
2269af526226Smrg
2270af526226Smrg case ARRAY_TYPE:
2271af526226Smrg if (name_only)
22723903d7f3Smrg dump_ada_node (buffer, TYPE_NAME (node), node, spc, limited_access,
22733903d7f3Smrg true);
2274af526226Smrg else
227563aace61Smrg dump_ada_array_type (buffer, node, type, spc);
2276af526226Smrg break;
2277af526226Smrg
2278af526226Smrg case RECORD_TYPE:
2279af526226Smrg case UNION_TYPE:
2280af526226Smrg if (name_only)
22813903d7f3Smrg dump_ada_node (buffer, TYPE_NAME (node), node, spc, limited_access,
22823903d7f3Smrg true);
2283af526226Smrg else
228481418a27Smrg dump_ada_structure (buffer, node, type, false, spc);
2285af526226Smrg break;
2286af526226Smrg
2287af526226Smrg case INTEGER_CST:
2288af526226Smrg /* We treat the upper half of the sizetype range as negative. This
2289af526226Smrg is consistent with the internal treatment and makes it possible
2290af526226Smrg to generate the (0 .. -1) range for flexible array members. */
2291af526226Smrg if (TREE_TYPE (node) == sizetype)
2292af526226Smrg node = fold_convert (ssizetype, node);
22935ef59e75Smrg if (tree_fits_shwi_p (node))
22945ef59e75Smrg pp_wide_integer (buffer, tree_to_shwi (node));
22955ef59e75Smrg else if (tree_fits_uhwi_p (node))
22965ef59e75Smrg pp_unsigned_wide_integer (buffer, tree_to_uhwi (node));
2297af526226Smrg else
2298af526226Smrg {
22993903d7f3Smrg wide_int val = wi::to_wide (node);
23005ef59e75Smrg int i;
23015ef59e75Smrg if (wi::neg_p (val))
2302af526226Smrg {
23035ef59e75Smrg pp_minus (buffer);
23045ef59e75Smrg val = -val;
2305af526226Smrg }
2306af526226Smrg sprintf (pp_buffer (buffer)->digit_buffer,
23075ef59e75Smrg "16#%" HOST_WIDE_INT_PRINT "x",
23085ef59e75Smrg val.elt (val.get_len () - 1));
23095ef59e75Smrg for (i = val.get_len () - 2; i >= 0; i--)
23105ef59e75Smrg sprintf (pp_buffer (buffer)->digit_buffer,
23115ef59e75Smrg HOST_WIDE_INT_PRINT_PADDED_HEX, val.elt (i));
2312af526226Smrg pp_string (buffer, pp_buffer (buffer)->digit_buffer);
2313af526226Smrg }
2314af526226Smrg break;
2315af526226Smrg
2316af526226Smrg case REAL_CST:
2317af526226Smrg case FIXED_CST:
2318af526226Smrg case COMPLEX_CST:
2319af526226Smrg case STRING_CST:
2320af526226Smrg case VECTOR_CST:
2321af526226Smrg return 0;
2322af526226Smrg
2323af526226Smrg case TYPE_DECL:
2324af526226Smrg if (DECL_IS_BUILTIN (node))
2325af526226Smrg {
2326af526226Smrg /* Don't print the declaration of built-in types. */
2327af526226Smrg if (name_only)
2328af526226Smrg {
2329af526226Smrg /* If we're in the middle of a declaration, defaults to
2330af526226Smrg System.Address. */
2331af526226Smrg if (package_prefix)
2332af526226Smrg {
2333af526226Smrg append_withs ("System", false);
2334af526226Smrg pp_string (buffer, "System.Address");
2335af526226Smrg }
2336af526226Smrg else
2337af526226Smrg pp_string (buffer, "address");
2338af526226Smrg }
2339af526226Smrg break;
2340af526226Smrg }
2341af526226Smrg
2342af526226Smrg if (name_only)
2343af526226Smrg dump_ada_decl_name (buffer, node, limited_access);
2344af526226Smrg else
2345af526226Smrg {
2346af526226Smrg if (is_tagged_type (TREE_TYPE (node)))
2347af526226Smrg {
23483903d7f3Smrg int first = true;
2349af526226Smrg
2350af526226Smrg /* Look for ancestors. */
23513903d7f3Smrg for (tree fld = TYPE_FIELDS (TREE_TYPE (node));
23523903d7f3Smrg fld;
23533903d7f3Smrg fld = TREE_CHAIN (fld))
2354af526226Smrg {
23553903d7f3Smrg if (!DECL_NAME (fld) && is_tagged_type (TREE_TYPE (fld)))
2356af526226Smrg {
2357af526226Smrg if (first)
2358af526226Smrg {
2359af526226Smrg pp_string (buffer, "limited new ");
23603903d7f3Smrg first = false;
2361af526226Smrg }
2362af526226Smrg else
2363af526226Smrg pp_string (buffer, " and ");
2364af526226Smrg
23653903d7f3Smrg dump_ada_decl_name (buffer, TYPE_NAME (TREE_TYPE (fld)),
23663903d7f3Smrg false);
2367af526226Smrg }
2368af526226Smrg }
2369af526226Smrg
2370af526226Smrg pp_string (buffer, first ? "tagged limited " : " with ");
2371af526226Smrg }
23725ef59e75Smrg else if (has_nontrivial_methods (TREE_TYPE (node)))
2373af526226Smrg pp_string (buffer, "limited ");
2374af526226Smrg
23753903d7f3Smrg dump_ada_node (buffer, TREE_TYPE (node), type, spc, false, false);
2376af526226Smrg }
2377af526226Smrg break;
2378af526226Smrg
23793903d7f3Smrg case FUNCTION_DECL:
23803903d7f3Smrg case CONST_DECL:
2381af526226Smrg case VAR_DECL:
2382af526226Smrg case PARM_DECL:
2383af526226Smrg case FIELD_DECL:
2384af526226Smrg case NAMESPACE_DECL:
2385af526226Smrg dump_ada_decl_name (buffer, node, false);
2386af526226Smrg break;
2387af526226Smrg
2388af526226Smrg default:
2389af526226Smrg /* Ignore other nodes (e.g. expressions). */
2390af526226Smrg return 0;
2391af526226Smrg }
2392af526226Smrg
2393af526226Smrg return 1;
2394af526226Smrg }
2395af526226Smrg
23965ef59e75Smrg /* Dump in BUFFER NODE's methods. SPC is the indentation level. Return 1 if
23976a5c9aabSmrg methods were printed, 0 otherwise. */
23985ef59e75Smrg
23995ef59e75Smrg static int
dump_ada_methods(pretty_printer * buffer,tree node,int spc)24003903d7f3Smrg dump_ada_methods (pretty_printer *buffer, tree node, int spc)
2401af526226Smrg {
24025ef59e75Smrg if (!has_nontrivial_methods (node))
24035ef59e75Smrg return 0;
24045ef59e75Smrg
2405af526226Smrg pp_semicolon (buffer);
2406af526226Smrg
24073903d7f3Smrg int res = 1;
24083903d7f3Smrg for (tree fld = TYPE_FIELDS (node); fld; fld = DECL_CHAIN (fld))
24093903d7f3Smrg if (TREE_CODE (fld) == FUNCTION_DECL)
2410af526226Smrg {
2411af526226Smrg if (res)
2412af526226Smrg {
2413af526226Smrg pp_newline (buffer);
2414af526226Smrg pp_newline (buffer);
2415af526226Smrg }
24165ef59e75Smrg
24173903d7f3Smrg res = dump_ada_declaration (buffer, fld, node, spc);
2418af526226Smrg }
24195ef59e75Smrg
24205ef59e75Smrg return 1;
2421af526226Smrg }
2422af526226Smrg
24233903d7f3Smrg /* Dump in BUFFER a forward declaration for TYPE present inside T.
24243903d7f3Smrg SPC is the indentation level. */
24253903d7f3Smrg
24263903d7f3Smrg static void
dump_forward_type(pretty_printer * buffer,tree type,tree t,int spc)24273903d7f3Smrg dump_forward_type (pretty_printer *buffer, tree type, tree t, int spc)
24283903d7f3Smrg {
24293903d7f3Smrg tree decl = get_underlying_decl (type);
24303903d7f3Smrg
24313903d7f3Smrg /* Anonymous pointer and function types. */
24323903d7f3Smrg if (!decl)
24333903d7f3Smrg {
24343903d7f3Smrg if (TREE_CODE (type) == POINTER_TYPE)
24353903d7f3Smrg dump_forward_type (buffer, TREE_TYPE (type), t, spc);
24363903d7f3Smrg else if (TREE_CODE (type) == FUNCTION_TYPE)
24373903d7f3Smrg {
24383903d7f3Smrg function_args_iterator args_iter;
24393903d7f3Smrg tree arg;
24403903d7f3Smrg dump_forward_type (buffer, TREE_TYPE (type), t, spc);
24413903d7f3Smrg FOREACH_FUNCTION_ARGS (type, arg, args_iter)
24423903d7f3Smrg dump_forward_type (buffer, arg, t, spc);
24433903d7f3Smrg }
24443903d7f3Smrg return;
24453903d7f3Smrg }
24463903d7f3Smrg
24473903d7f3Smrg if (DECL_IS_BUILTIN (decl) || TREE_VISITED (decl))
24483903d7f3Smrg return;
24493903d7f3Smrg
24503903d7f3Smrg /* Forward declarations are only needed within a given file. */
24513903d7f3Smrg if (DECL_SOURCE_FILE (decl) != DECL_SOURCE_FILE (t))
24523903d7f3Smrg return;
24533903d7f3Smrg
245481418a27Smrg if (TREE_CODE (type) == FUNCTION_TYPE)
245581418a27Smrg return;
245681418a27Smrg
24573903d7f3Smrg /* Generate an incomplete type declaration. */
24583903d7f3Smrg pp_string (buffer, "type ");
24593903d7f3Smrg dump_ada_node (buffer, decl, NULL_TREE, spc, false, true);
24603903d7f3Smrg pp_semicolon (buffer);
24613903d7f3Smrg newline_and_indent (buffer, spc);
24623903d7f3Smrg
24633903d7f3Smrg /* Only one incomplete declaration is legal for a given type. */
24643903d7f3Smrg TREE_VISITED (decl) = 1;
24653903d7f3Smrg }
24663903d7f3Smrg
2467*8d286336Smrg static void dump_nested_type (pretty_printer *, tree, tree, tree, bitmap, int);
246863aace61Smrg
2469*8d286336Smrg /* Dump in BUFFER anonymous types nested inside T's definition. PARENT is the
2470*8d286336Smrg parent node of T. DUMPED_TYPES is the bitmap of already dumped types. SPC
2471*8d286336Smrg is the indentation level.
247263aace61Smrg
247363aace61Smrg In C anonymous nested tagged types have no name whereas in C++ they have
247463aace61Smrg one. In C their TYPE_DECL is at top level whereas in C++ it is nested.
247563aace61Smrg In both languages untagged types (pointers and arrays) have no name.
247663aace61Smrg In C++ the nested TYPE_DECLs can come after their associated FIELD_DECL.
247763aace61Smrg
247863aace61Smrg Therefore, in order to have a common processing for both languages, we
247963aace61Smrg disregard anonymous TYPE_DECLs at top level and here we make a first
248063aace61Smrg pass on the nested TYPE_DECLs and a second pass on the unnamed types. */
2481af526226Smrg
2482af526226Smrg static void
dump_nested_types_1(pretty_printer * buffer,tree t,tree parent,bitmap dumped_types,int spc)2483*8d286336Smrg dump_nested_types_1 (pretty_printer *buffer, tree t, tree parent,
2484*8d286336Smrg bitmap dumped_types, int spc)
2485af526226Smrg {
248663aace61Smrg tree type, field;
2487af526226Smrg
248863aace61Smrg /* Find possible anonymous pointers/arrays/structs/unions recursively. */
248963aace61Smrg type = TREE_TYPE (t);
2490*8d286336Smrg if (!type)
2491af526226Smrg return;
2492af526226Smrg
249363aace61Smrg for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
249463aace61Smrg if (TREE_CODE (field) == TYPE_DECL
2495af526226Smrg && DECL_NAME (field) != DECL_NAME (t)
24963903d7f3Smrg && !DECL_ORIGINAL_TYPE (field)
249763aace61Smrg && TYPE_NAME (TREE_TYPE (field)) != TYPE_NAME (type))
2498*8d286336Smrg dump_nested_type (buffer, field, t, parent, dumped_types, spc);
249963aace61Smrg
250063aace61Smrg for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
25013903d7f3Smrg if (TREE_CODE (field) == FIELD_DECL && !TYPE_NAME (TREE_TYPE (field)))
2502*8d286336Smrg dump_nested_type (buffer, field, t, parent, dumped_types, spc);
250363aace61Smrg }
250463aace61Smrg
2505*8d286336Smrg /* Likewise, but to be invoked only at top level. We dump each anonymous type
2506*8d286336Smrg nested inside T's definition exactly once, even if it is referenced several
2507*8d286336Smrg times in it (typically an array type), with a name prefixed by that of T. */
2508*8d286336Smrg
2509*8d286336Smrg static void
dump_nested_types(pretty_printer * buffer,tree t,int spc)2510*8d286336Smrg dump_nested_types (pretty_printer *buffer, tree t, int spc)
2511*8d286336Smrg {
2512*8d286336Smrg auto_bitmap dumped_types;
2513*8d286336Smrg dump_nested_types_1 (buffer, t, t, dumped_types, spc);
2514*8d286336Smrg }
2515*8d286336Smrg
2516*8d286336Smrg /* Dump in BUFFER the anonymous type of FIELD inside T. PARENT is the parent
2517*8d286336Smrg node of T. DUMPED_TYPES is the bitmap of already dumped types. SPC is the
2518*8d286336Smrg indentation level. */
251963aace61Smrg
252063aace61Smrg static void
dump_nested_type(pretty_printer * buffer,tree field,tree t,tree parent,bitmap dumped_types,int spc)252163aace61Smrg dump_nested_type (pretty_printer *buffer, tree field, tree t, tree parent,
2522*8d286336Smrg bitmap dumped_types, int spc)
2523af526226Smrg {
252463aace61Smrg tree field_type = TREE_TYPE (field);
252563aace61Smrg tree decl, tmp;
252663aace61Smrg
252763aace61Smrg switch (TREE_CODE (field_type))
2528af526226Smrg {
2529af526226Smrg case POINTER_TYPE:
253063aace61Smrg tmp = TREE_TYPE (field_type);
25313903d7f3Smrg dump_forward_type (buffer, tmp, t, spc);
2532af526226Smrg break;
2533af526226Smrg
2534af526226Smrg case ARRAY_TYPE:
2535*8d286336Smrg /* Anonymous array types are shared. */
2536*8d286336Smrg if (!bitmap_set_bit (dumped_types, TYPE_UID (field_type)))
2537*8d286336Smrg return;
2538*8d286336Smrg
2539*8d286336Smrg /* Recurse on the element type if need be. */
254063aace61Smrg tmp = TREE_TYPE (field_type);
254163aace61Smrg while (TREE_CODE (tmp) == ARRAY_TYPE)
254263aace61Smrg tmp = TREE_TYPE (tmp);
254363aace61Smrg decl = get_underlying_decl (tmp);
254481418a27Smrg if (decl
254581418a27Smrg && !DECL_NAME (decl)
254681418a27Smrg && DECL_SOURCE_FILE (decl) == DECL_SOURCE_FILE (t)
254781418a27Smrg && !TREE_VISITED (decl))
254863aace61Smrg {
254963aace61Smrg /* Generate full declaration. */
2550*8d286336Smrg dump_nested_type (buffer, decl, t, parent, dumped_types, spc);
255163aace61Smrg TREE_VISITED (decl) = 1;
255263aace61Smrg }
25533903d7f3Smrg else if (!decl && TREE_CODE (tmp) == POINTER_TYPE)
25543903d7f3Smrg dump_forward_type (buffer, TREE_TYPE (tmp), t, spc);
255563aace61Smrg
2556af526226Smrg /* Special case char arrays. */
25573903d7f3Smrg if (is_char_array (field_type))
25583903d7f3Smrg pp_string (buffer, "subtype ");
25593903d7f3Smrg else
25605306d544Smrg pp_string (buffer, "type ");
25613903d7f3Smrg
2562*8d286336Smrg dump_anonymous_type_name (buffer, field_type, parent);
256363aace61Smrg pp_string (buffer, " is ");
25643903d7f3Smrg dump_ada_array_type (buffer, field_type, parent, spc);
2565af526226Smrg pp_semicolon (buffer);
2566af526226Smrg newline_and_indent (buffer, spc);
2567af526226Smrg break;
2568af526226Smrg
25693903d7f3Smrg case ENUMERAL_TYPE:
25703903d7f3Smrg if (is_simple_enum (field_type))
25715306d544Smrg pp_string (buffer, "type ");
25723903d7f3Smrg else
25733903d7f3Smrg pp_string (buffer, "subtype ");
25743903d7f3Smrg
25753903d7f3Smrg if (TYPE_NAME (field_type))
25763903d7f3Smrg dump_ada_node (buffer, field_type, NULL_TREE, spc, false, true);
25773903d7f3Smrg else
2578*8d286336Smrg dump_anonymous_type_name (buffer, field_type, parent);
25793903d7f3Smrg pp_string (buffer, " is ");
258081418a27Smrg dump_ada_enum_type (buffer, field_type, spc);
25815306d544Smrg pp_semicolon (buffer);
25825306d544Smrg newline_and_indent (buffer, spc);
25833903d7f3Smrg break;
25845306d544Smrg
25853903d7f3Smrg case RECORD_TYPE:
25863903d7f3Smrg case UNION_TYPE:
2587*8d286336Smrg dump_nested_types_1 (buffer, field, parent, dumped_types, spc);
258863aace61Smrg
2589af526226Smrg pp_string (buffer, "type ");
2590af526226Smrg
259163aace61Smrg if (TYPE_NAME (field_type))
25923903d7f3Smrg dump_ada_node (buffer, field_type, NULL_TREE, spc, false, true);
25930ffa2763Smrg else
2594*8d286336Smrg dump_anonymous_type_name (buffer, field_type, parent);
25953903d7f3Smrg
25965306d544Smrg if (TREE_CODE (field_type) == UNION_TYPE)
25975306d544Smrg pp_string (buffer, " (discr : unsigned := 0)");
25983903d7f3Smrg
25995306d544Smrg pp_string (buffer, " is ");
260081418a27Smrg dump_ada_structure (buffer, field_type, t, true, spc);
26015306d544Smrg
260281418a27Smrg pp_string (buffer, "with Convention => C_Pass_By_Copy");
260363aace61Smrg
260463aace61Smrg if (TREE_CODE (field_type) == UNION_TYPE)
260563aace61Smrg {
260681418a27Smrg pp_comma (buffer);
260781418a27Smrg newline_and_indent (buffer, spc + 5);
260881418a27Smrg pp_string (buffer, "Unchecked_Union => True");
260963aace61Smrg }
261081418a27Smrg
261181418a27Smrg pp_semicolon (buffer);
261281418a27Smrg newline_and_indent (buffer, spc);
26133903d7f3Smrg break;
2614af526226Smrg
2615af526226Smrg default:
2616af526226Smrg break;
2617af526226Smrg }
2618af526226Smrg }
2619af526226Smrg
262081418a27Smrg /* Hash table of overloaded names that we cannot support. It is needed even
262181418a27Smrg in Ada 2012 because we merge different types, e.g. void * and const void *
262281418a27Smrg in System.Address, so we cannot have overloading for them in Ada. */
262381418a27Smrg
262481418a27Smrg struct overloaded_name_hash {
262581418a27Smrg hashval_t hash;
262681418a27Smrg tree name;
262781418a27Smrg unsigned int n;
262881418a27Smrg };
262981418a27Smrg
263081418a27Smrg struct overloaded_name_hasher : delete_ptr_hash<overloaded_name_hash>
263181418a27Smrg {
hashoverloaded_name_hasher263281418a27Smrg static inline hashval_t hash (overloaded_name_hash *t)
263381418a27Smrg { return t->hash; }
equaloverloaded_name_hasher263481418a27Smrg static inline bool equal (overloaded_name_hash *a, overloaded_name_hash *b)
263581418a27Smrg { return a->name == b->name; }
263681418a27Smrg };
263781418a27Smrg
263881418a27Smrg static hash_table<overloaded_name_hasher> *overloaded_names;
263981418a27Smrg
264081418a27Smrg /* Initialize the table with the problematic overloaded names. */
264181418a27Smrg
264281418a27Smrg static hash_table<overloaded_name_hasher> *
init_overloaded_names(void)264381418a27Smrg init_overloaded_names (void)
264481418a27Smrg {
264581418a27Smrg static const char *names[] =
264681418a27Smrg /* The overloaded names from the /usr/include/string.h file. */
264781418a27Smrg { "memchr", "rawmemchr", "memrchr", "strchr", "strrchr", "strchrnul",
264881418a27Smrg "strpbrk", "strstr", "strcasestr", "index", "rindex", "basename" };
264981418a27Smrg
265081418a27Smrg hash_table<overloaded_name_hasher> *table
265181418a27Smrg = new hash_table<overloaded_name_hasher> (64);
265281418a27Smrg
265381418a27Smrg for (unsigned int i = 0; i < ARRAY_SIZE (names); i++)
265481418a27Smrg {
265581418a27Smrg struct overloaded_name_hash in, *h, **slot;
265681418a27Smrg tree id = get_identifier (names[i]);
265781418a27Smrg hashval_t hash = htab_hash_pointer (id);
265881418a27Smrg in.hash = hash;
265981418a27Smrg in.name = id;
266081418a27Smrg slot = table->find_slot_with_hash (&in, hash, INSERT);
266181418a27Smrg h = new overloaded_name_hash;
266281418a27Smrg h->hash = hash;
266381418a27Smrg h->name = id;
266481418a27Smrg h->n = 0;
266581418a27Smrg *slot = h;
266681418a27Smrg }
266781418a27Smrg
266881418a27Smrg return table;
266981418a27Smrg }
267081418a27Smrg
267181418a27Smrg /* Return whether NAME cannot be supported as overloaded name. */
267281418a27Smrg
267381418a27Smrg static bool
overloaded_name_p(tree name)267481418a27Smrg overloaded_name_p (tree name)
267581418a27Smrg {
267681418a27Smrg if (!overloaded_names)
267781418a27Smrg overloaded_names = init_overloaded_names ();
267881418a27Smrg
267981418a27Smrg struct overloaded_name_hash in, *h;
268081418a27Smrg hashval_t hash = htab_hash_pointer (name);
268181418a27Smrg in.hash = hash;
268281418a27Smrg in.name = name;
268381418a27Smrg h = overloaded_names->find_with_hash (&in, hash);
268481418a27Smrg return h && ++h->n > 1;
268581418a27Smrg }
268681418a27Smrg
26873903d7f3Smrg /* Dump in BUFFER constructor spec corresponding to T for TYPE. */
26885ef59e75Smrg
26895ef59e75Smrg static void
print_constructor(pretty_printer * buffer,tree t,tree type)26903903d7f3Smrg print_constructor (pretty_printer *buffer, tree t, tree type)
26915ef59e75Smrg {
26923903d7f3Smrg tree decl_name = DECL_NAME (TYPE_NAME (type));
26935ef59e75Smrg
26945ef59e75Smrg pp_string (buffer, "New_");
269581418a27Smrg pp_ada_tree_identifier (buffer, decl_name, t, false);
26965ef59e75Smrg }
26975ef59e75Smrg
2698af526226Smrg /* Dump in BUFFER destructor spec corresponding to T. */
2699af526226Smrg
2700af526226Smrg static void
print_destructor(pretty_printer * buffer,tree t,tree type)27013903d7f3Smrg print_destructor (pretty_printer *buffer, tree t, tree type)
2702af526226Smrg {
27033903d7f3Smrg tree decl_name = DECL_NAME (TYPE_NAME (type));
2704af526226Smrg
2705af526226Smrg pp_string (buffer, "Delete_");
27063903d7f3Smrg if (strncmp (IDENTIFIER_POINTER (DECL_NAME (t)), "__dt_del", 8) == 0)
270722b41cc1Smrg pp_string (buffer, "And_Free_");
270881418a27Smrg pp_ada_tree_identifier (buffer, decl_name, t, false);
2709af526226Smrg }
2710af526226Smrg
2711*8d286336Smrg /* Dump in BUFFER assignment operator spec corresponding to T. */
2712*8d286336Smrg
2713*8d286336Smrg static void
print_assignment_operator(pretty_printer * buffer,tree t,tree type)2714*8d286336Smrg print_assignment_operator (pretty_printer *buffer, tree t, tree type)
2715*8d286336Smrg {
2716*8d286336Smrg tree decl_name = DECL_NAME (TYPE_NAME (type));
2717*8d286336Smrg
2718*8d286336Smrg pp_string (buffer, "Assign_");
2719*8d286336Smrg pp_ada_tree_identifier (buffer, decl_name, t, false);
2720*8d286336Smrg }
2721*8d286336Smrg
2722af526226Smrg /* Return the name of type T. */
2723af526226Smrg
2724af526226Smrg static const char *
type_name(tree t)2725af526226Smrg type_name (tree t)
2726af526226Smrg {
2727af526226Smrg tree n = TYPE_NAME (t);
2728af526226Smrg
2729af526226Smrg if (TREE_CODE (n) == IDENTIFIER_NODE)
2730af526226Smrg return IDENTIFIER_POINTER (n);
2731af526226Smrg else
2732af526226Smrg return IDENTIFIER_POINTER (DECL_NAME (n));
2733af526226Smrg }
2734af526226Smrg
273581418a27Smrg /* Dump in BUFFER the declaration of object T of type TYPE in Ada syntax.
27365ef59e75Smrg SPC is the indentation level. Return 1 if a declaration was printed,
27375ef59e75Smrg 0 otherwise. */
2738af526226Smrg
2739af526226Smrg static int
dump_ada_declaration(pretty_printer * buffer,tree t,tree type,int spc)27403903d7f3Smrg dump_ada_declaration (pretty_printer *buffer, tree t, tree type, int spc)
2741af526226Smrg {
27423903d7f3Smrg bool is_var = false;
27433903d7f3Smrg bool need_indent = false;
27443903d7f3Smrg bool is_class = false;
2745af526226Smrg tree name = TYPE_NAME (TREE_TYPE (t));
2746af526226Smrg tree decl_name = DECL_NAME (t);
2747af526226Smrg tree orig = NULL_TREE;
2748af526226Smrg
2749af526226Smrg if (cpp_check && cpp_check (t, IS_TEMPLATE))
27505ef59e75Smrg return dump_ada_template (buffer, t, spc);
2751af526226Smrg
27525306d544Smrg /* Skip enumeral values: will be handled as part of the type itself. */
27533903d7f3Smrg if (TREE_CODE (t) == CONST_DECL && TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE)
2754af526226Smrg return 0;
2755af526226Smrg
2756af526226Smrg if (TREE_CODE (t) == TYPE_DECL)
2757af526226Smrg {
2758af526226Smrg orig = DECL_ORIGINAL_TYPE (t);
2759af526226Smrg
276081418a27Smrg /* This is a typedef. */
2761af526226Smrg if (orig && TYPE_STUB_DECL (orig))
2762af526226Smrg {
2763af526226Smrg tree stub = TYPE_STUB_DECL (orig);
2764af526226Smrg
276581418a27Smrg /* If this is a typedef of a named type, then output it as a subtype
276681418a27Smrg declaration. ??? Use a derived type declaration instead. */
276781418a27Smrg if (TYPE_NAME (orig))
2768af526226Smrg {
27693903d7f3Smrg /* If the types have the same name (ignoring casing), then ignore
27703903d7f3Smrg the second type, but forward declare the first if need be. */
277181418a27Smrg if (type_name (orig) == type_name (TREE_TYPE (t))
277281418a27Smrg || !strcasecmp (type_name (orig), type_name (TREE_TYPE (t))))
27736a5c9aabSmrg {
277481418a27Smrg if (RECORD_OR_UNION_TYPE_P (orig) && !TREE_VISITED (stub))
27753903d7f3Smrg {
27763903d7f3Smrg INDENT (spc);
277781418a27Smrg dump_forward_type (buffer, orig, t, 0);
27783903d7f3Smrg }
27793903d7f3Smrg
27806a5c9aabSmrg TREE_VISITED (t) = 1;
2781af526226Smrg return 0;
27826a5c9aabSmrg }
2783af526226Smrg
2784af526226Smrg INDENT (spc);
2785af526226Smrg
278681418a27Smrg if (RECORD_OR_UNION_TYPE_P (orig) && !TREE_VISITED (stub))
278781418a27Smrg dump_forward_type (buffer, orig, t, spc);
2788af526226Smrg
2789af526226Smrg pp_string (buffer, "subtype ");
27903903d7f3Smrg dump_ada_node (buffer, t, type, spc, false, true);
2791af526226Smrg pp_string (buffer, " is ");
279281418a27Smrg dump_ada_node (buffer, orig, type, spc, false, true);
27936a5c9aabSmrg pp_string (buffer, "; -- ");
27946a5c9aabSmrg dump_sloc (buffer, t);
27956a5c9aabSmrg
27966a5c9aabSmrg TREE_VISITED (t) = 1;
2797af526226Smrg return 1;
2798af526226Smrg }
279981418a27Smrg
280081418a27Smrg /* This is a typedef of an anonymous type. We'll output the full
280181418a27Smrg type declaration of the anonymous type with the typedef'ed name
280281418a27Smrg below. Prevent forward declarations for the anonymous type to
280381418a27Smrg be emitted from now on. */
280481418a27Smrg TREE_VISITED (stub) = 1;
2805af526226Smrg }
2806af526226Smrg
2807af526226Smrg /* Skip unnamed or anonymous structs/unions/enum types. */
280863aace61Smrg if (!orig && !decl_name && !name
280963aace61Smrg && (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t))
281063aace61Smrg || TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE))
2811af526226Smrg return 0;
2812af526226Smrg
281363aace61Smrg /* Skip anonymous enum types (duplicates of real types). */
2814af526226Smrg if (!orig
2815af526226Smrg && TREE_CODE (TREE_TYPE (t)) == ENUMERAL_TYPE
2816af526226Smrg && decl_name
2817af526226Smrg && (*IDENTIFIER_POINTER (decl_name) == '.'
2818af526226Smrg || *IDENTIFIER_POINTER (decl_name) == '$'))
2819af526226Smrg return 0;
2820af526226Smrg
2821af526226Smrg INDENT (spc);
2822af526226Smrg
2823af526226Smrg switch (TREE_CODE (TREE_TYPE (t)))
2824af526226Smrg {
2825af526226Smrg case RECORD_TYPE:
2826af526226Smrg case UNION_TYPE:
28273903d7f3Smrg if (!COMPLETE_TYPE_P (TREE_TYPE (t)))
2828af526226Smrg {
28293903d7f3Smrg pp_string (buffer, "type ");
28303903d7f3Smrg dump_ada_node (buffer, t, type, spc, false, true);
28313903d7f3Smrg pp_string (buffer, " is null record; -- incomplete struct");
28323903d7f3Smrg TREE_VISITED (t) = 1;
2833af526226Smrg return 1;
2834af526226Smrg }
2835af526226Smrg
2836af526226Smrg if (decl_name
2837af526226Smrg && (*IDENTIFIER_POINTER (decl_name) == '.'
2838af526226Smrg || *IDENTIFIER_POINTER (decl_name) == '$'))
2839af526226Smrg {
2840af526226Smrg pp_string (buffer, "-- skipped anonymous struct ");
28413903d7f3Smrg dump_ada_node (buffer, t, type, spc, false, true);
2842af526226Smrg TREE_VISITED (t) = 1;
2843af526226Smrg return 1;
2844af526226Smrg }
2845af526226Smrg
284681418a27Smrg /* ??? Packed record layout is not supported. */
284781418a27Smrg if (TYPE_PACKED (TREE_TYPE (t)))
284881418a27Smrg {
284981418a27Smrg warning_at (DECL_SOURCE_LOCATION (t), 0,
285081418a27Smrg "unsupported record layout");
285181418a27Smrg pp_string (buffer, "pragma Compile_Time_Warning (True, ");
285281418a27Smrg pp_string (buffer, "\"probably incorrect record layout\");");
285381418a27Smrg newline_and_indent (buffer, spc);
285481418a27Smrg }
285581418a27Smrg
28563903d7f3Smrg if (orig && TYPE_NAME (orig))
2857af526226Smrg pp_string (buffer, "subtype ");
2858af526226Smrg else
2859af526226Smrg {
2860*8d286336Smrg dump_nested_types (buffer, t, spc);
2861af526226Smrg
2862af526226Smrg if (separate_class_package (t))
2863af526226Smrg {
2864af526226Smrg is_class = true;
2865af526226Smrg pp_string (buffer, "package Class_");
28663903d7f3Smrg dump_ada_node (buffer, t, type, spc, false, true);
2867af526226Smrg pp_string (buffer, " is");
2868af526226Smrg spc += INDENT_INCR;
2869af526226Smrg newline_and_indent (buffer, spc);
2870af526226Smrg }
2871af526226Smrg
2872af526226Smrg pp_string (buffer, "type ");
2873af526226Smrg }
2874af526226Smrg break;
2875af526226Smrg
2876af526226Smrg case POINTER_TYPE:
2877af526226Smrg case REFERENCE_TYPE:
28783903d7f3Smrg dump_forward_type (buffer, TREE_TYPE (TREE_TYPE (t)), t, spc);
28793903d7f3Smrg /* fallthrough */
28803903d7f3Smrg
28813903d7f3Smrg case ARRAY_TYPE:
28823903d7f3Smrg if ((orig && TYPE_NAME (orig)) || is_char_array (TREE_TYPE (t)))
2883af526226Smrg pp_string (buffer, "subtype ");
2884af526226Smrg else
2885af526226Smrg pp_string (buffer, "type ");
2886af526226Smrg break;
2887af526226Smrg
2888af526226Smrg case FUNCTION_TYPE:
2889af526226Smrg pp_string (buffer, "-- skipped function type ");
28903903d7f3Smrg dump_ada_node (buffer, t, type, spc, false, true);
2891af526226Smrg return 1;
2892af526226Smrg
2893af526226Smrg case ENUMERAL_TYPE:
2894af526226Smrg if ((orig && TYPE_NAME (orig) && orig != TREE_TYPE (t))
2895af526226Smrg || !is_simple_enum (TREE_TYPE (t)))
2896af526226Smrg pp_string (buffer, "subtype ");
2897af526226Smrg else
2898af526226Smrg pp_string (buffer, "type ");
2899af526226Smrg break;
2900af526226Smrg
2901af526226Smrg default:
2902af526226Smrg pp_string (buffer, "subtype ");
2903af526226Smrg }
290481418a27Smrg
2905af526226Smrg TREE_VISITED (t) = 1;
2906af526226Smrg }
2907af526226Smrg else
2908af526226Smrg {
290963aace61Smrg if (VAR_P (t)
2910af526226Smrg && decl_name
2911af526226Smrg && *IDENTIFIER_POINTER (decl_name) == '_')
2912af526226Smrg return 0;
2913af526226Smrg
29143903d7f3Smrg need_indent = true;
2915af526226Smrg }
2916af526226Smrg
2917af526226Smrg /* Print the type and name. */
2918af526226Smrg if (TREE_CODE (TREE_TYPE (t)) == ARRAY_TYPE)
2919af526226Smrg {
2920af526226Smrg if (need_indent)
2921af526226Smrg INDENT (spc);
2922af526226Smrg
2923af526226Smrg /* Print variable's name. */
29243903d7f3Smrg dump_ada_node (buffer, t, type, spc, false, true);
2925af526226Smrg
2926af526226Smrg if (TREE_CODE (t) == TYPE_DECL)
2927af526226Smrg {
2928af526226Smrg pp_string (buffer, " is ");
2929af526226Smrg
29303903d7f3Smrg if (orig && TYPE_NAME (orig))
29313903d7f3Smrg dump_ada_node (buffer, TYPE_NAME (orig), type, spc, false, true);
2932af526226Smrg else
29333903d7f3Smrg dump_ada_array_type (buffer, TREE_TYPE (t), type, spc);
2934af526226Smrg }
2935af526226Smrg else
2936af526226Smrg {
2937af526226Smrg if (spc == INDENT_INCR || TREE_STATIC (t))
29383903d7f3Smrg is_var = true;
2939af526226Smrg
2940af526226Smrg pp_string (buffer, " : ");
2941af526226Smrg
294263aace61Smrg if (TREE_CODE (TREE_TYPE (TREE_TYPE (t))) != POINTER_TYPE)
294363aace61Smrg pp_string (buffer, "aliased ");
294463aace61Smrg
2945*8d286336Smrg if (TYPE_NAME (TREE_TYPE (t)))
2946*8d286336Smrg dump_ada_node (buffer, TREE_TYPE (t), type, spc, false, true);
294763aace61Smrg else if (type)
2948*8d286336Smrg dump_anonymous_type_name (buffer, TREE_TYPE (t), type);
2949af526226Smrg else
29503903d7f3Smrg dump_ada_array_type (buffer, TREE_TYPE (t), type, spc);
2951af526226Smrg }
2952af526226Smrg }
2953af526226Smrg else if (TREE_CODE (t) == FUNCTION_DECL)
2954af526226Smrg {
29553903d7f3Smrg bool is_abstract_class = false;
29565ef59e75Smrg bool is_method = TREE_CODE (TREE_TYPE (t)) == METHOD_TYPE;
2957af526226Smrg tree decl_name = DECL_NAME (t);
2958af526226Smrg bool is_abstract = false;
2959*8d286336Smrg bool is_assignment_operator = false;
2960af526226Smrg bool is_constructor = false;
2961af526226Smrg bool is_destructor = false;
2962af526226Smrg bool is_copy_constructor = false;
296363aace61Smrg bool is_move_constructor = false;
2964af526226Smrg
296581418a27Smrg if (!decl_name || overloaded_name_p (decl_name))
2966af526226Smrg return 0;
2967af526226Smrg
2968af526226Smrg if (cpp_check)
2969af526226Smrg {
2970af526226Smrg is_abstract = cpp_check (t, IS_ABSTRACT);
2971*8d286336Smrg is_assignment_operator = cpp_check (t, IS_ASSIGNMENT_OPERATOR);
2972af526226Smrg is_constructor = cpp_check (t, IS_CONSTRUCTOR);
2973af526226Smrg is_destructor = cpp_check (t, IS_DESTRUCTOR);
2974af526226Smrg is_copy_constructor = cpp_check (t, IS_COPY_CONSTRUCTOR);
297563aace61Smrg is_move_constructor = cpp_check (t, IS_MOVE_CONSTRUCTOR);
2976af526226Smrg }
2977af526226Smrg
297863aace61Smrg /* Skip copy constructors and C++11 move constructors: some are internal
297963aace61Smrg only and those that are not cannot be called easily from Ada. */
298063aace61Smrg if (is_copy_constructor || is_move_constructor)
2981af526226Smrg return 0;
2982af526226Smrg
29835ef59e75Smrg if (is_constructor || is_destructor)
2984af526226Smrg {
298563aace61Smrg /* ??? Skip implicit constructors/destructors for now. */
298663aace61Smrg if (DECL_ARTIFICIAL (t))
298763aace61Smrg return 0;
298863aace61Smrg
298922b41cc1Smrg /* Only consider complete constructors and deleting destructors. */
29903903d7f3Smrg if (strncmp (IDENTIFIER_POINTER (decl_name), "__ct_comp", 9) != 0
29913903d7f3Smrg && strncmp (IDENTIFIER_POINTER (decl_name), "__dt_comp", 9) != 0
29923903d7f3Smrg && strncmp (IDENTIFIER_POINTER (decl_name), "__dt_del", 8) != 0)
2993af526226Smrg return 0;
29945ef59e75Smrg }
2995af526226Smrg
2996*8d286336Smrg else if (is_assignment_operator)
2997*8d286336Smrg {
2998*8d286336Smrg /* ??? Skip implicit or non-method assignment operators for now. */
2999*8d286336Smrg if (DECL_ARTIFICIAL (t) || !is_method)
3000*8d286336Smrg return 0;
3001*8d286336Smrg }
3002*8d286336Smrg
30035ef59e75Smrg /* If this function has an entry in the vtable, we cannot omit it. */
30045ef59e75Smrg else if (!DECL_VINDEX (t) && *IDENTIFIER_POINTER (decl_name) == '_')
30055ef59e75Smrg {
3006af526226Smrg INDENT (spc);
3007af526226Smrg pp_string (buffer, "-- skipped func ");
3008af526226Smrg pp_string (buffer, IDENTIFIER_POINTER (decl_name));
3009af526226Smrg return 1;
3010af526226Smrg }
3011af526226Smrg
3012af526226Smrg INDENT (spc);
3013af526226Smrg
301481418a27Smrg dump_forward_type (buffer, TREE_TYPE (t), t, spc);
301581418a27Smrg
30165ef59e75Smrg if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t))) && !is_constructor)
3017af526226Smrg pp_string (buffer, "procedure ");
3018af526226Smrg else
3019af526226Smrg pp_string (buffer, "function ");
3020af526226Smrg
30215ef59e75Smrg if (is_constructor)
30223903d7f3Smrg print_constructor (buffer, t, type);
30235ef59e75Smrg else if (is_destructor)
30243903d7f3Smrg print_destructor (buffer, t, type);
3025*8d286336Smrg else if (is_assignment_operator)
3026*8d286336Smrg print_assignment_operator (buffer, t, type);
3027af526226Smrg else
3028af526226Smrg dump_ada_decl_name (buffer, t, false);
3029af526226Smrg
3030af526226Smrg dump_ada_function_declaration
3031af526226Smrg (buffer, t, is_method, is_constructor, is_destructor, spc);
3032af526226Smrg
30333903d7f3Smrg if (is_constructor && RECORD_OR_UNION_TYPE_P (type))
30343903d7f3Smrg for (tree fld = TYPE_FIELDS (type); fld; fld = DECL_CHAIN (fld))
30353903d7f3Smrg if (TREE_CODE (fld) == FUNCTION_DECL && cpp_check (fld, IS_ABSTRACT))
3036af526226Smrg {
30375ef59e75Smrg is_abstract_class = true;
3038af526226Smrg break;
3039af526226Smrg }
3040af526226Smrg
3041af526226Smrg if (is_abstract || is_abstract_class)
3042af526226Smrg pp_string (buffer, " is abstract");
3043af526226Smrg
304481418a27Smrg if (is_abstract || !DECL_ASSEMBLER_NAME (t))
304581418a27Smrg {
304681418a27Smrg pp_semicolon (buffer);
304781418a27Smrg pp_string (buffer, " -- ");
304881418a27Smrg dump_sloc (buffer, t);
304981418a27Smrg }
305081418a27Smrg else if (is_constructor)
305181418a27Smrg {
3052af526226Smrg pp_semicolon (buffer);
3053af526226Smrg pp_string (buffer, " -- ");
3054af526226Smrg dump_sloc (buffer, t);
3055af526226Smrg
3056af526226Smrg newline_and_indent (buffer, spc);
30575ef59e75Smrg pp_string (buffer, "pragma CPP_Constructor (");
30583903d7f3Smrg print_constructor (buffer, t, type);
3059af526226Smrg pp_string (buffer, ", \"");
3060af526226Smrg pp_asm_name (buffer, t);
3061af526226Smrg pp_string (buffer, "\");");
3062af526226Smrg }
3063af526226Smrg else
306481418a27Smrg {
306581418a27Smrg pp_string (buffer, " -- ");
306681418a27Smrg dump_sloc (buffer, t);
306781418a27Smrg
306881418a27Smrg newline_and_indent (buffer, spc);
306981418a27Smrg dump_ada_import (buffer, t, spc);
307081418a27Smrg }
3071af526226Smrg
3072af526226Smrg return 1;
3073af526226Smrg }
30743903d7f3Smrg else if (TREE_CODE (t) == TYPE_DECL && !orig)
3075af526226Smrg {
30763903d7f3Smrg bool is_interface = false;
30773903d7f3Smrg bool is_abstract_record = false;
3078af526226Smrg
30793903d7f3Smrg /* Anonymous structs/unions. */
30803903d7f3Smrg dump_ada_node (buffer, TREE_TYPE (t), t, spc, false, true);
3081af526226Smrg
308263aace61Smrg if (TREE_CODE (TREE_TYPE (t)) == UNION_TYPE)
3083af526226Smrg pp_string (buffer, " (discr : unsigned := 0)");
3084af526226Smrg
3085af526226Smrg pp_string (buffer, " is ");
3086af526226Smrg
30873903d7f3Smrg /* Check whether we have an Ada interface compatible class.
30883903d7f3Smrg That is only have a vtable non-static data member and no
30893903d7f3Smrg non-abstract methods. */
30905ef59e75Smrg if (cpp_check
30913903d7f3Smrg && RECORD_OR_UNION_TYPE_P (TREE_TYPE (t)))
3092af526226Smrg {
30933903d7f3Smrg bool has_fields = false;
3094af526226Smrg
3095af526226Smrg /* Check that there are no fields other than the virtual table. */
30963903d7f3Smrg for (tree fld = TYPE_FIELDS (TREE_TYPE (t));
30973903d7f3Smrg fld;
30983903d7f3Smrg fld = TREE_CHAIN (fld))
3099af526226Smrg {
31003903d7f3Smrg if (TREE_CODE (fld) == FIELD_DECL)
31010ffa2763Smrg {
31023903d7f3Smrg if (!has_fields && DECL_VIRTUAL_P (fld))
31033903d7f3Smrg is_interface = true;
31040ffa2763Smrg else
31053903d7f3Smrg is_interface = false;
31063903d7f3Smrg has_fields = true;
31073903d7f3Smrg }
31083903d7f3Smrg else if (TREE_CODE (fld) == FUNCTION_DECL
31093903d7f3Smrg && !DECL_ARTIFICIAL (fld))
31103903d7f3Smrg {
31113903d7f3Smrg if (cpp_check (fld, IS_ABSTRACT))
31123903d7f3Smrg is_abstract_record = true;
31133903d7f3Smrg else
31143903d7f3Smrg is_interface = false;
31153903d7f3Smrg }
3116af526226Smrg }
3117af526226Smrg }
3118af526226Smrg
3119af526226Smrg TREE_VISITED (t) = 1;
3120af526226Smrg if (is_interface)
3121af526226Smrg {
312281418a27Smrg pp_string (buffer, "limited interface -- ");
3123af526226Smrg dump_sloc (buffer, t);
3124af526226Smrg newline_and_indent (buffer, spc);
312581418a27Smrg pp_string (buffer, "with Import => True,");
312681418a27Smrg newline_and_indent (buffer, spc + 5);
312781418a27Smrg pp_string (buffer, "Convention => CPP");
3128af526226Smrg
31293903d7f3Smrg dump_ada_methods (buffer, TREE_TYPE (t), spc);
3130af526226Smrg }
3131af526226Smrg else
3132af526226Smrg {
3133af526226Smrg if (is_abstract_record)
3134af526226Smrg pp_string (buffer, "abstract ");
31353903d7f3Smrg dump_ada_node (buffer, t, t, spc, false, false);
3136af526226Smrg }
3137af526226Smrg }
3138af526226Smrg else
3139af526226Smrg {
3140af526226Smrg if (need_indent)
3141af526226Smrg INDENT (spc);
3142af526226Smrg
3143af526226Smrg if (TREE_CODE (t) == FIELD_DECL && DECL_NAME (t))
3144af526226Smrg check_name (buffer, t);
3145af526226Smrg
3146af526226Smrg /* Print variable/type's name. */
31473903d7f3Smrg dump_ada_node (buffer, t, t, spc, false, true);
3148af526226Smrg
3149af526226Smrg if (TREE_CODE (t) == TYPE_DECL)
3150af526226Smrg {
31513903d7f3Smrg const bool is_subtype = TYPE_NAME (orig);
3152af526226Smrg
315363aace61Smrg if (!is_subtype && TREE_CODE (TREE_TYPE (t)) == UNION_TYPE)
3154af526226Smrg pp_string (buffer, " (discr : unsigned := 0)");
3155af526226Smrg
3156af526226Smrg pp_string (buffer, " is ");
3157af526226Smrg
31583903d7f3Smrg dump_ada_node (buffer, orig, t, spc, false, is_subtype);
3159af526226Smrg }
3160af526226Smrg else
3161af526226Smrg {
3162af526226Smrg if (spc == INDENT_INCR || TREE_STATIC (t))
31633903d7f3Smrg is_var = true;
3164af526226Smrg
3165af526226Smrg pp_string (buffer, " : ");
3166af526226Smrg
3167af526226Smrg if (TREE_CODE (TREE_TYPE (t)) != POINTER_TYPE
3168af526226Smrg && (TYPE_NAME (TREE_TYPE (t))
3169*8d286336Smrg || (TREE_CODE (TREE_TYPE (t)) != INTEGER_TYPE
3170*8d286336Smrg && TREE_CODE (TREE_TYPE (t)) != ENUMERAL_TYPE)))
3171af526226Smrg pp_string (buffer, "aliased ");
3172af526226Smrg
31733903d7f3Smrg if (TREE_READONLY (t) && TREE_CODE (t) != FIELD_DECL)
31743903d7f3Smrg pp_string (buffer, "constant ");
31753903d7f3Smrg
3176*8d286336Smrg if (TYPE_NAME (TREE_TYPE (t))
3177*8d286336Smrg || (!RECORD_OR_UNION_TYPE_P (TREE_TYPE (t))
3178*8d286336Smrg && TREE_CODE (TREE_TYPE (t)) != ENUMERAL_TYPE))
31793903d7f3Smrg dump_ada_node (buffer, TREE_TYPE (t), t, spc, false, true);
3180*8d286336Smrg else if (type)
3181*8d286336Smrg dump_anonymous_type_name (buffer, TREE_TYPE (t), type);
3182af526226Smrg }
3183af526226Smrg }
3184af526226Smrg
3185af526226Smrg if (is_class)
3186af526226Smrg {
31875ef59e75Smrg spc -= INDENT_INCR;
3188af526226Smrg newline_and_indent (buffer, spc);
3189af526226Smrg pp_string (buffer, "end;");
3190af526226Smrg newline_and_indent (buffer, spc);
3191af526226Smrg pp_string (buffer, "use Class_");
31923903d7f3Smrg dump_ada_node (buffer, t, type, spc, false, true);
3193af526226Smrg pp_semicolon (buffer);
3194af526226Smrg pp_newline (buffer);
3195af526226Smrg
3196af526226Smrg /* All needed indentation/newline performed already, so return 0. */
3197af526226Smrg return 0;
3198af526226Smrg }
319981418a27Smrg else if (is_var)
320081418a27Smrg {
320181418a27Smrg pp_string (buffer, " -- ");
320281418a27Smrg dump_sloc (buffer, t);
320381418a27Smrg newline_and_indent (buffer, spc);
320481418a27Smrg dump_ada_import (buffer, t, spc);
320581418a27Smrg }
320681418a27Smrg
3207af526226Smrg else
3208af526226Smrg {
3209af526226Smrg pp_string (buffer, "; -- ");
3210af526226Smrg dump_sloc (buffer, t);
3211af526226Smrg }
3212af526226Smrg
3213af526226Smrg return 1;
3214af526226Smrg }
3215af526226Smrg
321681418a27Smrg /* Dump in BUFFER a structure NODE of type TYPE in Ada syntax. If NESTED is
321781418a27Smrg true, it's an anonymous nested type. SPC is the indentation level. */
3218af526226Smrg
3219af526226Smrg static void
dump_ada_structure(pretty_printer * buffer,tree node,tree type,bool nested,int spc)322081418a27Smrg dump_ada_structure (pretty_printer *buffer, tree node, tree type, bool nested,
322181418a27Smrg int spc)
3222af526226Smrg {
322363aace61Smrg const bool is_union = (TREE_CODE (node) == UNION_TYPE);
3224af526226Smrg char buf[32];
3225af526226Smrg int field_num = 0;
3226af526226Smrg int field_spc = spc + INDENT_INCR;
3227af526226Smrg int need_semicolon;
3228af526226Smrg
3229af526226Smrg bitfield_used = false;
3230af526226Smrg
3231af526226Smrg /* Print the contents of the structure. */
323263aace61Smrg pp_string (buffer, "record");
3233af526226Smrg
3234af526226Smrg if (is_union)
3235af526226Smrg {
3236af526226Smrg newline_and_indent (buffer, spc + INDENT_INCR);
3237af526226Smrg pp_string (buffer, "case discr is");
3238af526226Smrg field_spc = spc + INDENT_INCR * 3;
3239af526226Smrg }
3240af526226Smrg
3241af526226Smrg pp_newline (buffer);
3242af526226Smrg
3243af526226Smrg /* Print the non-static fields of the structure. */
32443903d7f3Smrg for (tree tmp = TYPE_FIELDS (node); tmp; tmp = TREE_CHAIN (tmp))
3245af526226Smrg {
3246af526226Smrg /* Add parent field if needed. */
3247af526226Smrg if (!DECL_NAME (tmp))
3248af526226Smrg {
3249af526226Smrg if (!is_tagged_type (TREE_TYPE (tmp)))
3250af526226Smrg {
3251af526226Smrg if (!TYPE_NAME (TREE_TYPE (tmp)))
32523903d7f3Smrg dump_ada_declaration (buffer, tmp, type, field_spc);
3253af526226Smrg else
3254af526226Smrg {
3255af526226Smrg INDENT (field_spc);
3256af526226Smrg
3257af526226Smrg if (field_num == 0)
3258af526226Smrg pp_string (buffer, "parent : aliased ");
3259af526226Smrg else
3260af526226Smrg {
3261af526226Smrg sprintf (buf, "field_%d : aliased ", field_num + 1);
3262af526226Smrg pp_string (buffer, buf);
3263af526226Smrg }
32643903d7f3Smrg dump_ada_decl_name (buffer, TYPE_NAME (TREE_TYPE (tmp)),
32653903d7f3Smrg false);
3266af526226Smrg pp_semicolon (buffer);
3267af526226Smrg }
32683903d7f3Smrg
3269af526226Smrg pp_newline (buffer);
3270af526226Smrg field_num++;
3271af526226Smrg }
3272af526226Smrg }
32733903d7f3Smrg else if (TREE_CODE (tmp) == FIELD_DECL)
3274af526226Smrg {
3275af526226Smrg /* Skip internal virtual table field. */
32763903d7f3Smrg if (!DECL_VIRTUAL_P (tmp))
3277af526226Smrg {
3278af526226Smrg if (is_union)
3279af526226Smrg {
3280af526226Smrg if (TREE_CHAIN (tmp)
3281af526226Smrg && TREE_TYPE (TREE_CHAIN (tmp)) != node
3282af526226Smrg && TREE_CODE (TREE_CHAIN (tmp)) != TYPE_DECL)
3283af526226Smrg sprintf (buf, "when %d =>", field_num);
3284af526226Smrg else
3285af526226Smrg sprintf (buf, "when others =>");
3286af526226Smrg
3287af526226Smrg INDENT (spc + INDENT_INCR * 2);
3288af526226Smrg pp_string (buffer, buf);
3289af526226Smrg pp_newline (buffer);
3290af526226Smrg }
3291af526226Smrg
32923903d7f3Smrg if (dump_ada_declaration (buffer, tmp, type, field_spc))
3293af526226Smrg {
3294af526226Smrg pp_newline (buffer);
3295af526226Smrg field_num++;
3296af526226Smrg }
3297af526226Smrg }
3298af526226Smrg }
3299af526226Smrg }
3300af526226Smrg
3301af526226Smrg if (is_union)
3302af526226Smrg {
3303af526226Smrg INDENT (spc + INDENT_INCR);
3304af526226Smrg pp_string (buffer, "end case;");
3305af526226Smrg pp_newline (buffer);
3306af526226Smrg }
3307af526226Smrg
3308af526226Smrg if (field_num == 0)
3309af526226Smrg {
3310af526226Smrg INDENT (spc + INDENT_INCR);
3311af526226Smrg pp_string (buffer, "null;");
3312af526226Smrg pp_newline (buffer);
3313af526226Smrg }
3314af526226Smrg
3315af526226Smrg INDENT (spc);
331681418a27Smrg pp_string (buffer, "end record");
3317af526226Smrg
3318af526226Smrg newline_and_indent (buffer, spc);
3319af526226Smrg
332081418a27Smrg /* We disregard the methods for anonymous nested types. */
332181418a27Smrg if (nested)
3322af526226Smrg return;
3323af526226Smrg
332481418a27Smrg if (has_nontrivial_methods (node))
3325af526226Smrg {
332681418a27Smrg pp_string (buffer, "with Import => True,");
332781418a27Smrg newline_and_indent (buffer, spc + 5);
332881418a27Smrg pp_string (buffer, "Convention => CPP");
3329af526226Smrg }
3330af526226Smrg else
333181418a27Smrg pp_string (buffer, "with Convention => C_Pass_By_Copy");
3332af526226Smrg
3333af526226Smrg if (is_union)
3334af526226Smrg {
333581418a27Smrg pp_comma (buffer);
333681418a27Smrg newline_and_indent (buffer, spc + 5);
333781418a27Smrg pp_string (buffer, "Unchecked_Union => True");
3338af526226Smrg }
3339af526226Smrg
3340af526226Smrg if (bitfield_used)
3341af526226Smrg {
334281418a27Smrg pp_comma (buffer);
334381418a27Smrg newline_and_indent (buffer, spc + 5);
334481418a27Smrg pp_string (buffer, "Pack => True");
3345af526226Smrg bitfield_used = false;
3346af526226Smrg }
3347af526226Smrg
33483903d7f3Smrg need_semicolon = !dump_ada_methods (buffer, node, spc);
3349af526226Smrg
3350af526226Smrg /* Print the static fields of the structure, if any. */
33513903d7f3Smrg for (tree tmp = TYPE_FIELDS (node); tmp; tmp = TREE_CHAIN (tmp))
3352af526226Smrg {
33533903d7f3Smrg if (TREE_CODE (tmp) == VAR_DECL && DECL_NAME (tmp))
3354af526226Smrg {
3355af526226Smrg if (need_semicolon)
3356af526226Smrg {
3357af526226Smrg need_semicolon = false;
3358af526226Smrg pp_semicolon (buffer);
3359af526226Smrg }
3360af526226Smrg pp_newline (buffer);
3361af526226Smrg pp_newline (buffer);
33623903d7f3Smrg dump_ada_declaration (buffer, tmp, type, spc);
3363af526226Smrg }
3364af526226Smrg }
3365af526226Smrg }
3366af526226Smrg
3367af526226Smrg /* Dump all the declarations in SOURCE_FILE to an Ada spec.
3368af526226Smrg COLLECT_ALL_REFS is a front-end callback used to collect all relevant
33695ef59e75Smrg nodes for SOURCE_FILE. CHECK is used to perform C++ queries on nodes. */
3370af526226Smrg
3371af526226Smrg static void
dump_ads(const char * source_file,void (* collect_all_refs)(const char *),int (* check)(tree,cpp_operation))3372af526226Smrg dump_ads (const char *source_file,
3373af526226Smrg void (*collect_all_refs)(const char *),
33745ef59e75Smrg int (*check)(tree, cpp_operation))
3375af526226Smrg {
3376af526226Smrg char *ads_name;
3377af526226Smrg char *pkg_name;
3378af526226Smrg char *s;
3379af526226Smrg FILE *f;
3380af526226Smrg
3381af526226Smrg pkg_name = get_ada_package (source_file);
3382af526226Smrg
3383af526226Smrg /* Construct the .ads filename and package name. */
3384af526226Smrg ads_name = xstrdup (pkg_name);
3385af526226Smrg
3386af526226Smrg for (s = ads_name; *s; s++)
3387af526226Smrg if (*s == '.')
3388af526226Smrg *s = '-';
3389af526226Smrg else
3390af526226Smrg *s = TOLOWER (*s);
3391af526226Smrg
3392af526226Smrg ads_name = reconcat (ads_name, ads_name, ".ads", NULL);
3393af526226Smrg
3394af526226Smrg /* Write out the .ads file. */
3395af526226Smrg f = fopen (ads_name, "w");
3396af526226Smrg if (f)
3397af526226Smrg {
3398af526226Smrg pretty_printer pp;
3399af526226Smrg
3400af526226Smrg pp_needs_newline (&pp) = true;
3401af526226Smrg pp.buffer->stream = f;
3402af526226Smrg
3403af526226Smrg /* Dump all relevant macros. */
3404af526226Smrg dump_ada_macros (&pp, source_file);
3405af526226Smrg
3406af526226Smrg /* Reset the table of withs for this file. */
3407af526226Smrg reset_ada_withs ();
3408af526226Smrg
3409af526226Smrg (*collect_all_refs) (source_file);
3410af526226Smrg
3411af526226Smrg /* Dump all references. */
34125ef59e75Smrg cpp_check = check;
34135ef59e75Smrg dump_ada_nodes (&pp, source_file);
3414af526226Smrg
341581418a27Smrg /* We require Ada 2012 syntax, so generate corresponding pragma.
3416af526226Smrg Also, disable style checks since this file is auto-generated. */
341781418a27Smrg fprintf (f, "pragma Ada_2012;\npragma Style_Checks (Off);\n\n");
3418af526226Smrg
3419af526226Smrg /* Dump withs. */
3420af526226Smrg dump_ada_withs (f);
3421af526226Smrg
3422af526226Smrg fprintf (f, "\npackage %s is\n\n", pkg_name);
3423af526226Smrg pp_write_text_to_stream (&pp);
3424af526226Smrg /* ??? need to free pp */
3425af526226Smrg fprintf (f, "end %s;\n", pkg_name);
3426af526226Smrg fclose (f);
3427af526226Smrg }
3428af526226Smrg
3429af526226Smrg free (ads_name);
3430af526226Smrg free (pkg_name);
3431af526226Smrg }
3432af526226Smrg
3433af526226Smrg static const char **source_refs = NULL;
3434af526226Smrg static int source_refs_used = 0;
3435af526226Smrg static int source_refs_allocd = 0;
3436af526226Smrg
3437af526226Smrg /* Add an entry for FILENAME to the table SOURCE_REFS. */
3438af526226Smrg
3439af526226Smrg void
collect_source_ref(const char * filename)3440af526226Smrg collect_source_ref (const char *filename)
3441af526226Smrg {
3442af526226Smrg int i;
3443af526226Smrg
3444af526226Smrg if (!filename)
3445af526226Smrg return;
3446af526226Smrg
3447af526226Smrg if (source_refs_allocd == 0)
3448af526226Smrg {
3449af526226Smrg source_refs_allocd = 1024;
3450af526226Smrg source_refs = XNEWVEC (const char *, source_refs_allocd);
3451af526226Smrg }
3452af526226Smrg
3453af526226Smrg for (i = 0; i < source_refs_used; i++)
3454af526226Smrg if (filename == source_refs[i])
3455af526226Smrg return;
3456af526226Smrg
3457af526226Smrg if (source_refs_used == source_refs_allocd)
3458af526226Smrg {
3459af526226Smrg source_refs_allocd *= 2;
3460af526226Smrg source_refs = XRESIZEVEC (const char *, source_refs, source_refs_allocd);
3461af526226Smrg }
3462af526226Smrg
3463af526226Smrg source_refs[source_refs_used++] = filename;
3464af526226Smrg }
3465af526226Smrg
3466af526226Smrg /* Main entry point: dump all Ada specs corresponding to SOURCE_REFS
34675ef59e75Smrg using callbacks COLLECT_ALL_REFS and CHECK.
3468af526226Smrg COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3469af526226Smrg nodes for a given source file.
34705ef59e75Smrg CHECK is used to perform C++ queries on nodes, or NULL for the C
3471af526226Smrg front-end. */
3472af526226Smrg
3473af526226Smrg void
dump_ada_specs(void (* collect_all_refs)(const char *),int (* check)(tree,cpp_operation))3474af526226Smrg dump_ada_specs (void (*collect_all_refs)(const char *),
34755ef59e75Smrg int (*check)(tree, cpp_operation))
3476af526226Smrg {
3477*8d286336Smrg bitmap_obstack_initialize (NULL);
3478*8d286336Smrg
34793903d7f3Smrg /* Iterate over the list of files to dump specs for. */
34803903d7f3Smrg for (int i = 0; i < source_refs_used; i++)
34815ef59e75Smrg dump_ads (source_refs[i], collect_all_refs, check);
3482af526226Smrg
34833903d7f3Smrg /* Free various tables. */
3484af526226Smrg free (source_refs);
34853903d7f3Smrg delete overloaded_names;
3486*8d286336Smrg
3487*8d286336Smrg bitmap_obstack_release (NULL);
3488af526226Smrg }
3489