1 /* Print GENERIC declaration (functions, variables, types) trees coming from
2 the C and C++ front-ends as well as macros in Ada syntax.
3 Copyright (C) 2010-2024 Free Software Foundation, Inc.
4 Adapted from tree-pretty-print.cc by Arnaud Charlet <charlet@adacore.com>
6 This file is part of GCC.
8 GCC is free software; you can redistribute it and/or modify it under
9 the terms of the GNU General Public License as published by the Free
10 Software Foundation; either version 3, or (at your option) any later
13 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
14 WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
18 You should have received a copy of the GNU General Public License
19 along with GCC; see the file COPYING3. If not see
20 <http://www.gnu.org/licenses/>. */
24 #include "coretypes.h"
26 #include "stringpool.h"
28 #include "c-ada-spec.h"
29 #include "fold-const.h"
31 #include "diagnostic.h"
32 #include "stringpool.h"
36 /* Local functions, macros and variables. */
37 static int dump_ada_node (pretty_printer
*, tree
, tree
, int, bool, bool);
38 static int dump_ada_declaration (pretty_printer
*, tree
, tree
, int);
39 static void dump_ada_structure (pretty_printer
*, tree
, tree
, bool, int);
40 static char *to_ada_name (const char *, bool *);
42 #define INDENT(SPACE) \
43 do { int i; for (i = 0; i<SPACE; i++) pp_space (pp); } while (0)
47 /* Global hook used to perform C++ queries on nodes. */
48 static int (*cpp_check
) (tree
, cpp_operation
) = NULL
;
50 /* Global variables used in macro-related callbacks. */
51 static int max_ada_macros
;
52 static int store_ada_macro_index
;
53 static const char *macro_source_file
;
55 /* Given a cpp MACRO, compute the max length BUFFER_LEN of the macro, as well
56 as max length PARAM_LEN of arguments for fun_like macros, and also set
57 SUPPORTED to 0 if the macro cannot be mapped to an Ada construct. */
60 macro_length (const cpp_macro
*macro
, int *supported
, int *buffer_len
,
73 for (i
= 0; i
< macro
->paramc
; i
++)
75 cpp_hashnode
*param
= macro
->parm
.params
[i
];
77 *param_len
+= NODE_LEN (param
);
79 if (i
+ 1 < macro
->paramc
)
81 *param_len
+= 2; /* ", " */
83 else if (macro
->variadic
)
89 *param_len
+= 2; /* ")\0" */
92 for (j
= 0; j
< macro
->count
; j
++)
94 const cpp_token
*token
= ¯o
->exp
.tokens
[j
];
96 if (token
->flags
& PREV_WHITE
)
99 if (token
->flags
& STRINGIFY_ARG
|| token
->flags
& PASTE_LEFT
)
105 if (token
->type
== CPP_MACRO_ARG
)
107 NODE_LEN (macro
->parm
.params
[token
->val
.macro_arg
.arg_no
- 1]);
109 /* Include enough extra space to handle e.g. special characters. */
110 *buffer_len
+= (cpp_token_len (token
) + 1) * 8;
116 /* Return true if NUMBER is a preprocessing floating-point number. */
119 is_cpp_float (unsigned char *number
)
121 /* In C, a floating constant need not have a point. */
122 while (*number
!= '\0')
126 else if ((*number
== 'e' || *number
== 'E')
127 && (*(number
+ 1) == '+' || *(number
+ 1) == '-'))
136 /* Dump all digits/hex chars from NUMBER to BUFFER and return a pointer
137 to the character after the last character written. If FLOAT_P is true,
138 this is a floating-point number. */
140 static unsigned char *
141 dump_number (unsigned char *number
, unsigned char *buffer
, bool float_p
)
143 /* In Ada, a real literal is a numeric literal that includes a point. */
146 bool point_seen
= false;
148 while (*number
!= '\0')
150 if (ISDIGIT (*number
))
151 *buffer
++ = *number
++;
152 else if (*number
== '.')
154 *buffer
++ = *number
++;
157 else if ((*number
== 'e' || *number
== 'E')
158 && (*(number
+ 1) == '+' || *(number
+ 1) == '-'))
166 *buffer
++ = *number
++;
167 *buffer
++ = *number
++;
174 /* An integer literal is a numeric literal without a point. */
176 while (*number
!= '\0'
181 *buffer
++ = *number
++;
186 /* Handle escape character C and convert to an Ada character into BUFFER.
187 Return a pointer to the character after the last character written, or
188 NULL if the escape character is not supported. */
190 static unsigned char *
191 handle_escape_character (unsigned char *buffer
, char c
)
201 strcpy ((char *) buffer
, "\" & ASCII.LF & \"");
206 strcpy ((char *) buffer
, "\" & ASCII.CR & \"");
211 strcpy ((char *) buffer
, "\" & ASCII.HT & \"");
222 /* Callback used to count the number of macros from cpp_forall_identifiers.
223 PFILE and V are not used. NODE is the current macro to consider. */
226 count_ada_macro (cpp_reader
*pfile ATTRIBUTE_UNUSED
, cpp_hashnode
*node
,
227 void *v ATTRIBUTE_UNUSED
)
229 if (cpp_user_macro_p (node
) && *NODE_NAME (node
) != '_')
231 const cpp_macro
*macro
= node
->value
.macro
;
232 if (macro
->count
&& LOCATION_FILE (macro
->line
) == macro_source_file
)
239 /* Callback used to store relevant macros from cpp_forall_identifiers.
240 PFILE is not used. NODE is the current macro to store if relevant.
241 MACROS is an array of cpp_hashnode* used to store NODE. */
244 store_ada_macro (cpp_reader
*pfile ATTRIBUTE_UNUSED
,
245 cpp_hashnode
*node
, void *macros
)
247 if (cpp_user_macro_p (node
) && *NODE_NAME (node
) != '_')
249 const cpp_macro
*macro
= node
->value
.macro
;
251 && LOCATION_FILE (macro
->line
) == macro_source_file
)
252 ((cpp_hashnode
**) macros
)[store_ada_macro_index
++] = node
;
257 /* Callback used to compare (during qsort) macros. NODE1 and NODE2 are the
258 two macro nodes to compare. */
261 compare_macro (const void *node1
, const void *node2
)
263 typedef const cpp_hashnode
*const_hnode
;
265 const_hnode n1
= *(const const_hnode
*) node1
;
266 const_hnode n2
= *(const const_hnode
*) node2
;
268 return n1
->value
.macro
->line
- n2
->value
.macro
->line
;
271 /* Dump in PP all relevant macros appearing in FILE. */
274 dump_ada_macros (pretty_printer
*pp
, const char* file
)
276 int num_macros
= 0, prev_line
= -1;
277 cpp_hashnode
**macros
;
279 /* Initialize file-scope variables. */
281 store_ada_macro_index
= 0;
282 macro_source_file
= file
;
284 /* Count all potentially relevant macros, and then sort them by sloc. */
285 cpp_forall_identifiers (parse_in
, count_ada_macro
, NULL
);
286 macros
= XALLOCAVEC (cpp_hashnode
*, max_ada_macros
);
287 cpp_forall_identifiers (parse_in
, store_ada_macro
, macros
);
288 qsort (macros
, max_ada_macros
, sizeof (cpp_hashnode
*), compare_macro
);
290 for (int j
= 0; j
< max_ada_macros
; j
++)
292 cpp_hashnode
*node
= macros
[j
];
293 const cpp_macro
*macro
= node
->value
.macro
;
295 int supported
= 1, prev_is_one
= 0, buffer_len
, param_len
;
296 int is_string
= 0, is_char
= 0;
298 unsigned char *s
, *params
, *buffer
, *buf_param
, *char_one
= NULL
, *tmp
;
300 macro_length (macro
, &supported
, &buffer_len
, ¶m_len
);
301 s
= buffer
= XALLOCAVEC (unsigned char, buffer_len
);
302 params
= buf_param
= XALLOCAVEC (unsigned char, param_len
);
309 for (i
= 0; i
< macro
->paramc
; i
++)
311 cpp_hashnode
*param
= macro
->parm
.params
[i
];
313 memcpy (buf_param
, NODE_NAME (param
), NODE_LEN (param
));
314 buf_param
+= NODE_LEN (param
);
316 if (i
+ 1 < macro
->paramc
)
321 else if (macro
->variadic
)
331 for (i
= 0; supported
&& i
< macro
->count
; i
++)
333 const cpp_token
*token
= ¯o
->exp
.tokens
[i
];
336 if (token
->flags
& PREV_WHITE
)
339 if (token
->flags
& STRINGIFY_ARG
|| token
->flags
& PASTE_LEFT
)
349 cpp_hashnode
*param
=
350 macro
->parm
.params
[token
->val
.macro_arg
.arg_no
- 1];
351 memcpy (buffer
, NODE_NAME (param
), NODE_LEN (param
));
352 buffer
+= NODE_LEN (param
);
356 case CPP_EQ_EQ
: *buffer
++ = '='; break;
357 case CPP_GREATER
: *buffer
++ = '>'; break;
358 case CPP_LESS
: *buffer
++ = '<'; break;
359 case CPP_PLUS
: *buffer
++ = '+'; break;
360 case CPP_MINUS
: *buffer
++ = '-'; break;
361 case CPP_MULT
: *buffer
++ = '*'; break;
362 case CPP_DIV
: *buffer
++ = '/'; break;
363 case CPP_COMMA
: *buffer
++ = ','; break;
364 case CPP_OPEN_SQUARE
:
365 case CPP_OPEN_PAREN
: *buffer
++ = '('; break;
366 case CPP_CLOSE_SQUARE
: /* fallthrough */
367 case CPP_CLOSE_PAREN
: *buffer
++ = ')'; break;
368 case CPP_DEREF
: /* fallthrough */
369 case CPP_SCOPE
: /* fallthrough */
370 case CPP_DOT
: *buffer
++ = '.'; break;
372 case CPP_EQ
: *buffer
++ = ':'; *buffer
++ = '='; break;
373 case CPP_NOT_EQ
: *buffer
++ = '/'; *buffer
++ = '='; break;
374 case CPP_GREATER_EQ
: *buffer
++ = '>'; *buffer
++ = '='; break;
375 case CPP_LESS_EQ
: *buffer
++ = '<'; *buffer
++ = '='; break;
378 *buffer
++ = 'n'; *buffer
++ = 'o'; *buffer
++ = 't'; break;
380 *buffer
++ = 'm'; *buffer
++ = 'o'; *buffer
++ = 'd'; break;
382 *buffer
++ = 'a'; *buffer
++ = 'n'; *buffer
++ = 'd'; break;
384 *buffer
++ = 'o'; *buffer
++ = 'r'; break;
386 *buffer
++ = 'x'; *buffer
++ = 'o'; *buffer
++ = 'r'; break;
388 strcpy ((char *) buffer
, " and then ");
392 strcpy ((char *) buffer
, " or else ");
398 is_one
= prev_is_one
;
413 if (!macro
->fun_like
)
417 = cpp_spell_token (parse_in
, token
, buffer
, false);
429 const unsigned char *s
= token
->val
.str
.text
;
435 buffer
= handle_escape_character (buffer
, *s
);
454 c
= cpp_interpret_charconst (parse_in
, token
,
455 &chars_seen
, &ignored
);
456 if (c
>= 32 && c
<= 126)
459 *buffer
++ = (char) c
;
464 chars_seen
= sprintf ((char *) buffer
,
465 "Character'Val (%d)", (int) c
);
466 buffer
+= chars_seen
;
472 tmp
= cpp_token_as_text (parse_in
, token
);
492 buffer
= dump_number (tmp
+ 2, buffer
, false);
500 buffer
= dump_number (tmp
+ 2, buffer
, false);
505 /* Dump floating-point constant unmodified. */
506 if (is_cpp_float (tmp
))
507 buffer
= dump_number (tmp
, buffer
, true);
513 = dump_number (tmp
+ 1, buffer
, false);
536 = dump_number (tmp
, buffer
, is_cpp_float (tmp
));
544 /* Replace "1 << N" by "2 ** N" */
571 case CPP_CLOSE_BRACE
:
575 case CPP_MINUS_MINUS
:
579 case CPP_HEADER_NAME
:
582 case CPP_OBJC_STRING
:
584 if (!macro
->fun_like
)
587 buffer
= cpp_spell_token (parse_in
, token
, buffer
, false);
591 prev_is_one
= is_one
;
598 if (macro
->fun_like
&& supported
)
600 char *start
= (char *) s
;
603 pp_string (pp
, " -- arg-macro: ");
605 if (*start
== '(' && buffer
[-1] == ')')
610 pp_string (pp
, "function ");
614 pp_string (pp
, "procedure ");
617 pp_string (pp
, (const char *) NODE_NAME (node
));
619 pp_string (pp
, (char *) params
);
621 pp_string (pp
, " -- ");
625 pp_string (pp
, "return ");
626 pp_string (pp
, start
);
630 pp_string (pp
, start
);
636 expanded_location sloc
= expand_location (macro
->line
);
638 if (sloc
.line
!= prev_line
+ 1 && prev_line
> 0)
642 prev_line
= sloc
.line
;
645 ada_name
= to_ada_name ((const char *) NODE_NAME (node
), NULL
);
646 pp_string (pp
, ada_name
);
648 pp_string (pp
, " : ");
651 pp_string (pp
, "aliased constant String");
653 pp_string (pp
, "aliased constant Character");
655 pp_string (pp
, "constant");
657 pp_string (pp
, " := ");
658 pp_string (pp
, (char *) s
);
661 pp_string (pp
, " & ASCII.NUL");
663 pp_string (pp
, "; -- ");
664 pp_string (pp
, sloc
.file
);
666 pp_decimal_int (pp
, sloc
.line
);
671 pp_string (pp
, " -- unsupported macro: ");
672 pp_string (pp
, (const char *) cpp_macro_definition (parse_in
, node
));
681 /* Current source file being handled. */
682 static const char *current_source_file
;
684 /* Return sloc of DECL, using sloc of last field if LAST is true. */
687 decl_sloc (const_tree decl
, bool last
)
691 /* Compare the declaration of struct-like types based on the sloc of their
692 last field (if LAST is true), so that more nested types collate before
694 if (TREE_CODE (decl
) == TYPE_DECL
695 && !DECL_ORIGINAL_TYPE (decl
)
696 && RECORD_OR_UNION_TYPE_P (TREE_TYPE (decl
))
697 && (field
= TYPE_FIELDS (TREE_TYPE (decl
))))
700 while (DECL_CHAIN (field
))
701 field
= DECL_CHAIN (field
);
702 return DECL_SOURCE_LOCATION (field
);
705 return DECL_SOURCE_LOCATION (decl
);
708 /* Compare two locations LHS and RHS. */
711 compare_location (location_t lhs
, location_t rhs
)
713 expanded_location xlhs
= expand_location (lhs
);
714 expanded_location xrhs
= expand_location (rhs
);
716 if (xlhs
.file
!= xrhs
.file
)
717 return filename_cmp (xlhs
.file
, xrhs
.file
);
719 if (xlhs
.line
!= xrhs
.line
)
720 return xlhs
.line
- xrhs
.line
;
722 if (xlhs
.column
!= xrhs
.column
)
723 return xlhs
.column
- xrhs
.column
;
728 /* Compare two declarations (LP and RP) by their source location. */
731 compare_node (const void *lp
, const void *rp
)
733 const_tree lhs
= *((const tree
*) lp
);
734 const_tree rhs
= *((const tree
*) rp
);
736 = compare_location (decl_sloc (lhs
, true), decl_sloc (rhs
, true));
738 return ret
? ret
: DECL_UID (lhs
) - DECL_UID (rhs
);
741 /* Compare two comments (LP and RP) by their source location. */
744 compare_comment (const void *lp
, const void *rp
)
746 const cpp_comment
*lhs
= (const cpp_comment
*) lp
;
747 const cpp_comment
*rhs
= (const cpp_comment
*) rp
;
749 return compare_location (lhs
->sloc
, rhs
->sloc
);
752 static tree
*to_dump
= NULL
;
753 static int to_dump_count
= 0;
754 static bool bitfield_used
= false;
755 static bool packed_layout
= false;
757 /* Collect a list of declarations from T relevant to SOURCE_FILE to be dumped
758 by a subsequent call to dump_ada_nodes. */
761 collect_ada_nodes (tree t
, const char *source_file
)
764 int i
= to_dump_count
;
766 /* Count the likely relevant nodes: do not dump builtins (they are irrelevant
767 in the context of bindings) and namespaces (we do not handle them properly
769 for (n
= t
; n
; n
= TREE_CHAIN (n
))
770 if (!DECL_IS_UNDECLARED_BUILTIN (n
)
771 && TREE_CODE (n
) != NAMESPACE_DECL
772 && LOCATION_FILE (decl_sloc (n
, false)) == source_file
)
775 /* Allocate sufficient storage for all nodes. */
776 to_dump
= XRESIZEVEC (tree
, to_dump
, to_dump_count
);
778 /* Store the relevant nodes. */
779 for (n
= t
; n
; n
= TREE_CHAIN (n
))
780 if (!DECL_IS_UNDECLARED_BUILTIN (n
)
781 && TREE_CODE (n
) != NAMESPACE_DECL
782 && LOCATION_FILE (decl_sloc (n
, false)) == source_file
)
786 /* Call back for walk_tree to clear the TREE_VISITED flag of TP. */
789 unmark_visited_r (tree
*tp
, int *walk_subtrees ATTRIBUTE_UNUSED
,
790 void *data ATTRIBUTE_UNUSED
)
792 if (TREE_VISITED (*tp
))
793 TREE_VISITED (*tp
) = 0;
800 /* Print a COMMENT to the output stream PP. */
803 print_comment (pretty_printer
*pp
, const char *comment
)
805 int len
= strlen (comment
);
806 char *str
= XALLOCAVEC (char, len
+ 1);
808 bool extra_newline
= false;
810 memcpy (str
, comment
, len
+ 1);
812 /* Trim C/C++ comment indicators. */
813 if (str
[len
- 2] == '*' && str
[len
- 1] == '/')
820 tok
= strtok (str
, "\n");
822 pp_string (pp
, " --");
825 tok
= strtok (NULL
, "\n");
827 /* Leave a blank line after multi-line comments. */
829 extra_newline
= true;
836 /* Dump nodes into PP relevant to SOURCE_FILE, as collected by previous calls
837 to collect_ada_nodes. */
840 dump_ada_nodes (pretty_printer
*pp
, const char *source_file
)
843 cpp_comment_table
*comments
;
845 /* Sort the table of declarations to dump by sloc. */
846 qsort (to_dump
, to_dump_count
, sizeof (tree
), compare_node
);
848 /* Fetch the table of comments. */
849 comments
= cpp_get_comments (parse_in
);
851 /* Sort the comments table by sloc. */
852 if (comments
->count
> 1)
853 qsort (comments
->entries
, comments
->count
, sizeof (cpp_comment
),
856 /* Interleave comments and declarations in line number order. */
860 /* Advance j until comment j is in this file. */
861 while (j
!= comments
->count
862 && LOCATION_FILE (comments
->entries
[j
].sloc
) != source_file
)
865 /* Advance j until comment j is not a duplicate. */
866 while (j
< comments
->count
- 1
867 && !compare_comment (&comments
->entries
[j
],
868 &comments
->entries
[j
+ 1]))
871 /* Write decls until decl i collates after comment j. */
872 while (i
!= to_dump_count
)
874 if (j
== comments
->count
875 || LOCATION_LINE (decl_sloc (to_dump
[i
], false))
876 < LOCATION_LINE (comments
->entries
[j
].sloc
))
878 current_source_file
= source_file
;
880 if (dump_ada_declaration (pp
, to_dump
[i
++], NULL_TREE
,
891 /* Write comment j, if there is one. */
892 if (j
!= comments
->count
)
893 print_comment (pp
, comments
->entries
[j
++].comment
);
895 } while (i
!= to_dump_count
|| j
!= comments
->count
);
897 /* Clear the TREE_VISITED flag over each subtree we've dumped. */
898 for (i
= 0; i
< to_dump_count
; i
++)
899 walk_tree (&to_dump
[i
], unmark_visited_r
, NULL
, NULL
);
901 /* Finalize the to_dump table. */
910 /* Dump a newline and indent BUFFER by SPC chars. */
913 newline_and_indent (pretty_printer
*pp
, int spc
)
919 struct with
{ char *s
; const char *in_file
; bool limited
; };
920 static struct with
*withs
= NULL
;
921 static int withs_max
= 4096;
922 static int with_len
= 0;
924 /* Record a "with" clause on package S (a limited with if LIMITED_ACCESS is
925 true), if not already done. */
928 append_withs (const char *s
, bool limited_access
)
933 withs
= XNEWVEC (struct with
, withs_max
);
935 if (with_len
== withs_max
)
938 withs
= XRESIZEVEC (struct with
, withs
, withs_max
);
941 for (i
= 0; i
< with_len
; i
++)
942 if (!strcmp (s
, withs
[i
].s
)
943 && current_source_file
== withs
[i
].in_file
)
945 withs
[i
].limited
&= limited_access
;
949 withs
[with_len
].s
= xstrdup (s
);
950 withs
[with_len
].in_file
= current_source_file
;
951 withs
[with_len
].limited
= limited_access
;
955 /* Reset "with" clauses. */
958 reset_ada_withs (void)
965 for (i
= 0; i
< with_len
; i
++)
973 /* Dump "with" clauses in F. */
976 dump_ada_withs (FILE *f
)
980 fprintf (f
, "with Interfaces.C; use Interfaces.C;\n");
982 for (i
= 0; i
< with_len
; i
++)
984 (f
, "%swith %s;\n", withs
[i
].limited
? "limited " : "", withs
[i
].s
);
987 /* Return suitable Ada package name from FILE. */
990 get_ada_package (const char *file
)
998 s
= strstr (file
, "/include/");
1002 base
= lbasename (file
);
1004 if (ada_specs_parent
== NULL
)
1007 plen
= strlen (ada_specs_parent
) + 1;
1009 res
= XNEWVEC (char, plen
+ strlen (base
) + 1);
1010 if (ada_specs_parent
!= NULL
) {
1011 strcpy (res
, ada_specs_parent
);
1012 res
[plen
- 1] = '.';
1015 for (i
= plen
; *base
; base
++, i
++)
1027 res
[i
] = (i
== 0 || res
[i
- 1] == '.' || res
[i
- 1] == '_') ? 'u' : '_';
1039 static const char *ada_reserved
[] = {
1040 "abort", "abs", "abstract", "accept", "access", "aliased", "all", "and",
1041 "array", "at", "begin", "body", "case", "constant", "declare", "delay",
1042 "delta", "digits", "do", "else", "elsif", "end", "entry", "exception",
1043 "exit", "for", "function", "generic", "goto", "if", "in", "interface", "is",
1044 "limited", "loop", "mod", "new", "not", "null", "others", "out", "of", "or",
1045 "overriding", "package", "pragma", "private", "procedure", "protected",
1046 "raise", "range", "record", "rem", "renames", "requeue", "return", "reverse",
1047 "select", "separate", "subtype", "synchronized", "tagged", "task",
1048 "terminate", "then", "type", "until", "use", "when", "while", "with", "xor",
1051 /* ??? would be nice to specify this list via a config file, so that users
1052 can create their own dictionary of conflicts. */
1053 static const char *c_duplicates
[] = {
1054 /* system will cause troubles with System.Address. */
1057 /* The following values have other definitions with same name/other
1063 "rl_readline_version",
1069 /* Return a declaration tree corresponding to TYPE. */
1072 get_underlying_decl (tree type
)
1077 /* type is a declaration. */
1083 /* Strip qualifiers but do not look through typedefs. */
1084 if (TYPE_QUALS_NO_ADDR_SPACE (type
))
1085 type
= TYPE_MAIN_VARIANT (type
);
1087 /* type is a typedef. */
1088 if (TYPE_NAME (type
) && DECL_P (TYPE_NAME (type
)))
1089 return TYPE_NAME (type
);
1091 /* TYPE_STUB_DECL has been set for type. */
1092 if (TYPE_STUB_DECL (type
))
1093 return TYPE_STUB_DECL (type
);
1099 /* Return whether TYPE has static fields. */
1102 has_static_fields (const_tree type
)
1104 if (!type
|| !RECORD_OR_UNION_TYPE_P (type
) || !COMPLETE_TYPE_P (type
))
1107 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= TREE_CHAIN (fld
))
1108 if (VAR_P (fld
) && DECL_NAME (fld
))
1114 /* Return whether TYPE corresponds to an Ada tagged type (has a dispatch
1118 is_tagged_type (const_tree type
)
1120 if (!type
|| !RECORD_OR_UNION_TYPE_P (type
) || !COMPLETE_TYPE_P (type
))
1123 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= TREE_CHAIN (fld
))
1124 if (TREE_CODE (fld
) == FUNCTION_DECL
&& DECL_VINDEX (fld
))
1130 /* Return whether TYPE has non-trivial methods, i.e. methods that do something
1131 for the objects of TYPE. In C++, all classes have implicit special methods,
1132 e.g. constructors and destructors, but they can be trivial if the type is
1133 sufficiently simple. */
1136 has_nontrivial_methods (tree type
)
1138 if (!type
|| !RECORD_OR_UNION_TYPE_P (type
) || !COMPLETE_TYPE_P (type
))
1141 /* Only C++ types can have methods. */
1145 /* A non-trivial type has non-trivial special methods. */
1146 if (!cpp_check (type
, IS_TRIVIAL
))
1149 /* If there are user-defined methods, they are deemed non-trivial. */
1150 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= DECL_CHAIN (fld
))
1151 if (TREE_CODE (fld
) == FUNCTION_DECL
&& !DECL_ARTIFICIAL (fld
))
1157 #define INDEX_LENGTH 8
1159 /* Generate a legal Ada name from a C/C++ NAME and return a malloc'ed string.
1160 SPACE_FOUND, if not NULL, is used to indicate whether a space was found in
1164 to_ada_name (const char *name
, bool *space_found
)
1167 const int len
= strlen (name
);
1170 char *s
= XNEWVEC (char, len
* 2 + 5);
1174 *space_found
= false;
1176 /* Add "c_" prefix if name is an Ada reserved word. */
1177 for (names
= ada_reserved
; *names
; names
++)
1178 if (!strcasecmp (name
, *names
))
1187 /* Add "c_" prefix if name is a potential case sensitive duplicate. */
1188 for (names
= c_duplicates
; *names
; names
++)
1189 if (!strcmp (name
, *names
))
1197 for (j
= 0; name
[j
] == '_'; j
++)
1202 else if (*name
== '.' || *name
== '$')
1212 /* Replace unsuitable characters for Ada identifiers. */
1213 for (; j
< len
; j
++)
1218 *space_found
= true;
1222 /* ??? missing some C++ operators. */
1226 if (name
[j
+ 1] == '=')
1241 if (name
[j
+ 1] == '=')
1259 s
[len2
++] = name
[j
] == '&' ? 'a' : name
[j
] == '|' ? 'o' : 'x';
1261 if (name
[j
+ 1] == '=')
1274 if (s
[len2
- 1] != '_')
1277 switch (name
[j
+ 1]) {
1280 switch (name
[j
- 1]) {
1281 case '+': s
[len2
++] = 'p'; break; /* + */
1282 case '-': s
[len2
++] = 'm'; break; /* - */
1283 case '*': s
[len2
++] = 't'; break; /* * */
1284 case '/': s
[len2
++] = 'd'; break; /* / */
1290 switch (name
[j
- 1]) {
1291 case '+': s
[len2
++] = 'p'; break; /* += */
1292 case '-': s
[len2
++] = 'm'; break; /* -= */
1293 case '*': s
[len2
++] = 't'; break; /* *= */
1294 case '/': s
[len2
++] = 'd'; break; /* /= */
1328 c
= name
[j
] == '<' ? 'l' : 'g';
1331 switch (name
[j
+ 1]) {
1357 if (len2
&& s
[len2
- 1] == '_')
1362 s
[len2
++] = name
[j
];
1365 if (s
[len2
- 1] == '_')
1373 /* Return true if DECL refers to a C++ class type for which a
1374 separate enclosing package has been or should be generated. */
1377 separate_class_package (tree decl
)
1379 tree type
= TREE_TYPE (decl
);
1380 return has_nontrivial_methods (type
) || has_static_fields (type
);
1383 static bool package_prefix
= true;
1385 /* Dump in PP the name of an identifier NODE of type TYPE, following Ada
1386 syntax. LIMITED_ACCESS indicates whether NODE can be accessed through a
1387 limited 'with' clause rather than a regular 'with' clause. */
1390 pp_ada_tree_identifier (pretty_printer
*pp
, tree node
, tree type
,
1391 bool limited_access
)
1393 const char *name
= IDENTIFIER_POINTER (node
);
1394 bool space_found
= false;
1395 char *s
= to_ada_name (name
, &space_found
);
1396 tree decl
= get_underlying_decl (type
);
1400 /* If the entity comes from another file, generate a package prefix. */
1401 const expanded_location xloc
= expand_location (decl_sloc (decl
, false));
1403 if (xloc
.line
&& xloc
.file
&& xloc
.file
!= current_source_file
)
1405 switch (TREE_CODE (type
))
1410 case FIXED_POINT_TYPE
:
1412 case REFERENCE_TYPE
:
1420 char *s1
= get_ada_package (xloc
.file
);
1421 append_withs (s1
, limited_access
);
1431 /* Generate the additional package prefix for C++ classes. */
1432 if (separate_class_package (decl
))
1434 pp_string (pp
, "Class_");
1442 if (!strcmp (s
, "short_int"))
1443 pp_string (pp
, "short");
1444 else if (!strcmp (s
, "short_unsigned_int"))
1445 pp_string (pp
, "unsigned_short");
1446 else if (!strcmp (s
, "unsigned_int"))
1447 pp_string (pp
, "unsigned");
1448 else if (!strcmp (s
, "long_int"))
1449 pp_string (pp
, "long");
1450 else if (!strcmp (s
, "long_unsigned_int"))
1451 pp_string (pp
, "unsigned_long");
1452 else if (!strcmp (s
, "long_long_int"))
1453 pp_string (pp
, "Long_Long_Integer");
1454 else if (!strcmp (s
, "long_long_unsigned_int"))
1458 append_withs ("Interfaces.C.Extensions", false);
1459 pp_string (pp
, "Extensions.unsigned_long_long");
1462 pp_string (pp
, "unsigned_long_long");
1467 if (!strcmp (s
, "u_Bool") || !strcmp (s
, "bool"))
1471 append_withs ("Interfaces.C.Extensions", false);
1472 pp_string (pp
, "Extensions.bool");
1475 pp_string (pp
, "bool");
1483 /* Dump in PP the assembly name of T. */
1486 pp_asm_name (pretty_printer
*pp
, tree t
)
1488 tree name
= DECL_ASSEMBLER_NAME (t
);
1489 char *ada_name
= XALLOCAVEC (char, IDENTIFIER_LENGTH (name
) + 1), *s
;
1490 const char *ident
= IDENTIFIER_POINTER (name
);
1492 for (s
= ada_name
; *ident
; ident
++)
1496 else if (*ident
!= '*')
1501 pp_string (pp
, ada_name
);
1504 /* Dump in PP the name of a DECL node if set, in Ada syntax.
1505 LIMITED_ACCESS indicates whether NODE can be accessed via a
1506 limited 'with' clause rather than a regular 'with' clause. */
1509 dump_ada_decl_name (pretty_printer
*pp
, tree decl
, bool limited_access
)
1511 if (DECL_NAME (decl
))
1512 pp_ada_tree_identifier (pp
, DECL_NAME (decl
), decl
, limited_access
);
1515 tree type_name
= TYPE_NAME (TREE_TYPE (decl
));
1519 pp_string (pp
, "anon");
1520 if (TREE_CODE (decl
) == FIELD_DECL
)
1521 pp_decimal_int (pp
, DECL_UID (decl
));
1523 pp_decimal_int (pp
, TYPE_UID (TREE_TYPE (decl
)));
1525 else if (TREE_CODE (type_name
) == IDENTIFIER_NODE
)
1526 pp_ada_tree_identifier (pp
, type_name
, decl
, limited_access
);
1530 /* Dump in PP a name for the type T, which is a TYPE without TYPE_NAME. */
1533 dump_anonymous_type_name (pretty_printer
*pp
, tree t
)
1535 pp_string (pp
, "anon");
1537 switch (TREE_CODE (t
))
1540 pp_string (pp
, "_array");
1543 pp_string (pp
, "_enum");
1546 pp_string (pp
, "_struct");
1549 pp_string (pp
, "_union");
1552 pp_string (pp
, "_unknown");
1556 pp_decimal_int (pp
, TYPE_UID (t
));
1559 /* Dump in PP aspect Import on a given node T. SPC is the current
1560 indentation level. */
1563 dump_ada_import (pretty_printer
*pp
, tree t
, int spc
)
1565 const char *name
= IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (t
));
1566 const bool is_stdcall
1567 = TREE_CODE (t
) == FUNCTION_DECL
1568 && lookup_attribute ("stdcall", TYPE_ATTRIBUTES (TREE_TYPE (t
)));
1570 pp_string (pp
, "with Import => True, ");
1572 newline_and_indent (pp
, spc
+ 5);
1575 pp_string (pp
, "Convention => Stdcall, ");
1576 else if (name
[0] == '_' && name
[1] == 'Z')
1577 pp_string (pp
, "Convention => CPP, ");
1579 pp_string (pp
, "Convention => C, ");
1581 newline_and_indent (pp
, spc
+ 5);
1583 tree sec
= lookup_attribute ("section", DECL_ATTRIBUTES (t
));
1586 pp_string (pp
, "Linker_Section => \"");
1587 pp_string (pp
, TREE_STRING_POINTER (TREE_VALUE (TREE_VALUE (sec
))));
1588 pp_string (pp
, "\", ");
1589 newline_and_indent (pp
, spc
+ 5);
1592 pp_string (pp
, "External_Name => \"");
1595 pp_string (pp
, IDENTIFIER_POINTER (DECL_NAME (t
)));
1597 pp_asm_name (pp
, t
);
1599 pp_string (pp
, "\";");
1602 /* Check whether T and its type have different names, and append "the_"
1606 check_type_name_conflict (pretty_printer
*pp
, tree t
)
1608 tree tmp
= TREE_TYPE (t
);
1610 while (TREE_CODE (tmp
) == POINTER_TYPE
&& !TYPE_NAME (tmp
))
1611 tmp
= TREE_TYPE (tmp
);
1613 if (TREE_CODE (tmp
) != FUNCTION_TYPE
&& tmp
!= error_mark_node
)
1617 if (TREE_CODE (tmp
) == IDENTIFIER_NODE
)
1618 s
= IDENTIFIER_POINTER (tmp
);
1619 else if (!TYPE_NAME (tmp
))
1621 else if (TREE_CODE (TYPE_NAME (tmp
)) == IDENTIFIER_NODE
)
1622 s
= IDENTIFIER_POINTER (TYPE_NAME (tmp
));
1623 else if (!DECL_NAME (TYPE_NAME (tmp
)))
1626 s
= IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp
)));
1628 if (!strcasecmp (IDENTIFIER_POINTER (DECL_NAME (t
)), s
))
1629 pp_string (pp
, "the_");
1633 /* Dump in PP a function declaration FUNC in Ada syntax.
1634 IS_METHOD indicates whether FUNC is a C++ method.
1635 IS_CONSTRUCTOR whether FUNC is a C++ constructor.
1636 IS_DESTRUCTOR whether FUNC is a C++ destructor.
1637 SPC is the current indentation level. */
1640 dump_ada_function_declaration (pretty_printer
*pp
, tree func
,
1641 bool is_method
, bool is_constructor
,
1642 bool is_destructor
, int spc
)
1644 tree type
= TREE_TYPE (func
);
1645 tree arg
= TYPE_ARG_TYPES (type
);
1648 int num
, num_args
= 0, have_args
= true, have_ellipsis
= false;
1650 /* Compute number of arguments. */
1653 while (TREE_CHAIN (arg
) && arg
!= error_mark_node
)
1656 arg
= TREE_CHAIN (arg
);
1659 if (TREE_CODE (TREE_VALUE (arg
)) != VOID_TYPE
)
1662 have_ellipsis
= true;
1673 newline_and_indent (pp
, spc
+ 1);
1681 /* For a function, see if we have the corresponding arguments. */
1682 if (TREE_CODE (func
) == FUNCTION_DECL
)
1684 arg
= DECL_ARGUMENTS (func
);
1685 for (t
= arg
, num
= 0; t
; t
= DECL_CHAIN (t
))
1693 /* Otherwise, only print the types. */
1697 arg
= TYPE_ARG_TYPES (type
);
1701 arg
= TREE_CHAIN (arg
);
1703 /* Print the argument names (if available) and types. */
1704 for (num
= 1; num
<= num_args
; num
++)
1708 if (DECL_NAME (arg
))
1710 check_type_name_conflict (pp
, arg
);
1711 pp_ada_tree_identifier (pp
, DECL_NAME (arg
), NULL_TREE
,
1713 pp_string (pp
, " : ");
1717 sprintf (buf
, "arg%d : ", num
);
1718 pp_string (pp
, buf
);
1721 dump_ada_node (pp
, TREE_TYPE (arg
), type
, spc
, false, true);
1725 sprintf (buf
, "arg%d : ", num
);
1726 pp_string (pp
, buf
);
1727 dump_ada_node (pp
, TREE_VALUE (arg
), type
, spc
, false, true);
1730 /* If the type is a pointer to a tagged type, we need to differentiate
1731 virtual methods from the rest (non-virtual methods, static member
1732 or regular functions) and import only them as primitive operations,
1733 because they make up the virtual table which is mirrored on the Ada
1734 side by the dispatch table. So we add 'Class to the type of every
1735 parameter that is not the first one of a method which either has a
1736 slot in the virtual table or is a constructor. */
1738 && POINTER_TYPE_P (TREE_TYPE (arg
))
1739 && is_tagged_type (TREE_TYPE (TREE_TYPE (arg
)))
1740 && !(num
== 1 && is_method
&& (DECL_VINDEX (func
) || is_constructor
)))
1741 pp_string (pp
, "'Class");
1743 arg
= TREE_CHAIN (arg
);
1750 newline_and_indent (pp
, spc
+ INDENT_INCR
);
1758 pp_string (pp
, " -- , ...");
1759 newline_and_indent (pp
, spc
+ INDENT_INCR
);
1763 pp_right_paren (pp
);
1765 if (is_constructor
|| !VOID_TYPE_P (TREE_TYPE (type
)))
1767 pp_string (pp
, " return ");
1768 tree rtype
= is_constructor
? DECL_CONTEXT (func
) : TREE_TYPE (type
);
1769 dump_ada_node (pp
, rtype
, rtype
, spc
, false, true);
1773 /* Dump in PP all the domains associated with an array NODE,
1774 in Ada syntax. SPC is the current indentation level. */
1777 dump_ada_array_domains (pretty_printer
*pp
, tree node
, int spc
)
1783 for (; TREE_CODE (node
) == ARRAY_TYPE
; node
= TREE_TYPE (node
))
1785 tree domain
= TYPE_DOMAIN (node
);
1789 tree min
= TYPE_MIN_VALUE (domain
);
1790 tree max
= TYPE_MAX_VALUE (domain
);
1793 pp_string (pp
, ", ");
1797 dump_ada_node (pp
, min
, NULL_TREE
, spc
, false, true);
1798 pp_string (pp
, " .. ");
1800 /* If the upper bound is zero, gcc may generate a NULL_TREE
1801 for TYPE_MAX_VALUE rather than an integer_cst. */
1803 dump_ada_node (pp
, max
, NULL_TREE
, spc
, false, true);
1805 pp_string (pp
, "0");
1809 pp_string (pp
, "size_t");
1813 pp_right_paren (pp
);
1816 /* Dump in PP file:line information related to NODE. */
1819 dump_sloc (pretty_printer
*pp
, tree node
)
1821 expanded_location xloc
;
1824 xloc
= expand_location (DECL_SOURCE_LOCATION (node
));
1825 else if (EXPR_HAS_LOCATION (node
))
1826 xloc
= expand_location (EXPR_LOCATION (node
));
1832 pp_string (pp
, xloc
.file
);
1834 pp_decimal_int (pp
, xloc
.line
);
1838 /* Return true if type T designates a 1-dimension array of "char". */
1841 is_char_array (tree t
)
1843 return TREE_CODE (t
) == ARRAY_TYPE
1844 && TREE_CODE (TREE_TYPE (t
)) == INTEGER_TYPE
1845 && id_equal (DECL_NAME (TYPE_NAME (TREE_TYPE (t
))), "char");
1848 /* Dump in PP an array type NODE in Ada syntax. SPC is the indentation
1852 dump_ada_array_type (pretty_printer
*pp
, tree node
, int spc
)
1854 const bool char_array
= is_char_array (node
);
1856 /* Special case char arrays. */
1858 pp_string (pp
, "Interfaces.C.char_array ");
1860 pp_string (pp
, "array ");
1862 /* Print the dimensions. */
1863 dump_ada_array_domains (pp
, node
, spc
);
1865 /* Print the component type. */
1868 tree tmp
= strip_array_types (node
);
1870 pp_string (pp
, " of ");
1872 if (TREE_CODE (tmp
) != POINTER_TYPE
&& !packed_layout
)
1873 pp_string (pp
, "aliased ");
1876 || (!RECORD_OR_UNION_TYPE_P (tmp
)
1877 && TREE_CODE (tmp
) != ENUMERAL_TYPE
))
1878 dump_ada_node (pp
, tmp
, node
, spc
, false, true);
1880 dump_anonymous_type_name (pp
, tmp
);
1884 /* Dump in PP type names associated with a template, each prepended with
1885 '_'. TYPES is the TREE_PURPOSE of a DECL_TEMPLATE_INSTANTIATIONS. SPC is
1886 the indentation level. */
1889 dump_template_types (pretty_printer
*pp
, tree types
, int spc
)
1891 for (int i
= 0; i
< TREE_VEC_LENGTH (types
); i
++)
1893 tree elem
= TREE_VEC_ELT (types
, i
);
1896 if (!dump_ada_node (pp
, elem
, NULL_TREE
, spc
, false, true))
1898 pp_string (pp
, "unknown");
1899 pp_scalar (pp
, HOST_SIZE_T_PRINT_UNSIGNED
,
1900 (fmt_size_t
) TREE_HASH (elem
));
1905 /* Dump in PP the contents of all class instantiations associated with
1906 a given template T. SPC is the indentation level. */
1909 dump_ada_template (pretty_printer
*pp
, tree t
, int spc
)
1911 /* DECL_SIZE_UNIT is DECL_TEMPLATE_INSTANTIATIONS in this context. */
1912 tree inst
= DECL_SIZE_UNIT (t
);
1913 /* This emulates DECL_TEMPLATE_RESULT in this context. */
1914 struct tree_template_decl
{
1915 struct tree_decl_common common
;
1919 tree result
= ((struct tree_template_decl
*) t
)->result
;
1922 /* Don't look at template declarations declaring something coming from
1923 another file. This can occur for template friend declarations. */
1924 if (LOCATION_FILE (decl_sloc (result
, false))
1925 != LOCATION_FILE (decl_sloc (t
, false)))
1928 for (; inst
&& inst
!= error_mark_node
; inst
= TREE_CHAIN (inst
))
1930 tree types
= TREE_PURPOSE (inst
);
1931 tree instance
= TREE_VALUE (inst
);
1933 if (TREE_VEC_LENGTH (types
) == 0)
1936 if (!RECORD_OR_UNION_TYPE_P (instance
))
1939 /* We are interested in concrete template instantiations only: skip
1940 partially specialized nodes. */
1941 if (RECORD_OR_UNION_TYPE_P (instance
)
1943 && cpp_check (instance
, HAS_DEPENDENT_TEMPLATE_ARGS
))
1948 pp_string (pp
, "package ");
1949 package_prefix
= false;
1950 dump_ada_node (pp
, instance
, t
, spc
, false, true);
1951 dump_template_types (pp
, types
, spc
);
1952 pp_string (pp
, " is");
1954 newline_and_indent (pp
, spc
);
1956 TREE_VISITED (get_underlying_decl (instance
)) = 1;
1957 pp_string (pp
, "type ");
1958 dump_ada_node (pp
, instance
, t
, spc
, false, true);
1959 package_prefix
= true;
1961 if (is_tagged_type (instance
))
1962 pp_string (pp
, " is tagged limited ");
1964 pp_string (pp
, " is limited ");
1966 dump_ada_node (pp
, instance
, t
, spc
, false, false);
1969 newline_and_indent (pp
, spc
);
1971 pp_string (pp
, "end;");
1972 newline_and_indent (pp
, spc
);
1973 pp_string (pp
, "use ");
1974 package_prefix
= false;
1975 dump_ada_node (pp
, instance
, t
, spc
, false, true);
1976 dump_template_types (pp
, types
, spc
);
1977 package_prefix
= true;
1983 return num_inst
> 0;
1986 /* Return true if NODE is a simple enumeral type that can be mapped to an
1987 Ada enumeration type directly. */
1990 is_simple_enum (tree node
)
1992 HOST_WIDE_INT count
= 0;
1994 for (tree value
= TYPE_VALUES (node
); value
; value
= TREE_CHAIN (value
))
1996 tree int_val
= TREE_VALUE (value
);
1998 if (TREE_CODE (int_val
) != INTEGER_CST
)
1999 int_val
= DECL_INITIAL (int_val
);
2001 if (!tree_fits_shwi_p (int_val
) || tree_to_shwi (int_val
) != count
)
2010 /* Dump in PP the declaration of enumeral NODE of type TYPE in Ada syntax.
2011 SPC is the indentation level. */
2014 dump_ada_enum_type (pretty_printer
*pp
, tree node
, tree type
, int spc
)
2016 if (is_simple_enum (node
))
2020 newline_and_indent (pp
, spc
- 1);
2022 for (tree value
= TYPE_VALUES (node
); value
; value
= TREE_CHAIN (value
))
2029 newline_and_indent (pp
, spc
);
2032 pp_ada_tree_identifier (pp
, TREE_PURPOSE (value
), node
, false);
2034 pp_string (pp
, ")");
2036 newline_and_indent (pp
, spc
);
2037 pp_string (pp
, "with Convention => C");
2041 if (TYPE_UNSIGNED (node
))
2042 pp_string (pp
, "unsigned");
2044 pp_string (pp
, "int");
2046 for (tree value
= TYPE_VALUES (node
); value
; value
= TREE_CHAIN (value
))
2048 tree int_val
= TREE_VALUE (value
);
2050 if (TREE_CODE (int_val
) != INTEGER_CST
)
2051 int_val
= DECL_INITIAL (int_val
);
2054 newline_and_indent (pp
, spc
);
2056 if (TYPE_NAME (node
))
2057 dump_ada_node (pp
, node
, NULL_TREE
, spc
, false, true);
2059 dump_ada_node (pp
, type
, NULL_TREE
, spc
, false, true);
2061 dump_anonymous_type_name (pp
, node
);
2063 pp_ada_tree_identifier (pp
, TREE_PURPOSE (value
), node
, false);
2065 pp_string (pp
, " : constant ");
2067 if (TYPE_NAME (node
))
2068 dump_ada_node (pp
, node
, NULL_TREE
, spc
, false, true);
2070 dump_ada_node (pp
, type
, NULL_TREE
, spc
, false, true);
2072 dump_anonymous_type_name (pp
, node
);
2074 pp_string (pp
, " := ");
2075 dump_ada_node (pp
, int_val
, node
, spc
, false, true);
2080 /* Return true if NODE is the __bf16 type. */
2083 is_float16 (tree node
)
2085 if (!TYPE_NAME (node
) || TREE_CODE (TYPE_NAME (node
)) != TYPE_DECL
)
2088 tree name
= DECL_NAME (TYPE_NAME (node
));
2090 if (IDENTIFIER_POINTER (name
) [0] != '_')
2093 return id_equal (name
, "__bf16");
2096 /* Return true if NODE is the _Float32/_Float32x type. */
2099 is_float32 (tree node
)
2101 if (!TYPE_NAME (node
) || TREE_CODE (TYPE_NAME (node
)) != TYPE_DECL
)
2104 tree name
= DECL_NAME (TYPE_NAME (node
));
2106 if (IDENTIFIER_POINTER (name
) [0] != '_')
2109 return id_equal (name
, "_Float32") || id_equal (name
, "_Float32x");
2112 /* Return true if NODE is the _Float64/_Float64x type. */
2115 is_float64 (tree node
)
2117 if (!TYPE_NAME (node
) || TREE_CODE (TYPE_NAME (node
)) != TYPE_DECL
)
2120 tree name
= DECL_NAME (TYPE_NAME (node
));
2122 if (IDENTIFIER_POINTER (name
) [0] != '_')
2125 return id_equal (name
, "_Float64") || id_equal (name
, "_Float64x");
2128 /* Return true if NODE is the __float128/_Float128/_Float128x type. */
2131 is_float128 (tree node
)
2133 if (!TYPE_NAME (node
) || TREE_CODE (TYPE_NAME (node
)) != TYPE_DECL
)
2136 tree name
= DECL_NAME (TYPE_NAME (node
));
2138 if (IDENTIFIER_POINTER (name
) [0] != '_')
2141 return id_equal (name
, "__float128")
2142 || id_equal (name
, "_Float128")
2143 || id_equal (name
, "_Float128x");
2146 /* Recursively dump in PP Ada declarations corresponding to NODE of type
2147 TYPE. SPC is the indentation level. LIMITED_ACCESS indicates whether NODE
2148 can be referenced via a "limited with" clause. NAME_ONLY indicates whether
2149 we should only dump the name of NODE, instead of its full declaration. */
2152 dump_ada_node (pretty_printer
*pp
, tree node
, tree type
, int spc
,
2153 bool limited_access
, bool name_only
)
2155 if (node
== NULL_TREE
)
2158 switch (TREE_CODE (node
))
2161 pp_string (pp
, "<<< error >>>");
2164 case IDENTIFIER_NODE
:
2165 pp_ada_tree_identifier (pp
, node
, type
, limited_access
);
2169 pp_string (pp
, "--- unexpected node: TREE_LIST");
2173 dump_ada_node (pp
, BINFO_TYPE (node
), type
, spc
, limited_access
,
2178 pp_string (pp
, "--- unexpected node: TREE_VEC");
2185 append_withs ("System", false);
2186 pp_string (pp
, "System.Address");
2189 pp_string (pp
, "address");
2193 pp_string (pp
, "<vector>");
2197 if (is_float128 (TREE_TYPE (node
)))
2199 append_withs ("Interfaces.C.Extensions", false);
2200 pp_string (pp
, "Extensions.CFloat_128");
2202 else if (TREE_TYPE (node
) == float_type_node
)
2204 append_withs ("Ada.Numerics.Complex_Types", false);
2205 pp_string (pp
, "Ada.Numerics.Complex_Types.Complex");
2207 else if (TREE_TYPE (node
) == double_type_node
)
2209 append_withs ("Ada.Numerics.Long_Complex_Types", false);
2210 pp_string (pp
, "Ada.Numerics.Long_Complex_Types.Complex");
2212 else if (TREE_TYPE (node
) == long_double_type_node
)
2214 append_withs ("Ada.Numerics.Long_Long_Complex_Types", false);
2215 pp_string (pp
, "Ada.Numerics.Long_Long_Complex_Types.Complex");
2218 pp_string (pp
, "<complex>");
2223 dump_ada_node (pp
, TYPE_NAME (node
), node
, spc
, false, true);
2225 dump_ada_enum_type (pp
, node
, type
, spc
);
2229 if (is_float16 (node
))
2231 pp_string (pp
, "Short_Float");
2234 else if (is_float32 (node
))
2236 pp_string (pp
, "Float");
2239 else if (is_float64 (node
))
2241 pp_string (pp
, "Long_Float");
2244 else if (is_float128 (node
))
2246 append_withs ("Interfaces.C.Extensions", false);
2247 pp_string (pp
, "Extensions.Float_128");
2254 case FIXED_POINT_TYPE
:
2256 if (TYPE_NAME (node
)
2257 && !(TREE_CODE (TYPE_NAME (node
)) == TYPE_DECL
2258 && !strcmp (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (node
))),
2261 if (TREE_CODE (TYPE_NAME (node
)) == IDENTIFIER_NODE
)
2262 pp_ada_tree_identifier (pp
, TYPE_NAME (node
), node
,
2264 else if (TREE_CODE (TYPE_NAME (node
)) == TYPE_DECL
2265 && DECL_NAME (TYPE_NAME (node
)))
2266 dump_ada_decl_name (pp
, TYPE_NAME (node
), limited_access
);
2268 pp_string (pp
, "<unnamed type>");
2270 else if (TREE_CODE (node
) == INTEGER_TYPE
)
2272 append_withs ("Interfaces.C.Extensions", false);
2273 bitfield_used
= true;
2275 if (TYPE_PRECISION (node
) == 1)
2276 pp_string (pp
, "Extensions.Unsigned_1");
2279 pp_string (pp
, TYPE_UNSIGNED (node
)
2280 ? "Extensions.Unsigned_"
2281 : "Extensions.Signed_");
2282 pp_decimal_int (pp
, TYPE_PRECISION (node
));
2286 pp_string (pp
, "<unnamed type>");
2290 case REFERENCE_TYPE
:
2291 if (name_only
&& TYPE_NAME (node
))
2292 dump_ada_node (pp
, TYPE_NAME (node
), node
, spc
, limited_access
,
2295 else if (TREE_CODE (TREE_TYPE (node
)) == FUNCTION_TYPE
)
2297 if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (node
))))
2298 pp_string (pp
, "access procedure");
2300 pp_string (pp
, "access function");
2302 dump_ada_function_declaration (pp
, node
, false, false, false,
2305 /* If we are dumping the full type, it means we are part of a
2306 type definition and need also a Convention C aspect. */
2309 newline_and_indent (pp
, spc
);
2310 pp_string (pp
, "with Convention => C");
2315 tree ref_type
= TREE_TYPE (node
);
2316 const unsigned int quals
= TYPE_QUALS (ref_type
);
2319 if (VOID_TYPE_P (ref_type
))
2322 pp_string (pp
, "new ");
2325 append_withs ("System", false);
2326 pp_string (pp
, "System.Address");
2329 pp_string (pp
, "address");
2333 if (TREE_CODE (node
) == POINTER_TYPE
2334 && TREE_CODE (ref_type
) == INTEGER_TYPE
2335 && id_equal (DECL_NAME (TYPE_NAME (ref_type
)), "char"))
2338 pp_string (pp
, "new ");
2342 pp_string (pp
, "Interfaces.C.Strings.chars_ptr");
2343 append_withs ("Interfaces.C.Strings", false);
2346 pp_string (pp
, "chars_ptr");
2350 tree stub
= TYPE_STUB_DECL (ref_type
);
2351 tree type_name
= TYPE_NAME (ref_type
);
2353 /* For now, handle access-to-access as System.Address. */
2354 if (TREE_CODE (ref_type
) == POINTER_TYPE
)
2358 append_withs ("System", false);
2360 pp_string (pp
, "new ");
2361 pp_string (pp
, "System.Address");
2364 pp_string (pp
, "address");
2368 if (!package_prefix
)
2371 pp_string (pp
, "access");
2373 else if (AGGREGATE_TYPE_P (ref_type
))
2375 if (!type
|| TREE_CODE (type
) != FUNCTION_DECL
)
2378 pp_string (pp
, "access ");
2380 if (quals
& TYPE_QUAL_CONST
)
2381 pp_string (pp
, "constant ");
2382 else if (!name_only
)
2383 pp_string (pp
, "all ");
2385 else if (quals
& TYPE_QUAL_CONST
)
2388 pp_string (pp
, "in ");
2393 pp_string (pp
, "access ");
2398 /* We want to use regular with clauses for scalar types,
2399 as they are not involved in circular declarations. */
2401 pp_string (pp
, "access ");
2404 pp_string (pp
, "all ");
2407 /* If this is the anonymous original type of a typedef'ed
2408 type, then use the name of the latter. */
2411 && DECL_CHAIN (stub
)
2412 && TREE_CODE (DECL_CHAIN (stub
)) == TYPE_DECL
2413 && DECL_ORIGINAL_TYPE (DECL_CHAIN (stub
)) == ref_type
)
2414 ref_type
= TREE_TYPE (DECL_CHAIN (stub
));
2416 /* If this is a pointer to an anonymous array type, then use
2417 the name of the component type. */
2418 else if (!type_name
&& is_access
)
2419 ref_type
= strip_array_types (ref_type
);
2421 /* Generate "access <type>" instead of "access <subtype>"
2422 if the subtype comes from another file, because subtype
2423 declarations do not contribute to the limited view of a
2424 package and thus subtypes cannot be referenced through
2425 a limited_with clause. */
2428 && TREE_CODE (type_name
) == TYPE_DECL
2429 && DECL_ORIGINAL_TYPE (type_name
)
2430 && TYPE_NAME (DECL_ORIGINAL_TYPE (type_name
)))
2432 const expanded_location xloc
2433 = expand_location (decl_sloc (type_name
, false));
2436 && xloc
.file
!= current_source_file
)
2438 ref_type
= DECL_ORIGINAL_TYPE (type_name
);
2439 type_name
= TYPE_NAME (ref_type
);
2445 dump_ada_node (pp
, ref_type
, ref_type
, spc
, is_access
,
2454 dump_ada_node (pp
, TYPE_NAME (node
), node
, spc
, limited_access
,
2457 dump_ada_array_type (pp
, node
, spc
);
2463 dump_ada_node (pp
, TYPE_NAME (node
), node
, spc
, limited_access
,
2466 dump_ada_structure (pp
, node
, type
, false, spc
);
2470 /* We treat the upper half of the sizetype range as negative. This
2471 is consistent with the internal treatment and makes it possible
2472 to generate the (0 .. -1) range for flexible array members. */
2473 if (TREE_TYPE (node
) == sizetype
)
2474 node
= fold_convert (ssizetype
, node
);
2475 if (tree_fits_shwi_p (node
))
2476 pp_wide_integer (pp
, tree_to_shwi (node
));
2477 else if (tree_fits_uhwi_p (node
))
2478 pp_unsigned_wide_integer (pp
, tree_to_uhwi (node
));
2481 wide_int val
= wi::to_wide (node
);
2483 if (wi::neg_p (val
))
2488 sprintf (pp_buffer (pp
)->digit_buffer
,
2489 "16#%" HOST_WIDE_INT_PRINT
"x",
2490 val
.elt (val
.get_len () - 1));
2491 for (i
= val
.get_len () - 2; i
>= 0; i
--)
2492 sprintf (pp_buffer (pp
)->digit_buffer
,
2493 HOST_WIDE_INT_PRINT_PADDED_HEX
, val
.elt (i
));
2494 pp_string (pp
, pp_buffer (pp
)->digit_buffer
);
2506 if (DECL_IS_UNDECLARED_BUILTIN (node
))
2508 /* Don't print the declaration of built-in types. */
2511 /* If we're in the middle of a declaration, defaults to
2515 append_withs ("System", false);
2516 pp_string (pp
, "System.Address");
2519 pp_string (pp
, "address");
2523 dump_ada_decl_name (pp
, node
, limited_access
);
2526 if (is_tagged_type (TREE_TYPE (node
)))
2530 /* Look for ancestors. */
2531 for (tree fld
= TYPE_FIELDS (TREE_TYPE (node
));
2533 fld
= TREE_CHAIN (fld
))
2535 if (!DECL_NAME (fld
) && is_tagged_type (TREE_TYPE (fld
)))
2539 pp_string (pp
, "limited new ");
2543 pp_string (pp
, " and ");
2545 dump_ada_decl_name (pp
, TYPE_NAME (TREE_TYPE (fld
)),
2550 pp_string (pp
, first
? "tagged limited " : " with ");
2552 else if (has_nontrivial_methods (TREE_TYPE (node
)))
2553 pp_string (pp
, "limited ");
2555 dump_ada_node (pp
, TREE_TYPE (node
), type
, spc
, false, false);
2564 case NAMESPACE_DECL
:
2565 dump_ada_decl_name (pp
, node
, false);
2569 /* Ignore other nodes (e.g. expressions). */
2576 /* Dump in PP NODE's methods. SPC is the indentation level. Return 1 if
2577 methods were printed, 0 otherwise. */
2580 dump_ada_methods (pretty_printer
*pp
, tree node
, int spc
)
2582 if (!has_nontrivial_methods (node
))
2588 for (tree fld
= TYPE_FIELDS (node
); fld
; fld
= DECL_CHAIN (fld
))
2589 if (TREE_CODE (fld
) == FUNCTION_DECL
)
2597 res
= dump_ada_declaration (pp
, fld
, node
, spc
);
2603 /* Dump in PP a forward declaration for TYPE present inside T.
2604 SPC is the indentation level. */
2607 dump_forward_type (pretty_printer
*pp
, tree type
, tree t
, int spc
)
2609 tree decl
= get_underlying_decl (type
);
2611 /* Anonymous pointer and function types. */
2614 if (TREE_CODE (type
) == POINTER_TYPE
)
2615 dump_forward_type (pp
, TREE_TYPE (type
), t
, spc
);
2616 else if (TREE_CODE (type
) == FUNCTION_TYPE
)
2618 function_args_iterator args_iter
;
2620 dump_forward_type (pp
, TREE_TYPE (type
), t
, spc
);
2621 FOREACH_FUNCTION_ARGS (type
, arg
, args_iter
)
2622 dump_forward_type (pp
, arg
, t
, spc
);
2627 if (DECL_IS_UNDECLARED_BUILTIN (decl
) || TREE_VISITED (decl
))
2630 /* Forward declarations are only needed within a given file. */
2631 if (DECL_SOURCE_FILE (decl
) != DECL_SOURCE_FILE (t
))
2634 if (TREE_CODE (type
) == FUNCTION_TYPE
)
2637 /* Generate an incomplete type declaration. */
2638 pp_string (pp
, "type ");
2639 dump_ada_node (pp
, decl
, NULL_TREE
, spc
, false, true);
2641 newline_and_indent (pp
, spc
);
2643 /* Only one incomplete declaration is legal for a given type. */
2644 TREE_VISITED (decl
) = 1;
2647 /* Bitmap of anonymous types already dumped. Anonymous array types are shared
2648 throughout the compilation so it needs to be global. */
2650 static bitmap dumped_anonymous_types
;
2652 static void dump_nested_type (pretty_printer
*, tree
, tree
, int);
2654 /* Dump in PP anonymous types nested inside T's definition. PARENT is the
2655 parent node of T. DUMPED_TYPES is the bitmap of already dumped types. SPC
2656 is the indentation level.
2658 In C anonymous nested tagged types have no name whereas in C++ they have
2659 one. In C their TYPE_DECL is at top level whereas in C++ it is nested.
2660 In both languages untagged types (pointers and arrays) have no name.
2661 In C++ the nested TYPE_DECLs can come after their associated FIELD_DECL.
2663 Therefore, in order to have a common processing for both languages, we
2664 disregard anonymous TYPE_DECLs at top level and here we make a first
2665 pass on the nested TYPE_DECLs and a second pass on the unnamed types. */
2668 dump_nested_types (pretty_printer
*pp
, tree t
, int spc
)
2672 /* Find possible anonymous pointers/arrays/structs/unions recursively. */
2673 type
= TREE_TYPE (t
);
2677 for (field
= TYPE_FIELDS (type
); field
; field
= TREE_CHAIN (field
))
2678 if (TREE_CODE (field
) == TYPE_DECL
2679 && DECL_NAME (field
) != DECL_NAME (t
)
2680 && !DECL_ORIGINAL_TYPE (field
)
2681 && TYPE_NAME (TREE_TYPE (field
)) != TYPE_NAME (type
))
2682 dump_nested_type (pp
, field
, t
, spc
);
2684 for (field
= TYPE_FIELDS (type
); field
; field
= TREE_CHAIN (field
))
2685 if (TREE_CODE (field
) == FIELD_DECL
&& !TYPE_NAME (TREE_TYPE (field
)))
2686 dump_nested_type (pp
, field
, t
, spc
);
2689 /* Dump in PP the anonymous type of FIELD inside T. SPC is the indentation
2693 dump_nested_type (pretty_printer
*pp
, tree field
, tree t
, int spc
)
2695 tree field_type
= TREE_TYPE (field
);
2698 switch (TREE_CODE (field_type
))
2701 tmp
= TREE_TYPE (field_type
);
2702 dump_forward_type (pp
, tmp
, t
, spc
);
2706 /* Anonymous array types are shared. */
2707 if (!bitmap_set_bit (dumped_anonymous_types
, TYPE_UID (field_type
)))
2710 tmp
= strip_array_types (field_type
);
2711 decl
= get_underlying_decl (tmp
);
2713 && !DECL_NAME (decl
)
2714 && DECL_SOURCE_FILE (decl
) == DECL_SOURCE_FILE (t
)
2715 && !TREE_VISITED (decl
))
2717 /* Generate full declaration. */
2718 dump_nested_type (pp
, decl
, t
, spc
);
2719 TREE_VISITED (decl
) = 1;
2721 else if (!decl
&& TREE_CODE (tmp
) == POINTER_TYPE
)
2722 dump_forward_type (pp
, TREE_TYPE (tmp
), t
, spc
);
2724 /* Special case char arrays. */
2725 if (is_char_array (field_type
))
2726 pp_string (pp
, "subtype ");
2728 pp_string (pp
, "type ");
2730 dump_anonymous_type_name (pp
, field_type
);
2731 pp_string (pp
, " is ");
2732 dump_ada_array_type (pp
, field_type
, spc
);
2734 newline_and_indent (pp
, spc
);
2738 if (is_simple_enum (field_type
))
2739 pp_string (pp
, "type ");
2741 pp_string (pp
, "subtype ");
2743 if (TYPE_NAME (field_type
))
2744 dump_ada_node (pp
, field_type
, NULL_TREE
, spc
, false, true);
2746 dump_anonymous_type_name (pp
, field_type
);
2747 pp_string (pp
, " is ");
2748 dump_ada_enum_type (pp
, field_type
, NULL_TREE
, spc
);
2750 newline_and_indent (pp
, spc
);
2755 dump_nested_types (pp
, field
, spc
);
2757 pp_string (pp
, "type ");
2759 if (TYPE_NAME (field_type
))
2760 dump_ada_node (pp
, field_type
, NULL_TREE
, spc
, false, true);
2762 dump_anonymous_type_name (pp
, field_type
);
2764 if (TREE_CODE (field_type
) == UNION_TYPE
)
2765 pp_string (pp
, " (discr : unsigned := 0)");
2767 pp_string (pp
, " is ");
2768 dump_ada_structure (pp
, field_type
, t
, true, spc
);
2770 newline_and_indent (pp
, spc
);
2778 /* Hash table of overloaded names that we cannot support. It is needed even
2779 in Ada 2012 because we merge different types, e.g. void * and const void *
2780 in System.Address, so we cannot have overloading for them in Ada. */
2782 struct overloaded_name_hash
{
2788 struct overloaded_name_hasher
: delete_ptr_hash
<overloaded_name_hash
>
2790 static inline hashval_t
hash (overloaded_name_hash
*t
)
2792 static inline bool equal (overloaded_name_hash
*a
, overloaded_name_hash
*b
)
2793 { return a
->name
== b
->name
; }
2796 typedef hash_table
<overloaded_name_hasher
> htable_t
;
2798 static htable_t
*overloaded_names
;
2800 /* Add an overloaded NAME with N occurrences to TABLE. */
2803 add_name (const char *name
, unsigned int n
, htable_t
*table
)
2805 struct overloaded_name_hash in
, *h
, **slot
;
2806 tree id
= get_identifier (name
);
2807 hashval_t hash
= htab_hash_pointer (id
);
2810 slot
= table
->find_slot_with_hash (&in
, hash
, INSERT
);
2811 h
= new overloaded_name_hash
;
2818 /* Initialize the table with the problematic overloaded names. */
2821 init_overloaded_names (void)
2823 static const char *names
[] =
2824 /* The overloaded names from the /usr/include/string.h file. */
2825 { "memchr", "rawmemchr", "memrchr", "strchr", "strrchr", "strchrnul",
2826 "strpbrk", "strstr", "strcasestr", "index", "rindex", "basename" };
2828 htable_t
*table
= new htable_t (64);
2830 for (unsigned int i
= 0; i
< ARRAY_SIZE (names
); i
++)
2831 add_name (names
[i
], 0, table
);
2833 /* Consider that sigaction() is overloaded by struct sigaction for QNX. */
2834 add_name ("sigaction", 1, table
);
2836 /* Consider that stat() is overloaded by struct stat for QNX. */
2837 add_name ("stat", 1, table
);
2842 /* Return the overloading index of NAME or 0 if NAME is not overloaded. */
2845 overloading_index (tree name
)
2847 struct overloaded_name_hash in
, *h
;
2848 hashval_t hash
= htab_hash_pointer (name
);
2851 h
= overloaded_names
->find_with_hash (&in
, hash
);
2852 return h
? ++h
->n
: 0;
2855 /* Dump in PP constructor spec corresponding to T for TYPE. */
2858 print_constructor (pretty_printer
*pp
, tree t
, tree type
)
2860 tree decl_name
= DECL_NAME (TYPE_NAME (type
));
2862 pp_string (pp
, "New_");
2863 pp_ada_tree_identifier (pp
, decl_name
, t
, false);
2866 /* Dump in PP destructor spec corresponding to T. */
2869 print_destructor (pretty_printer
*pp
, tree t
, tree type
)
2871 tree decl_name
= DECL_NAME (TYPE_NAME (type
));
2873 pp_string (pp
, "Delete_");
2874 if (startswith (IDENTIFIER_POINTER (DECL_NAME (t
)), "__dt_del"))
2875 pp_string (pp
, "And_Free_");
2876 pp_ada_tree_identifier (pp
, decl_name
, t
, false);
2879 /* Dump in PP assignment operator spec corresponding to T. */
2882 print_assignment_operator (pretty_printer
*pp
, tree t
, tree type
)
2884 tree decl_name
= DECL_NAME (TYPE_NAME (type
));
2886 pp_string (pp
, "Assign_");
2887 pp_ada_tree_identifier (pp
, decl_name
, t
, false);
2890 /* Return the name of type T. */
2895 tree n
= TYPE_NAME (t
);
2897 if (TREE_CODE (n
) == IDENTIFIER_NODE
)
2898 return IDENTIFIER_POINTER (n
);
2900 return IDENTIFIER_POINTER (DECL_NAME (n
));
2903 /* Dump in PP the declaration of object T of type TYPE in Ada syntax.
2904 SPC is the indentation level. Return 1 if a declaration was printed,
2908 dump_ada_declaration (pretty_printer
*pp
, tree t
, tree type
, int spc
)
2910 bool is_var
= false;
2911 bool need_indent
= false;
2912 bool is_class
= false;
2913 tree name
= TYPE_NAME (TREE_TYPE (t
));
2914 tree decl_name
= DECL_NAME (t
);
2915 tree orig
= NULL_TREE
;
2917 if (cpp_check
&& cpp_check (t
, IS_TEMPLATE
))
2918 return dump_ada_template (pp
, t
, spc
);
2920 /* Skip enumeral values: will be handled as part of the type itself. */
2921 if (TREE_CODE (t
) == CONST_DECL
&& TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
)
2924 if (TREE_CODE (t
) == TYPE_DECL
)
2926 orig
= DECL_ORIGINAL_TYPE (t
);
2928 /* This is a typedef. */
2929 if (orig
&& TYPE_STUB_DECL (orig
))
2931 tree stub
= TYPE_STUB_DECL (orig
);
2933 /* If this is a typedef of a named type, then output it as a subtype
2934 declaration. ??? Use a derived type declaration instead. */
2935 if (TYPE_NAME (orig
))
2937 /* If the types have the same name (ignoring casing), then ignore
2938 the second type, but forward declare the first if need be. */
2939 if (type_name (orig
) == type_name (TREE_TYPE (t
))
2940 || !strcasecmp (type_name (orig
), type_name (TREE_TYPE (t
))))
2942 if (RECORD_OR_UNION_TYPE_P (orig
) && !TREE_VISITED (stub
))
2945 dump_forward_type (pp
, orig
, t
, 0);
2948 TREE_VISITED (t
) = 1;
2954 if (RECORD_OR_UNION_TYPE_P (orig
) && !TREE_VISITED (stub
))
2955 dump_forward_type (pp
, orig
, t
, spc
);
2957 pp_string (pp
, "subtype ");
2958 dump_ada_node (pp
, t
, type
, spc
, false, true);
2959 pp_string (pp
, " is ");
2960 dump_ada_node (pp
, orig
, type
, spc
, false, true);
2961 pp_string (pp
, "; -- ");
2964 TREE_VISITED (t
) = 1;
2968 /* This is a typedef of an anonymous type. We'll output the full
2969 type declaration of the anonymous type with the typedef'ed name
2970 below. Prevent forward declarations for the anonymous type to
2971 be emitted from now on. */
2972 TREE_VISITED (stub
) = 1;
2975 /* Skip unnamed or anonymous structs/unions/enum types. */
2977 && (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
))
2978 || TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
)
2983 /* Skip duplicates of structs/unions/enum types built in C++. */
2985 && (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
))
2986 || TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
)
2988 && (*IDENTIFIER_POINTER (decl_name
) == '.'
2989 || *IDENTIFIER_POINTER (decl_name
) == '$'))
2994 switch (TREE_CODE (TREE_TYPE (t
)))
2998 if (!COMPLETE_TYPE_P (TREE_TYPE (t
)))
3000 pp_string (pp
, "type ");
3001 dump_ada_node (pp
, t
, type
, spc
, false, true);
3002 pp_string (pp
, " is null record; -- incomplete struct");
3003 TREE_VISITED (t
) = 1;
3007 /* Packed record layout is not fully supported. */
3008 if (TYPE_PACKED (TREE_TYPE (t
)))
3010 warning_at (DECL_SOURCE_LOCATION (t
), 0, "packed layout");
3011 pp_string (pp
, "pragma Compile_Time_Warning (True, ");
3012 pp_string (pp
, "\"packed layout may be incorrect\");");
3013 newline_and_indent (pp
, spc
);
3014 packed_layout
= true;
3017 if (orig
&& TYPE_NAME (orig
))
3018 pp_string (pp
, "subtype ");
3021 if (separate_class_package (t
))
3024 pp_string (pp
, "package Class_");
3025 dump_ada_node (pp
, t
, type
, spc
, false, true);
3026 pp_string (pp
, " is");
3028 newline_and_indent (pp
, spc
);
3031 dump_nested_types (pp
, t
, spc
);
3033 pp_string (pp
, "type ");
3038 case REFERENCE_TYPE
:
3039 dump_forward_type (pp
, TREE_TYPE (TREE_TYPE (t
)), t
, spc
);
3040 if (orig
&& TYPE_NAME (orig
))
3041 pp_string (pp
, "subtype ");
3043 pp_string (pp
, "type ");
3047 if ((orig
&& TYPE_NAME (orig
)) || is_char_array (TREE_TYPE (t
)))
3048 pp_string (pp
, "subtype ");
3050 pp_string (pp
, "type ");
3054 pp_string (pp
, "-- skipped function type ");
3055 dump_ada_node (pp
, t
, type
, spc
, false, true);
3059 if ((orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
3060 || !is_simple_enum (TREE_TYPE (t
)))
3061 pp_string (pp
, "subtype ");
3063 pp_string (pp
, "type ");
3067 pp_string (pp
, "subtype ");
3070 TREE_VISITED (t
) = 1;
3076 && *IDENTIFIER_POINTER (decl_name
) == '_')
3082 /* Print the type and name. */
3083 if (TREE_CODE (TREE_TYPE (t
)) == ARRAY_TYPE
)
3088 /* Print variable's name. */
3089 dump_ada_node (pp
, t
, type
, spc
, false, true);
3091 if (TREE_CODE (t
) == TYPE_DECL
)
3093 pp_string (pp
, " is ");
3095 if (orig
&& TYPE_NAME (orig
))
3096 dump_ada_node (pp
, TYPE_NAME (orig
), type
, spc
, false, true);
3098 dump_ada_array_type (pp
, TREE_TYPE (t
), spc
);
3102 if (spc
== INDENT_INCR
|| TREE_STATIC (t
))
3105 pp_string (pp
, " : ");
3107 if (TREE_CODE (TREE_TYPE (TREE_TYPE (t
))) != POINTER_TYPE
3109 pp_string (pp
, "aliased ");
3111 if (TYPE_NAME (TREE_TYPE (t
)))
3112 dump_ada_node (pp
, TREE_TYPE (t
), type
, spc
, false, true);
3114 dump_anonymous_type_name (pp
, TREE_TYPE (t
));
3116 dump_ada_array_type (pp
, TREE_TYPE (t
), spc
);
3119 else if (TREE_CODE (t
) == FUNCTION_DECL
)
3121 tree decl_name
= DECL_NAME (t
);
3122 bool is_abstract_class
= false;
3123 bool is_method
= TREE_CODE (TREE_TYPE (t
)) == METHOD_TYPE
;
3124 bool is_abstract
= false;
3125 bool is_assignment_operator
= false;
3126 bool is_constructor
= false;
3127 bool is_destructor
= false;
3128 bool is_copy_constructor
= false;
3129 bool is_move_constructor
= false;
3136 is_abstract
= cpp_check (t
, IS_ABSTRACT
);
3137 is_assignment_operator
= cpp_check (t
, IS_ASSIGNMENT_OPERATOR
);
3138 is_constructor
= cpp_check (t
, IS_CONSTRUCTOR
);
3139 is_destructor
= cpp_check (t
, IS_DESTRUCTOR
);
3140 is_copy_constructor
= cpp_check (t
, IS_COPY_CONSTRUCTOR
);
3141 is_move_constructor
= cpp_check (t
, IS_MOVE_CONSTRUCTOR
);
3144 /* Skip copy constructors and C++11 move constructors: some are internal
3145 only and those that are not cannot be called easily from Ada. */
3146 if (is_copy_constructor
|| is_move_constructor
)
3149 if (is_constructor
|| is_destructor
)
3151 /* ??? Skip implicit constructors/destructors for now. */
3152 if (DECL_ARTIFICIAL (t
))
3155 /* Only consider complete constructors and deleting destructors. */
3156 if (!startswith (IDENTIFIER_POINTER (decl_name
), "__ct_comp")
3157 && !startswith (IDENTIFIER_POINTER (decl_name
), "__dt_comp")
3158 && !startswith (IDENTIFIER_POINTER (decl_name
), "__dt_del"))
3162 else if (is_assignment_operator
)
3164 /* ??? Skip implicit or non-method assignment operators for now. */
3165 if (DECL_ARTIFICIAL (t
) || !is_method
)
3169 /* If this function has an entry in the vtable, we cannot omit it. */
3170 else if (!DECL_VINDEX (t
) && *IDENTIFIER_POINTER (decl_name
) == '_')
3173 pp_string (pp
, "-- skipped func ");
3174 pp_string (pp
, IDENTIFIER_POINTER (decl_name
));
3180 dump_forward_type (pp
, TREE_TYPE (t
), t
, spc
);
3182 if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t
))) && !is_constructor
)
3183 pp_string (pp
, "procedure ");
3185 pp_string (pp
, "function ");
3188 print_constructor (pp
, t
, type
);
3189 else if (is_destructor
)
3190 print_destructor (pp
, t
, type
);
3191 else if (is_assignment_operator
)
3192 print_assignment_operator (pp
, t
, type
);
3195 const unsigned int suffix
= overloading_index (decl_name
);
3196 pp_ada_tree_identifier (pp
, decl_name
, t
, false);
3198 pp_decimal_int (pp
, suffix
);
3201 dump_ada_function_declaration
3202 (pp
, t
, is_method
, is_constructor
, is_destructor
, spc
);
3204 if (is_constructor
&& RECORD_OR_UNION_TYPE_P (type
))
3205 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= DECL_CHAIN (fld
))
3206 if (TREE_CODE (fld
) == FUNCTION_DECL
&& cpp_check (fld
, IS_ABSTRACT
))
3208 is_abstract_class
= true;
3212 if (is_abstract
|| is_abstract_class
)
3213 pp_string (pp
, " is abstract");
3215 if (is_abstract
|| !DECL_ASSEMBLER_NAME (t
))
3218 pp_string (pp
, " -- ");
3221 else if (is_constructor
)
3224 pp_string (pp
, " -- ");
3227 newline_and_indent (pp
, spc
);
3228 pp_string (pp
, "pragma CPP_Constructor (");
3229 print_constructor (pp
, t
, type
);
3230 pp_string (pp
, ", \"");
3231 pp_asm_name (pp
, t
);
3232 pp_string (pp
, "\");");
3236 pp_string (pp
, " -- ");
3239 newline_and_indent (pp
, spc
);
3240 dump_ada_import (pp
, t
, spc
);
3245 else if (TREE_CODE (t
) == TYPE_DECL
&& !orig
)
3247 bool is_interface
= false;
3248 bool is_abstract_record
= false;
3250 /* Anonymous structs/unions. */
3251 dump_ada_node (pp
, TREE_TYPE (t
), t
, spc
, false, true);
3253 if (TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
)
3254 pp_string (pp
, " (discr : unsigned := 0)");
3256 pp_string (pp
, " is ");
3258 /* Check whether we have an Ada interface compatible class.
3259 That is only have a vtable non-static data member and no
3260 non-abstract methods. */
3262 && RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
)))
3264 bool has_fields
= false;
3266 /* Check that there are no fields other than the virtual table. */
3267 for (tree fld
= TYPE_FIELDS (TREE_TYPE (t
));
3269 fld
= TREE_CHAIN (fld
))
3271 if (TREE_CODE (fld
) == FIELD_DECL
)
3273 if (!has_fields
&& DECL_VIRTUAL_P (fld
))
3274 is_interface
= true;
3276 is_interface
= false;
3279 else if (TREE_CODE (fld
) == FUNCTION_DECL
3280 && !DECL_ARTIFICIAL (fld
))
3282 if (cpp_check (fld
, IS_ABSTRACT
))
3283 is_abstract_record
= true;
3285 is_interface
= false;
3290 TREE_VISITED (t
) = 1;
3293 pp_string (pp
, "limited interface -- ");
3295 newline_and_indent (pp
, spc
);
3296 pp_string (pp
, "with Import => True,");
3297 newline_and_indent (pp
, spc
+ 5);
3298 pp_string (pp
, "Convention => CPP");
3300 dump_ada_methods (pp
, TREE_TYPE (t
), spc
);
3304 if (is_abstract_record
)
3305 pp_string (pp
, "abstract ");
3306 dump_ada_node (pp
, t
, t
, spc
, false, false);
3314 if ((TREE_CODE (t
) == FIELD_DECL
|| VAR_P (t
))
3316 check_type_name_conflict (pp
, t
);
3318 /* Print variable/type's name. */
3319 dump_ada_node (pp
, t
, t
, spc
, false, true);
3321 if (TREE_CODE (t
) == TYPE_DECL
)
3323 const bool is_subtype
= TYPE_NAME (orig
);
3325 if (!is_subtype
&& TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
)
3326 pp_string (pp
, " (discr : unsigned := 0)");
3328 pp_string (pp
, " is ");
3330 dump_ada_node (pp
, orig
, t
, spc
, false, is_subtype
);
3334 if (spc
== INDENT_INCR
|| TREE_STATIC (t
))
3337 pp_string (pp
, " : ");
3339 if (TREE_CODE (TREE_TYPE (t
)) != POINTER_TYPE
3340 && (TYPE_NAME (TREE_TYPE (t
))
3341 || (TREE_CODE (TREE_TYPE (t
)) != INTEGER_TYPE
3342 && TREE_CODE (TREE_TYPE (t
)) != ENUMERAL_TYPE
))
3344 pp_string (pp
, "aliased ");
3346 if (TREE_READONLY (t
) && TREE_CODE (t
) != FIELD_DECL
)
3347 pp_string (pp
, "constant ");
3349 if (TYPE_NAME (TREE_TYPE (t
))
3350 || (!RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
))
3351 && TREE_CODE (TREE_TYPE (t
)) != ENUMERAL_TYPE
))
3352 dump_ada_node (pp
, TREE_TYPE (t
), t
, spc
, false, true);
3354 dump_anonymous_type_name (pp
, TREE_TYPE (t
));
3361 newline_and_indent (pp
, spc
);
3362 pp_string (pp
, "end;");
3363 newline_and_indent (pp
, spc
);
3364 pp_string (pp
, "use Class_");
3365 dump_ada_node (pp
, t
, type
, spc
, false, true);
3369 /* All needed indentation/newline performed already, so return 0. */
3374 pp_string (pp
, " -- ");
3376 newline_and_indent (pp
, spc
);
3377 dump_ada_import (pp
, t
, spc
);
3382 pp_string (pp
, "; -- ");
3389 /* Dump in PP a structure NODE of type TYPE in Ada syntax. If NESTED is
3390 true, it's an anonymous nested type. SPC is the indentation level. */
3393 dump_ada_structure (pretty_printer
*pp
, tree node
, tree type
, bool nested
,
3396 const bool is_union
= (TREE_CODE (node
) == UNION_TYPE
);
3399 int field_spc
= spc
+ INDENT_INCR
;
3402 bitfield_used
= false;
3404 /* Print the contents of the structure. */
3405 pp_string (pp
, "record");
3409 newline_and_indent (pp
, spc
+ INDENT_INCR
);
3410 pp_string (pp
, "case discr is");
3411 field_spc
= spc
+ INDENT_INCR
* 3;
3416 /* Print the non-static fields of the structure. */
3417 for (tree tmp
= TYPE_FIELDS (node
); tmp
; tmp
= TREE_CHAIN (tmp
))
3419 /* Add parent field if needed. */
3420 if (!DECL_NAME (tmp
))
3422 if (!is_tagged_type (TREE_TYPE (tmp
)))
3424 if (!TYPE_NAME (TREE_TYPE (tmp
)))
3425 dump_ada_declaration (pp
, tmp
, type
, field_spc
);
3431 pp_string (pp
, "parent : aliased ");
3434 sprintf (buf
, "field_%d : aliased ", field_num
+ 1);
3435 pp_string (pp
, buf
);
3437 dump_ada_decl_name (pp
, TYPE_NAME (TREE_TYPE (tmp
)),
3446 else if (TREE_CODE (tmp
) == FIELD_DECL
)
3448 /* Skip internal virtual table field. */
3449 if (!DECL_VIRTUAL_P (tmp
))
3453 if (TREE_CHAIN (tmp
)
3454 && TREE_TYPE (TREE_CHAIN (tmp
)) != node
3455 && TREE_CODE (TREE_CHAIN (tmp
)) != TYPE_DECL
)
3456 sprintf (buf
, "when %d =>", field_num
);
3458 sprintf (buf
, "when others =>");
3460 INDENT (spc
+ INDENT_INCR
* 2);
3461 pp_string (pp
, buf
);
3465 if (dump_ada_declaration (pp
, tmp
, type
, field_spc
))
3476 INDENT (spc
+ INDENT_INCR
);
3477 pp_string (pp
, "end case;");
3483 INDENT (spc
+ INDENT_INCR
);
3484 pp_string (pp
, "null;");
3489 pp_string (pp
, "end record");
3491 newline_and_indent (pp
, spc
);
3493 /* We disregard the methods for anonymous nested types. */
3494 if (has_nontrivial_methods (node
) && !nested
)
3496 pp_string (pp
, "with Import => True,");
3497 newline_and_indent (pp
, spc
+ 5);
3498 pp_string (pp
, "Convention => CPP");
3501 pp_string (pp
, "with Convention => C_Pass_By_Copy");
3506 newline_and_indent (pp
, spc
+ 5);
3507 pp_string (pp
, "Unchecked_Union => True");
3510 if (bitfield_used
|| packed_layout
)
3514 newline_and_indent (pp
, spc
+ 5);
3515 pp_string (pp
, "Pack => True");
3517 newline_and_indent (pp
, spc
+ 5);
3518 sprintf (buf
, "Alignment => %d", TYPE_ALIGN (node
) / BITS_PER_UNIT
);
3519 pp_string (pp
, buf
);
3520 bitfield_used
= false;
3521 packed_layout
= false;
3527 need_semicolon
= !dump_ada_methods (pp
, node
, spc
);
3529 /* Print the static fields of the structure, if any. */
3530 for (tree tmp
= TYPE_FIELDS (node
); tmp
; tmp
= TREE_CHAIN (tmp
))
3532 if (VAR_P (tmp
) && DECL_NAME (tmp
))
3536 need_semicolon
= false;
3541 dump_ada_declaration (pp
, tmp
, type
, spc
);
3546 /* Dump all the declarations in SOURCE_FILE to an Ada spec.
3547 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3548 nodes for SOURCE_FILE. CHECK is used to perform C++ queries on nodes. */
3551 dump_ads (const char *source_file
,
3552 void (*collect_all_refs
)(const char *),
3553 int (*check
)(tree
, cpp_operation
))
3560 pkg_name
= get_ada_package (source_file
);
3562 /* Construct the .ads filename and package name. */
3563 ads_name
= xstrdup (pkg_name
);
3565 for (s
= ads_name
; *s
; s
++)
3571 ads_name
= reconcat (ads_name
, ads_name
, ".ads", NULL
);
3573 /* Write out the .ads file. */
3574 f
= fopen (ads_name
, "w");
3579 pp_needs_newline (&pp
) = true;
3580 pp
.set_output_stream (f
);
3582 /* Dump all relevant macros. */
3583 dump_ada_macros (&pp
, source_file
);
3585 /* Reset the table of withs for this file. */
3588 (*collect_all_refs
) (source_file
);
3590 /* Dump all references. */
3592 dump_ada_nodes (&pp
, source_file
);
3594 /* We require Ada 2012 syntax, so generate corresponding pragma. */
3595 fputs ("pragma Ada_2012;\n\n", f
);
3597 /* Disable style checks and warnings on unused entities since this file
3598 is auto-generated and always has a with clause for Interfaces.C. */
3599 fputs ("pragma Style_Checks (Off);\n", f
);
3600 fputs ("pragma Warnings (Off, \"-gnatwu\");\n\n", f
);
3605 fprintf (f
, "\npackage %s is\n\n", pkg_name
);
3606 pp_write_text_to_stream (&pp
);
3607 /* ??? need to free pp */
3608 fprintf (f
, "end %s;\n\n", pkg_name
);
3610 fputs ("pragma Style_Checks (On);\n", f
);
3611 fputs ("pragma Warnings (On, \"-gnatwu\");\n", f
);
3619 static const char **source_refs
= NULL
;
3620 static int source_refs_used
= 0;
3621 static int source_refs_allocd
= 0;
3623 /* Add an entry for FILENAME to the table SOURCE_REFS. */
3626 collect_source_ref (const char *filename
)
3633 if (source_refs_allocd
== 0)
3635 source_refs_allocd
= 1024;
3636 source_refs
= XNEWVEC (const char *, source_refs_allocd
);
3639 for (i
= 0; i
< source_refs_used
; i
++)
3640 if (filename
== source_refs
[i
])
3643 if (source_refs_used
== source_refs_allocd
)
3645 source_refs_allocd
*= 2;
3646 source_refs
= XRESIZEVEC (const char *, source_refs
, source_refs_allocd
);
3649 source_refs
[source_refs_used
++] = filename
;
3652 /* Main entry point: dump all Ada specs corresponding to SOURCE_REFS
3653 using callbacks COLLECT_ALL_REFS and CHECK.
3654 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3655 nodes for a given source file.
3656 CHECK is used to perform C++ queries on nodes, or NULL for the C
3660 dump_ada_specs (void (*collect_all_refs
)(const char *),
3661 int (*check
)(tree
, cpp_operation
))
3663 bitmap_obstack_initialize (NULL
);
3665 overloaded_names
= init_overloaded_names ();
3667 /* Iterate over the list of files to dump specs for. */
3668 for (int i
= 0; i
< source_refs_used
; i
++)
3670 dumped_anonymous_types
= BITMAP_ALLOC (NULL
);
3671 dump_ads (source_refs
[i
], collect_all_refs
, check
);
3672 BITMAP_FREE (dumped_anonymous_types
);
3675 /* Free various tables. */
3677 delete overloaded_names
;
3679 bitmap_obstack_release (NULL
);