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-2020 Free Software Foundation, Inc.
4 Adapted from tree-pretty-print.c 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 (buffer); } 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 /* Dump all digits/hex chars from NUMBER to BUFFER and return a pointer
117 to the character after the last character written. If FLOAT_P is true,
118 this is a floating-point number. */
120 static unsigned char *
121 dump_number (unsigned char *number
, unsigned char *buffer
, bool float_p
)
123 while (*number
!= '\0'
124 && *number
!= (float_p
? 'F' : 'U')
125 && *number
!= (float_p
? 'f' : 'u')
128 *buffer
++ = *number
++;
133 /* Handle escape character C and convert to an Ada character into BUFFER.
134 Return a pointer to the character after the last character written, or
135 NULL if the escape character is not supported. */
137 static unsigned char *
138 handle_escape_character (unsigned char *buffer
, char c
)
148 strcpy ((char *) buffer
, "\" & ASCII.LF & \"");
153 strcpy ((char *) buffer
, "\" & ASCII.CR & \"");
158 strcpy ((char *) buffer
, "\" & ASCII.HT & \"");
169 /* Callback used to count the number of macros from cpp_forall_identifiers.
170 PFILE and V are not used. NODE is the current macro to consider. */
173 count_ada_macro (cpp_reader
*pfile ATTRIBUTE_UNUSED
, cpp_hashnode
*node
,
174 void *v ATTRIBUTE_UNUSED
)
176 if (cpp_user_macro_p (node
) && *NODE_NAME (node
) != '_')
178 const cpp_macro
*macro
= node
->value
.macro
;
179 if (macro
->count
&& LOCATION_FILE (macro
->line
) == macro_source_file
)
186 /* Callback used to store relevant macros from cpp_forall_identifiers.
187 PFILE is not used. NODE is the current macro to store if relevant.
188 MACROS is an array of cpp_hashnode* used to store NODE. */
191 store_ada_macro (cpp_reader
*pfile ATTRIBUTE_UNUSED
,
192 cpp_hashnode
*node
, void *macros
)
194 if (cpp_user_macro_p (node
) && *NODE_NAME (node
) != '_')
196 const cpp_macro
*macro
= node
->value
.macro
;
198 && LOCATION_FILE (macro
->line
) == macro_source_file
)
199 ((cpp_hashnode
**) macros
)[store_ada_macro_index
++] = node
;
204 /* Callback used to compare (during qsort) macros. NODE1 and NODE2 are the
205 two macro nodes to compare. */
208 compare_macro (const void *node1
, const void *node2
)
210 typedef const cpp_hashnode
*const_hnode
;
212 const_hnode n1
= *(const const_hnode
*) node1
;
213 const_hnode n2
= *(const const_hnode
*) node2
;
215 return n1
->value
.macro
->line
- n2
->value
.macro
->line
;
218 /* Dump in PP all relevant macros appearing in FILE. */
221 dump_ada_macros (pretty_printer
*pp
, const char* file
)
223 int num_macros
= 0, prev_line
= -1;
224 cpp_hashnode
**macros
;
226 /* Initialize file-scope variables. */
228 store_ada_macro_index
= 0;
229 macro_source_file
= file
;
231 /* Count all potentially relevant macros, and then sort them by sloc. */
232 cpp_forall_identifiers (parse_in
, count_ada_macro
, NULL
);
233 macros
= XALLOCAVEC (cpp_hashnode
*, max_ada_macros
);
234 cpp_forall_identifiers (parse_in
, store_ada_macro
, macros
);
235 qsort (macros
, max_ada_macros
, sizeof (cpp_hashnode
*), compare_macro
);
237 for (int j
= 0; j
< max_ada_macros
; j
++)
239 cpp_hashnode
*node
= macros
[j
];
240 const cpp_macro
*macro
= node
->value
.macro
;
242 int supported
= 1, prev_is_one
= 0, buffer_len
, param_len
;
243 int is_string
= 0, is_char
= 0;
245 unsigned char *s
, *params
, *buffer
, *buf_param
, *char_one
= NULL
, *tmp
;
247 macro_length (macro
, &supported
, &buffer_len
, ¶m_len
);
248 s
= buffer
= XALLOCAVEC (unsigned char, buffer_len
);
249 params
= buf_param
= XALLOCAVEC (unsigned char, param_len
);
256 for (i
= 0; i
< macro
->paramc
; i
++)
258 cpp_hashnode
*param
= macro
->parm
.params
[i
];
260 memcpy (buf_param
, NODE_NAME (param
), NODE_LEN (param
));
261 buf_param
+= NODE_LEN (param
);
263 if (i
+ 1 < macro
->paramc
)
268 else if (macro
->variadic
)
278 for (i
= 0; supported
&& i
< macro
->count
; i
++)
280 const cpp_token
*token
= ¯o
->exp
.tokens
[i
];
283 if (token
->flags
& PREV_WHITE
)
286 if (token
->flags
& STRINGIFY_ARG
|| token
->flags
& PASTE_LEFT
)
296 cpp_hashnode
*param
=
297 macro
->parm
.params
[token
->val
.macro_arg
.arg_no
- 1];
298 memcpy (buffer
, NODE_NAME (param
), NODE_LEN (param
));
299 buffer
+= NODE_LEN (param
);
303 case CPP_EQ_EQ
: *buffer
++ = '='; break;
304 case CPP_GREATER
: *buffer
++ = '>'; break;
305 case CPP_LESS
: *buffer
++ = '<'; break;
306 case CPP_PLUS
: *buffer
++ = '+'; break;
307 case CPP_MINUS
: *buffer
++ = '-'; break;
308 case CPP_MULT
: *buffer
++ = '*'; break;
309 case CPP_DIV
: *buffer
++ = '/'; break;
310 case CPP_COMMA
: *buffer
++ = ','; break;
311 case CPP_OPEN_SQUARE
:
312 case CPP_OPEN_PAREN
: *buffer
++ = '('; break;
313 case CPP_CLOSE_SQUARE
: /* fallthrough */
314 case CPP_CLOSE_PAREN
: *buffer
++ = ')'; break;
315 case CPP_DEREF
: /* fallthrough */
316 case CPP_SCOPE
: /* fallthrough */
317 case CPP_DOT
: *buffer
++ = '.'; break;
319 case CPP_EQ
: *buffer
++ = ':'; *buffer
++ = '='; break;
320 case CPP_NOT_EQ
: *buffer
++ = '/'; *buffer
++ = '='; break;
321 case CPP_GREATER_EQ
: *buffer
++ = '>'; *buffer
++ = '='; break;
322 case CPP_LESS_EQ
: *buffer
++ = '<'; *buffer
++ = '='; break;
325 *buffer
++ = 'n'; *buffer
++ = 'o'; *buffer
++ = 't'; break;
327 *buffer
++ = 'm'; *buffer
++ = 'o'; *buffer
++ = 'd'; break;
329 *buffer
++ = 'a'; *buffer
++ = 'n'; *buffer
++ = 'd'; break;
331 *buffer
++ = 'o'; *buffer
++ = 'r'; break;
333 *buffer
++ = 'x'; *buffer
++ = 'o'; *buffer
++ = 'r'; break;
335 strcpy ((char *) buffer
, " and then ");
339 strcpy ((char *) buffer
, " or else ");
345 is_one
= prev_is_one
;
360 if (!macro
->fun_like
)
364 = cpp_spell_token (parse_in
, token
, buffer
, false);
376 const unsigned char *s
= token
->val
.str
.text
;
382 buffer
= handle_escape_character (buffer
, *s
);
401 c
= cpp_interpret_charconst (parse_in
, token
,
402 &chars_seen
, &ignored
);
403 if (c
>= 32 && c
<= 126)
406 *buffer
++ = (char) c
;
412 ((char *) buffer
, "Character'Val (%d)", (int) c
);
413 buffer
+= chars_seen
;
419 tmp
= cpp_token_as_text (parse_in
, token
);
439 buffer
= dump_number (tmp
+ 2, buffer
, false);
447 buffer
= dump_number (tmp
+ 2, buffer
, false);
452 /* Dump floating-point constant unmodified. */
453 if (strchr ((const char *)tmp
, '.'))
454 buffer
= dump_number (tmp
, buffer
, true);
460 = dump_number (tmp
+ 1, buffer
, false);
483 = dump_number (tmp
, buffer
,
484 strchr ((const char *)tmp
, '.'));
492 /* Replace "1 << N" by "2 ** N" */
519 case CPP_CLOSE_BRACE
:
523 case CPP_MINUS_MINUS
:
527 case CPP_HEADER_NAME
:
530 case CPP_OBJC_STRING
:
532 if (!macro
->fun_like
)
535 buffer
= cpp_spell_token (parse_in
, token
, buffer
, false);
539 prev_is_one
= is_one
;
546 if (macro
->fun_like
&& supported
)
548 char *start
= (char *) s
;
551 pp_string (pp
, " -- arg-macro: ");
553 if (*start
== '(' && buffer
[-1] == ')')
558 pp_string (pp
, "function ");
562 pp_string (pp
, "procedure ");
565 pp_string (pp
, (const char *) NODE_NAME (node
));
567 pp_string (pp
, (char *) params
);
569 pp_string (pp
, " -- ");
573 pp_string (pp
, "return ");
574 pp_string (pp
, start
);
578 pp_string (pp
, start
);
584 expanded_location sloc
= expand_location (macro
->line
);
586 if (sloc
.line
!= prev_line
+ 1 && prev_line
> 0)
590 prev_line
= sloc
.line
;
593 ada_name
= to_ada_name ((const char *) NODE_NAME (node
), NULL
);
594 pp_string (pp
, ada_name
);
596 pp_string (pp
, " : ");
599 pp_string (pp
, "aliased constant String");
601 pp_string (pp
, "aliased constant Character");
603 pp_string (pp
, "constant");
605 pp_string (pp
, " := ");
606 pp_string (pp
, (char *) s
);
609 pp_string (pp
, " & ASCII.NUL");
611 pp_string (pp
, "; -- ");
612 pp_string (pp
, sloc
.file
);
614 pp_scalar (pp
, "%d", sloc
.line
);
619 pp_string (pp
, " -- unsupported macro: ");
620 pp_string (pp
, (const char *) cpp_macro_definition (parse_in
, node
));
629 /* Current source file being handled. */
630 static const char *current_source_file
;
632 /* Return sloc of DECL, using sloc of last field if LAST is true. */
635 decl_sloc (const_tree decl
, bool last
)
639 /* Compare the declaration of struct-like types based on the sloc of their
640 last field (if LAST is true), so that more nested types collate before
642 if (TREE_CODE (decl
) == TYPE_DECL
643 && !DECL_ORIGINAL_TYPE (decl
)
644 && RECORD_OR_UNION_TYPE_P (TREE_TYPE (decl
))
645 && (field
= TYPE_FIELDS (TREE_TYPE (decl
))))
648 while (DECL_CHAIN (field
))
649 field
= DECL_CHAIN (field
);
650 return DECL_SOURCE_LOCATION (field
);
653 return DECL_SOURCE_LOCATION (decl
);
656 /* Compare two locations LHS and RHS. */
659 compare_location (location_t lhs
, location_t rhs
)
661 expanded_location xlhs
= expand_location (lhs
);
662 expanded_location xrhs
= expand_location (rhs
);
664 if (xlhs
.file
!= xrhs
.file
)
665 return filename_cmp (xlhs
.file
, xrhs
.file
);
667 if (xlhs
.line
!= xrhs
.line
)
668 return xlhs
.line
- xrhs
.line
;
670 if (xlhs
.column
!= xrhs
.column
)
671 return xlhs
.column
- xrhs
.column
;
676 /* Compare two declarations (LP and RP) by their source location. */
679 compare_node (const void *lp
, const void *rp
)
681 const_tree lhs
= *((const tree
*) lp
);
682 const_tree rhs
= *((const tree
*) rp
);
684 = compare_location (decl_sloc (lhs
, true), decl_sloc (rhs
, true));
686 return ret
? ret
: DECL_UID (lhs
) - DECL_UID (rhs
);
689 /* Compare two comments (LP and RP) by their source location. */
692 compare_comment (const void *lp
, const void *rp
)
694 const cpp_comment
*lhs
= (const cpp_comment
*) lp
;
695 const cpp_comment
*rhs
= (const cpp_comment
*) rp
;
697 return compare_location (lhs
->sloc
, rhs
->sloc
);
700 static tree
*to_dump
= NULL
;
701 static int to_dump_count
= 0;
703 /* Collect a list of declarations from T relevant to SOURCE_FILE to be dumped
704 by a subsequent call to dump_ada_nodes. */
707 collect_ada_nodes (tree t
, const char *source_file
)
710 int i
= to_dump_count
;
712 /* Count the likely relevant nodes: do not dump builtins (they are irrelevant
713 in the context of bindings) and namespaces (we do not handle them properly
715 for (n
= t
; n
; n
= TREE_CHAIN (n
))
716 if (!DECL_IS_BUILTIN (n
)
717 && TREE_CODE (n
) != NAMESPACE_DECL
718 && LOCATION_FILE (decl_sloc (n
, false)) == source_file
)
721 /* Allocate sufficient storage for all nodes. */
722 to_dump
= XRESIZEVEC (tree
, to_dump
, to_dump_count
);
724 /* Store the relevant nodes. */
725 for (n
= t
; n
; n
= TREE_CHAIN (n
))
726 if (!DECL_IS_BUILTIN (n
)
727 && TREE_CODE (n
) != NAMESPACE_DECL
728 && LOCATION_FILE (decl_sloc (n
, false)) == source_file
)
732 /* Call back for walk_tree to clear the TREE_VISITED flag of TP. */
735 unmark_visited_r (tree
*tp
, int *walk_subtrees ATTRIBUTE_UNUSED
,
736 void *data ATTRIBUTE_UNUSED
)
738 if (TREE_VISITED (*tp
))
739 TREE_VISITED (*tp
) = 0;
746 /* Print a COMMENT to the output stream PP. */
749 print_comment (pretty_printer
*pp
, const char *comment
)
751 int len
= strlen (comment
);
752 char *str
= XALLOCAVEC (char, len
+ 1);
754 bool extra_newline
= false;
756 memcpy (str
, comment
, len
+ 1);
758 /* Trim C/C++ comment indicators. */
759 if (str
[len
- 2] == '*' && str
[len
- 1] == '/')
766 tok
= strtok (str
, "\n");
768 pp_string (pp
, " --");
771 tok
= strtok (NULL
, "\n");
773 /* Leave a blank line after multi-line comments. */
775 extra_newline
= true;
782 /* Dump nodes into PP relevant to SOURCE_FILE, as collected by previous calls
783 to collect_ada_nodes. */
786 dump_ada_nodes (pretty_printer
*pp
, const char *source_file
)
789 cpp_comment_table
*comments
;
791 /* Sort the table of declarations to dump by sloc. */
792 qsort (to_dump
, to_dump_count
, sizeof (tree
), compare_node
);
794 /* Fetch the table of comments. */
795 comments
= cpp_get_comments (parse_in
);
797 /* Sort the comments table by sloc. */
798 if (comments
->count
> 1)
799 qsort (comments
->entries
, comments
->count
, sizeof (cpp_comment
),
802 /* Interleave comments and declarations in line number order. */
806 /* Advance j until comment j is in this file. */
807 while (j
!= comments
->count
808 && LOCATION_FILE (comments
->entries
[j
].sloc
) != source_file
)
811 /* Advance j until comment j is not a duplicate. */
812 while (j
< comments
->count
- 1
813 && !compare_comment (&comments
->entries
[j
],
814 &comments
->entries
[j
+ 1]))
817 /* Write decls until decl i collates after comment j. */
818 while (i
!= to_dump_count
)
820 if (j
== comments
->count
821 || LOCATION_LINE (decl_sloc (to_dump
[i
], false))
822 < LOCATION_LINE (comments
->entries
[j
].sloc
))
824 current_source_file
= source_file
;
826 if (dump_ada_declaration (pp
, to_dump
[i
++], NULL_TREE
,
837 /* Write comment j, if there is one. */
838 if (j
!= comments
->count
)
839 print_comment (pp
, comments
->entries
[j
++].comment
);
841 } while (i
!= to_dump_count
|| j
!= comments
->count
);
843 /* Clear the TREE_VISITED flag over each subtree we've dumped. */
844 for (i
= 0; i
< to_dump_count
; i
++)
845 walk_tree (&to_dump
[i
], unmark_visited_r
, NULL
, NULL
);
847 /* Finalize the to_dump table. */
856 /* Dump a newline and indent BUFFER by SPC chars. */
859 newline_and_indent (pretty_printer
*buffer
, int spc
)
865 struct with
{ char *s
; const char *in_file
; bool limited
; };
866 static struct with
*withs
= NULL
;
867 static int withs_max
= 4096;
868 static int with_len
= 0;
870 /* Record a "with" clause on package S (a limited with if LIMITED_ACCESS is
871 true), if not already done. */
874 append_withs (const char *s
, bool limited_access
)
879 withs
= XNEWVEC (struct with
, withs_max
);
881 if (with_len
== withs_max
)
884 withs
= XRESIZEVEC (struct with
, withs
, withs_max
);
887 for (i
= 0; i
< with_len
; i
++)
888 if (!strcmp (s
, withs
[i
].s
)
889 && current_source_file
== withs
[i
].in_file
)
891 withs
[i
].limited
&= limited_access
;
895 withs
[with_len
].s
= xstrdup (s
);
896 withs
[with_len
].in_file
= current_source_file
;
897 withs
[with_len
].limited
= limited_access
;
901 /* Reset "with" clauses. */
904 reset_ada_withs (void)
911 for (i
= 0; i
< with_len
; i
++)
919 /* Dump "with" clauses in F. */
922 dump_ada_withs (FILE *f
)
926 fprintf (f
, "with Interfaces.C; use Interfaces.C;\n");
928 for (i
= 0; i
< with_len
; i
++)
930 (f
, "%swith %s;\n", withs
[i
].limited
? "limited " : "", withs
[i
].s
);
933 /* Return suitable Ada package name from FILE. */
936 get_ada_package (const char *file
)
944 s
= strstr (file
, "/include/");
948 base
= lbasename (file
);
950 if (ada_specs_parent
== NULL
)
953 plen
= strlen (ada_specs_parent
) + 1;
955 res
= XNEWVEC (char, plen
+ strlen (base
) + 1);
956 if (ada_specs_parent
!= NULL
) {
957 strcpy (res
, ada_specs_parent
);
961 for (i
= plen
; *base
; base
++, i
++)
973 res
[i
] = (i
== 0 || res
[i
- 1] == '.' || res
[i
- 1] == '_') ? 'u' : '_';
985 static const char *ada_reserved
[] = {
986 "abort", "abs", "abstract", "accept", "access", "aliased", "all", "and",
987 "array", "at", "begin", "body", "case", "constant", "declare", "delay",
988 "delta", "digits", "do", "else", "elsif", "end", "entry", "exception",
989 "exit", "for", "function", "generic", "goto", "if", "in", "interface", "is",
990 "limited", "loop", "mod", "new", "not", "null", "others", "out", "of", "or",
991 "overriding", "package", "pragma", "private", "procedure", "protected",
992 "raise", "range", "record", "rem", "renames", "requeue", "return", "reverse",
993 "select", "separate", "subtype", "synchronized", "tagged", "task",
994 "terminate", "then", "type", "until", "use", "when", "while", "with", "xor",
997 /* ??? would be nice to specify this list via a config file, so that users
998 can create their own dictionary of conflicts. */
999 static const char *c_duplicates
[] = {
1000 /* system will cause troubles with System.Address. */
1003 /* The following values have other definitions with same name/other
1009 "rl_readline_version",
1015 /* Return a declaration tree corresponding to TYPE. */
1018 get_underlying_decl (tree type
)
1023 /* type is a declaration. */
1029 /* Strip qualifiers but do not look through typedefs. */
1030 if (TYPE_QUALS_NO_ADDR_SPACE (type
))
1031 type
= TYPE_MAIN_VARIANT (type
);
1033 /* type is a typedef. */
1034 if (TYPE_NAME (type
) && DECL_P (TYPE_NAME (type
)))
1035 return TYPE_NAME (type
);
1037 /* TYPE_STUB_DECL has been set for type. */
1038 if (TYPE_STUB_DECL (type
))
1039 return TYPE_STUB_DECL (type
);
1045 /* Return whether TYPE has static fields. */
1048 has_static_fields (const_tree type
)
1050 if (!type
|| !RECORD_OR_UNION_TYPE_P (type
) || !COMPLETE_TYPE_P (type
))
1053 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= TREE_CHAIN (fld
))
1054 if (TREE_CODE (fld
) == VAR_DECL
&& DECL_NAME (fld
))
1060 /* Return whether TYPE corresponds to an Ada tagged type (has a dispatch
1064 is_tagged_type (const_tree type
)
1066 if (!type
|| !RECORD_OR_UNION_TYPE_P (type
) || !COMPLETE_TYPE_P (type
))
1069 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= TREE_CHAIN (fld
))
1070 if (TREE_CODE (fld
) == FUNCTION_DECL
&& DECL_VINDEX (fld
))
1076 /* Return whether TYPE has non-trivial methods, i.e. methods that do something
1077 for the objects of TYPE. In C++, all classes have implicit special methods,
1078 e.g. constructors and destructors, but they can be trivial if the type is
1079 sufficiently simple. */
1082 has_nontrivial_methods (tree type
)
1084 if (!type
|| !RECORD_OR_UNION_TYPE_P (type
) || !COMPLETE_TYPE_P (type
))
1087 /* Only C++ types can have methods. */
1091 /* A non-trivial type has non-trivial special methods. */
1092 if (!cpp_check (type
, IS_TRIVIAL
))
1095 /* If there are user-defined methods, they are deemed non-trivial. */
1096 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= DECL_CHAIN (fld
))
1097 if (TREE_CODE (fld
) == FUNCTION_DECL
&& !DECL_ARTIFICIAL (fld
))
1103 #define INDEX_LENGTH 8
1105 /* Generate a legal Ada name from a C/C++ NAME and return a malloc'ed string.
1106 SPACE_FOUND, if not NULL, is used to indicate whether a space was found in
1110 to_ada_name (const char *name
, bool *space_found
)
1113 const int len
= strlen (name
);
1116 char *s
= XNEWVEC (char, len
* 2 + 5);
1120 *space_found
= false;
1122 /* Add "c_" prefix if name is an Ada reserved word. */
1123 for (names
= ada_reserved
; *names
; names
++)
1124 if (!strcasecmp (name
, *names
))
1133 /* Add "c_" prefix if name is a potential case sensitive duplicate. */
1134 for (names
= c_duplicates
; *names
; names
++)
1135 if (!strcmp (name
, *names
))
1143 for (j
= 0; name
[j
] == '_'; j
++)
1148 else if (*name
== '.' || *name
== '$')
1158 /* Replace unsuitable characters for Ada identifiers. */
1159 for (; j
< len
; j
++)
1164 *space_found
= true;
1168 /* ??? missing some C++ operators. */
1172 if (name
[j
+ 1] == '=')
1187 if (name
[j
+ 1] == '=')
1205 s
[len2
++] = name
[j
] == '&' ? 'a' : name
[j
] == '|' ? 'o' : 'x';
1207 if (name
[j
+ 1] == '=')
1220 if (s
[len2
- 1] != '_')
1223 switch (name
[j
+ 1]) {
1226 switch (name
[j
- 1]) {
1227 case '+': s
[len2
++] = 'p'; break; /* + */
1228 case '-': s
[len2
++] = 'm'; break; /* - */
1229 case '*': s
[len2
++] = 't'; break; /* * */
1230 case '/': s
[len2
++] = 'd'; break; /* / */
1236 switch (name
[j
- 1]) {
1237 case '+': s
[len2
++] = 'p'; break; /* += */
1238 case '-': s
[len2
++] = 'm'; break; /* -= */
1239 case '*': s
[len2
++] = 't'; break; /* *= */
1240 case '/': s
[len2
++] = 'd'; break; /* /= */
1274 c
= name
[j
] == '<' ? 'l' : 'g';
1277 switch (name
[j
+ 1]) {
1303 if (len2
&& s
[len2
- 1] == '_')
1308 s
[len2
++] = name
[j
];
1311 if (s
[len2
- 1] == '_')
1319 /* Return true if DECL refers to a C++ class type for which a
1320 separate enclosing package has been or should be generated. */
1323 separate_class_package (tree decl
)
1325 tree type
= TREE_TYPE (decl
);
1326 return has_nontrivial_methods (type
) || has_static_fields (type
);
1329 static bool package_prefix
= true;
1331 /* Dump in BUFFER the name of an identifier NODE of type TYPE, following Ada
1332 syntax. LIMITED_ACCESS indicates whether NODE can be accessed through a
1333 limited 'with' clause rather than a regular 'with' clause. */
1336 pp_ada_tree_identifier (pretty_printer
*buffer
, tree node
, tree type
,
1337 bool limited_access
)
1339 const char *name
= IDENTIFIER_POINTER (node
);
1340 bool space_found
= false;
1341 char *s
= to_ada_name (name
, &space_found
);
1342 tree decl
= get_underlying_decl (type
);
1344 /* If the entity comes from another file, generate a package prefix. */
1347 expanded_location xloc
= expand_location (decl_sloc (decl
, false));
1349 if (xloc
.file
&& xloc
.line
)
1351 if (xloc
.file
!= current_source_file
)
1353 switch (TREE_CODE (type
))
1358 case FIXED_POINT_TYPE
:
1360 case REFERENCE_TYPE
:
1368 char *s1
= get_ada_package (xloc
.file
);
1369 append_withs (s1
, limited_access
);
1370 pp_string (buffer
, s1
);
1379 /* Generate the additional package prefix for C++ classes. */
1380 if (separate_class_package (decl
))
1382 pp_string (buffer
, "Class_");
1383 pp_string (buffer
, s
);
1391 if (!strcmp (s
, "short_int"))
1392 pp_string (buffer
, "short");
1393 else if (!strcmp (s
, "short_unsigned_int"))
1394 pp_string (buffer
, "unsigned_short");
1395 else if (!strcmp (s
, "unsigned_int"))
1396 pp_string (buffer
, "unsigned");
1397 else if (!strcmp (s
, "long_int"))
1398 pp_string (buffer
, "long");
1399 else if (!strcmp (s
, "long_unsigned_int"))
1400 pp_string (buffer
, "unsigned_long");
1401 else if (!strcmp (s
, "long_long_int"))
1402 pp_string (buffer
, "Long_Long_Integer");
1403 else if (!strcmp (s
, "long_long_unsigned_int"))
1407 append_withs ("Interfaces.C.Extensions", false);
1408 pp_string (buffer
, "Extensions.unsigned_long_long");
1411 pp_string (buffer
, "unsigned_long_long");
1414 pp_string(buffer
, s
);
1416 if (!strcmp (s
, "u_Bool") || !strcmp (s
, "bool"))
1420 append_withs ("Interfaces.C.Extensions", false);
1421 pp_string (buffer
, "Extensions.bool");
1424 pp_string (buffer
, "bool");
1427 pp_string(buffer
, s
);
1432 /* Dump in BUFFER the assembly name of T. */
1435 pp_asm_name (pretty_printer
*buffer
, tree t
)
1437 tree name
= DECL_ASSEMBLER_NAME (t
);
1438 char *ada_name
= XALLOCAVEC (char, IDENTIFIER_LENGTH (name
) + 1), *s
;
1439 const char *ident
= IDENTIFIER_POINTER (name
);
1441 for (s
= ada_name
; *ident
; ident
++)
1445 else if (*ident
!= '*')
1450 pp_string (buffer
, ada_name
);
1453 /* Dump in BUFFER the name of a DECL node if set, in Ada syntax.
1454 LIMITED_ACCESS indicates whether NODE can be accessed via a
1455 limited 'with' clause rather than a regular 'with' clause. */
1458 dump_ada_decl_name (pretty_printer
*buffer
, tree decl
, bool limited_access
)
1460 if (DECL_NAME (decl
))
1461 pp_ada_tree_identifier (buffer
, DECL_NAME (decl
), decl
, limited_access
);
1464 tree type_name
= TYPE_NAME (TREE_TYPE (decl
));
1468 pp_string (buffer
, "anon");
1469 if (TREE_CODE (decl
) == FIELD_DECL
)
1470 pp_scalar (buffer
, "%d", DECL_UID (decl
));
1472 pp_scalar (buffer
, "%d", TYPE_UID (TREE_TYPE (decl
)));
1474 else if (TREE_CODE (type_name
) == IDENTIFIER_NODE
)
1475 pp_ada_tree_identifier (buffer
, type_name
, decl
, limited_access
);
1479 /* Dump in BUFFER a name for the type T, which is a _TYPE without TYPE_NAME.
1480 PARENT is the parent node of T. */
1483 dump_anonymous_type_name (pretty_printer
*buffer
, tree t
, tree parent
)
1485 if (DECL_NAME (parent
))
1486 pp_ada_tree_identifier (buffer
, DECL_NAME (parent
), parent
, false);
1489 pp_string (buffer
, "anon");
1490 pp_scalar (buffer
, "%d", TYPE_UID (TREE_TYPE (parent
)));
1493 switch (TREE_CODE (t
))
1496 pp_string (buffer
, "_array");
1499 pp_string (buffer
, "_enum");
1502 pp_string (buffer
, "_struct");
1505 pp_string (buffer
, "_union");
1508 pp_string (buffer
, "_unknown");
1512 pp_scalar (buffer
, "%d", TYPE_UID (t
));
1515 /* Dump in BUFFER aspect Import on a given node T. SPC is the current
1516 indentation level. */
1519 dump_ada_import (pretty_printer
*buffer
, tree t
, int spc
)
1521 const char *name
= IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (t
));
1522 const bool is_stdcall
1523 = TREE_CODE (t
) == FUNCTION_DECL
1524 && lookup_attribute ("stdcall", TYPE_ATTRIBUTES (TREE_TYPE (t
)));
1526 pp_string (buffer
, "with Import => True, ");
1528 newline_and_indent (buffer
, spc
+ 5);
1531 pp_string (buffer
, "Convention => Stdcall, ");
1532 else if (name
[0] == '_' && name
[1] == 'Z')
1533 pp_string (buffer
, "Convention => CPP, ");
1535 pp_string (buffer
, "Convention => C, ");
1537 newline_and_indent (buffer
, spc
+ 5);
1539 pp_string (buffer
, "External_Name => \"");
1542 pp_string (buffer
, IDENTIFIER_POINTER (DECL_NAME (t
)));
1544 pp_asm_name (buffer
, t
);
1546 pp_string (buffer
, "\";");
1549 /* Check whether T and its type have different names, and append "the_"
1550 otherwise in BUFFER. */
1553 check_name (pretty_printer
*buffer
, tree t
)
1556 tree tmp
= TREE_TYPE (t
);
1558 while (TREE_CODE (tmp
) == POINTER_TYPE
&& !TYPE_NAME (tmp
))
1559 tmp
= TREE_TYPE (tmp
);
1561 if (TREE_CODE (tmp
) != FUNCTION_TYPE
)
1563 if (TREE_CODE (tmp
) == IDENTIFIER_NODE
)
1564 s
= IDENTIFIER_POINTER (tmp
);
1565 else if (!TYPE_NAME (tmp
))
1567 else if (TREE_CODE (TYPE_NAME (tmp
)) == IDENTIFIER_NODE
)
1568 s
= IDENTIFIER_POINTER (TYPE_NAME (tmp
));
1570 s
= IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp
)));
1572 if (!strcasecmp (IDENTIFIER_POINTER (DECL_NAME (t
)), s
))
1573 pp_string (buffer
, "the_");
1577 /* Dump in BUFFER a function declaration FUNC in Ada syntax.
1578 IS_METHOD indicates whether FUNC is a C++ method.
1579 IS_CONSTRUCTOR whether FUNC is a C++ constructor.
1580 IS_DESTRUCTOR whether FUNC is a C++ destructor.
1581 SPC is the current indentation level. */
1584 dump_ada_function_declaration (pretty_printer
*buffer
, tree func
,
1585 bool is_method
, bool is_constructor
,
1586 bool is_destructor
, int spc
)
1588 tree type
= TREE_TYPE (func
);
1589 tree arg
= TYPE_ARG_TYPES (type
);
1592 int num
, num_args
= 0, have_args
= true, have_ellipsis
= false;
1594 /* Compute number of arguments. */
1597 while (TREE_CHAIN (arg
) && arg
!= error_mark_node
)
1600 arg
= TREE_CHAIN (arg
);
1603 if (TREE_CODE (TREE_VALUE (arg
)) != VOID_TYPE
)
1606 have_ellipsis
= true;
1617 newline_and_indent (buffer
, spc
+ 1);
1622 pp_left_paren (buffer
);
1625 /* For a function, see if we have the corresponding arguments. */
1626 if (TREE_CODE (func
) == FUNCTION_DECL
)
1628 arg
= DECL_ARGUMENTS (func
);
1629 for (t
= arg
, num
= 0; t
; t
= DECL_CHAIN (t
))
1637 /* Otherwise, only print the types. */
1641 arg
= TYPE_ARG_TYPES (type
);
1645 arg
= TREE_CHAIN (arg
);
1647 /* Print the argument names (if available) and types. */
1648 for (num
= 1; num
<= num_args
; num
++)
1652 if (DECL_NAME (arg
))
1654 check_name (buffer
, arg
);
1655 pp_ada_tree_identifier (buffer
, DECL_NAME (arg
), NULL_TREE
,
1657 pp_string (buffer
, " : ");
1661 sprintf (buf
, "arg%d : ", num
);
1662 pp_string (buffer
, buf
);
1665 dump_ada_node (buffer
, TREE_TYPE (arg
), type
, spc
, false, true);
1669 sprintf (buf
, "arg%d : ", num
);
1670 pp_string (buffer
, buf
);
1671 dump_ada_node (buffer
, TREE_VALUE (arg
), type
, spc
, false, true);
1674 /* If the type is a pointer to a tagged type, we need to differentiate
1675 virtual methods from the rest (non-virtual methods, static member
1676 or regular functions) and import only them as primitive operations,
1677 because they make up the virtual table which is mirrored on the Ada
1678 side by the dispatch table. So we add 'Class to the type of every
1679 parameter that is not the first one of a method which either has a
1680 slot in the virtual table or is a constructor. */
1682 && POINTER_TYPE_P (TREE_TYPE (arg
))
1683 && is_tagged_type (TREE_TYPE (TREE_TYPE (arg
)))
1684 && !(num
== 1 && is_method
&& (DECL_VINDEX (func
) || is_constructor
)))
1685 pp_string (buffer
, "'Class");
1687 arg
= TREE_CHAIN (arg
);
1691 pp_semicolon (buffer
);
1694 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
1702 pp_string (buffer
, " -- , ...");
1703 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
1707 pp_right_paren (buffer
);
1709 if (is_constructor
|| !VOID_TYPE_P (TREE_TYPE (type
)))
1711 pp_string (buffer
, " return ");
1712 tree rtype
= is_constructor
? DECL_CONTEXT (func
) : TREE_TYPE (type
);
1713 dump_ada_node (buffer
, rtype
, rtype
, spc
, false, true);
1717 /* Dump in BUFFER all the domains associated with an array NODE,
1718 in Ada syntax. SPC is the current indentation level. */
1721 dump_ada_array_domains (pretty_printer
*buffer
, tree node
, int spc
)
1724 pp_left_paren (buffer
);
1726 for (; TREE_CODE (node
) == ARRAY_TYPE
; node
= TREE_TYPE (node
))
1728 tree domain
= TYPE_DOMAIN (node
);
1732 tree min
= TYPE_MIN_VALUE (domain
);
1733 tree max
= TYPE_MAX_VALUE (domain
);
1736 pp_string (buffer
, ", ");
1740 dump_ada_node (buffer
, min
, NULL_TREE
, spc
, false, true);
1741 pp_string (buffer
, " .. ");
1743 /* If the upper bound is zero, gcc may generate a NULL_TREE
1744 for TYPE_MAX_VALUE rather than an integer_cst. */
1746 dump_ada_node (buffer
, max
, NULL_TREE
, spc
, false, true);
1748 pp_string (buffer
, "0");
1751 pp_string (buffer
, "size_t");
1753 pp_right_paren (buffer
);
1756 /* Dump in BUFFER file:line information related to NODE. */
1759 dump_sloc (pretty_printer
*buffer
, tree node
)
1761 expanded_location xloc
;
1766 xloc
= expand_location (DECL_SOURCE_LOCATION (node
));
1767 else if (EXPR_HAS_LOCATION (node
))
1768 xloc
= expand_location (EXPR_LOCATION (node
));
1772 pp_string (buffer
, xloc
.file
);
1774 pp_decimal_int (buffer
, xloc
.line
);
1778 /* Return true if type T designates a 1-dimension array of "char". */
1781 is_char_array (tree t
)
1785 while (TREE_CODE (t
) == ARRAY_TYPE
)
1792 && TREE_CODE (t
) == INTEGER_TYPE
1793 && id_equal (DECL_NAME (TYPE_NAME (t
)), "char");
1796 /* Dump in BUFFER an array type NODE of type TYPE in Ada syntax. SPC is the
1797 indentation level. */
1800 dump_ada_array_type (pretty_printer
*buffer
, tree node
, tree type
, int spc
)
1802 const bool char_array
= is_char_array (node
);
1804 /* Special case char arrays. */
1806 pp_string (buffer
, "Interfaces.C.char_array ");
1808 pp_string (buffer
, "array ");
1810 /* Print the dimensions. */
1811 dump_ada_array_domains (buffer
, node
, spc
);
1813 /* Print the component type. */
1817 while (TREE_CODE (tmp
) == ARRAY_TYPE
)
1818 tmp
= TREE_TYPE (tmp
);
1820 pp_string (buffer
, " of ");
1822 if (TREE_CODE (tmp
) != POINTER_TYPE
)
1823 pp_string (buffer
, "aliased ");
1826 || (!RECORD_OR_UNION_TYPE_P (tmp
)
1827 && TREE_CODE (tmp
) != ENUMERAL_TYPE
))
1828 dump_ada_node (buffer
, tmp
, node
, spc
, false, true);
1830 dump_anonymous_type_name (buffer
, tmp
, type
);
1834 /* Dump in BUFFER type names associated with a template, each prepended with
1835 '_'. TYPES is the TREE_PURPOSE of a DECL_TEMPLATE_INSTANTIATIONS. SPC is
1836 the indentation level. */
1839 dump_template_types (pretty_printer
*buffer
, tree types
, int spc
)
1841 for (int i
= 0; i
< TREE_VEC_LENGTH (types
); i
++)
1843 tree elem
= TREE_VEC_ELT (types
, i
);
1844 pp_underscore (buffer
);
1846 if (!dump_ada_node (buffer
, elem
, NULL_TREE
, spc
, false, true))
1848 pp_string (buffer
, "unknown");
1849 pp_scalar (buffer
, "%lu", (unsigned long) TREE_HASH (elem
));
1854 /* Dump in BUFFER the contents of all class instantiations associated with
1855 a given template T. SPC is the indentation level. */
1858 dump_ada_template (pretty_printer
*buffer
, tree t
, int spc
)
1860 /* DECL_SIZE_UNIT is DECL_TEMPLATE_INSTANTIATIONS in this context. */
1861 tree inst
= DECL_SIZE_UNIT (t
);
1862 /* This emulates DECL_TEMPLATE_RESULT in this context. */
1863 struct tree_template_decl
{
1864 struct tree_decl_common common
;
1868 tree result
= ((struct tree_template_decl
*) t
)->result
;
1871 /* Don't look at template declarations declaring something coming from
1872 another file. This can occur for template friend declarations. */
1873 if (LOCATION_FILE (decl_sloc (result
, false))
1874 != LOCATION_FILE (decl_sloc (t
, false)))
1877 for (; inst
&& inst
!= error_mark_node
; inst
= TREE_CHAIN (inst
))
1879 tree types
= TREE_PURPOSE (inst
);
1880 tree instance
= TREE_VALUE (inst
);
1882 if (TREE_VEC_LENGTH (types
) == 0)
1885 if (!RECORD_OR_UNION_TYPE_P (instance
))
1888 /* We are interested in concrete template instantiations only: skip
1889 partially specialized nodes. */
1890 if (RECORD_OR_UNION_TYPE_P (instance
)
1892 && cpp_check (instance
, HAS_DEPENDENT_TEMPLATE_ARGS
))
1897 pp_string (buffer
, "package ");
1898 package_prefix
= false;
1899 dump_ada_node (buffer
, instance
, t
, spc
, false, true);
1900 dump_template_types (buffer
, types
, spc
);
1901 pp_string (buffer
, " is");
1903 newline_and_indent (buffer
, spc
);
1905 TREE_VISITED (get_underlying_decl (instance
)) = 1;
1906 pp_string (buffer
, "type ");
1907 dump_ada_node (buffer
, instance
, t
, spc
, false, true);
1908 package_prefix
= true;
1910 if (is_tagged_type (instance
))
1911 pp_string (buffer
, " is tagged limited ");
1913 pp_string (buffer
, " is limited ");
1915 dump_ada_node (buffer
, instance
, t
, spc
, false, false);
1916 pp_newline (buffer
);
1918 newline_and_indent (buffer
, spc
);
1920 pp_string (buffer
, "end;");
1921 newline_and_indent (buffer
, spc
);
1922 pp_string (buffer
, "use ");
1923 package_prefix
= false;
1924 dump_ada_node (buffer
, instance
, t
, spc
, false, true);
1925 dump_template_types (buffer
, types
, spc
);
1926 package_prefix
= true;
1927 pp_semicolon (buffer
);
1928 pp_newline (buffer
);
1929 pp_newline (buffer
);
1932 return num_inst
> 0;
1935 /* Return true if NODE is a simple enum types, that can be mapped to an
1936 Ada enum type directly. */
1939 is_simple_enum (tree node
)
1941 HOST_WIDE_INT count
= 0;
1943 for (tree value
= TYPE_VALUES (node
); value
; value
= TREE_CHAIN (value
))
1945 tree int_val
= TREE_VALUE (value
);
1947 if (TREE_CODE (int_val
) != INTEGER_CST
)
1948 int_val
= DECL_INITIAL (int_val
);
1950 if (!tree_fits_shwi_p (int_val
))
1952 else if (tree_to_shwi (int_val
) != count
)
1961 /* Dump in BUFFER an enumeral type NODE in Ada syntax. SPC is the indentation
1965 dump_ada_enum_type (pretty_printer
*buffer
, tree node
, int spc
)
1967 if (is_simple_enum (node
))
1971 newline_and_indent (buffer
, spc
- 1);
1972 pp_left_paren (buffer
);
1973 for (tree value
= TYPE_VALUES (node
); value
; value
= TREE_CHAIN (value
))
1980 newline_and_indent (buffer
, spc
);
1983 pp_ada_tree_identifier (buffer
, TREE_PURPOSE (value
), node
, false);
1985 pp_string (buffer
, ")");
1987 newline_and_indent (buffer
, spc
);
1988 pp_string (buffer
, "with Convention => C");
1992 if (TYPE_UNSIGNED (node
))
1993 pp_string (buffer
, "unsigned");
1995 pp_string (buffer
, "int");
1996 for (tree value
= TYPE_VALUES (node
); value
; value
= TREE_CHAIN (value
))
1998 pp_semicolon (buffer
);
1999 newline_and_indent (buffer
, spc
);
2001 pp_ada_tree_identifier (buffer
, TREE_PURPOSE (value
), node
, false);
2002 pp_string (buffer
, " : constant ");
2004 if (TYPE_UNSIGNED (node
))
2005 pp_string (buffer
, "unsigned");
2007 pp_string (buffer
, "int");
2009 pp_string (buffer
, " := ");
2010 dump_ada_node (buffer
,
2011 TREE_CODE (TREE_VALUE (value
)) == INTEGER_CST
2012 ? TREE_VALUE (value
)
2013 : DECL_INITIAL (TREE_VALUE (value
)),
2014 node
, spc
, false, true);
2019 /* Return true if NODE is the __float128/_Float128 type. */
2022 is_float128 (tree node
)
2024 if (!TYPE_NAME (node
) || TREE_CODE (TYPE_NAME (node
)) != TYPE_DECL
)
2027 tree name
= DECL_NAME (TYPE_NAME (node
));
2029 if (IDENTIFIER_POINTER (name
) [0] != '_')
2032 return id_equal (name
, "__float128") || id_equal (name
, "_Float128");
2035 static bool bitfield_used
= false;
2037 /* Recursively dump in BUFFER Ada declarations corresponding to NODE of type
2038 TYPE. SPC is the indentation level. LIMITED_ACCESS indicates whether NODE
2039 can be referenced via a "limited with" clause. NAME_ONLY indicates whether
2040 we should only dump the name of NODE, instead of its full declaration. */
2043 dump_ada_node (pretty_printer
*buffer
, tree node
, tree type
, int spc
,
2044 bool limited_access
, bool name_only
)
2046 if (node
== NULL_TREE
)
2049 switch (TREE_CODE (node
))
2052 pp_string (buffer
, "<<< error >>>");
2055 case IDENTIFIER_NODE
:
2056 pp_ada_tree_identifier (buffer
, node
, type
, limited_access
);
2060 pp_string (buffer
, "--- unexpected node: TREE_LIST");
2064 dump_ada_node (buffer
, BINFO_TYPE (node
), type
, spc
, limited_access
,
2069 pp_string (buffer
, "--- unexpected node: TREE_VEC");
2076 append_withs ("System", false);
2077 pp_string (buffer
, "System.Address");
2080 pp_string (buffer
, "address");
2084 pp_string (buffer
, "<vector>");
2088 if (is_float128 (TREE_TYPE (node
)))
2090 append_withs ("Interfaces.C.Extensions", false);
2091 pp_string (buffer
, "Extensions.CFloat_128");
2094 pp_string (buffer
, "<complex>");
2099 dump_ada_node (buffer
, TYPE_NAME (node
), node
, spc
, false, true);
2101 dump_ada_enum_type (buffer
, node
, spc
);
2105 if (is_float128 (node
))
2107 append_withs ("Interfaces.C.Extensions", false);
2108 pp_string (buffer
, "Extensions.Float_128");
2114 case FIXED_POINT_TYPE
:
2116 if (TYPE_NAME (node
)
2117 && !(TREE_CODE (TYPE_NAME (node
)) == TYPE_DECL
2118 && !strcmp (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (node
))),
2121 if (TREE_CODE (TYPE_NAME (node
)) == IDENTIFIER_NODE
)
2122 pp_ada_tree_identifier (buffer
, TYPE_NAME (node
), node
,
2124 else if (TREE_CODE (TYPE_NAME (node
)) == TYPE_DECL
2125 && DECL_NAME (TYPE_NAME (node
)))
2126 dump_ada_decl_name (buffer
, TYPE_NAME (node
), limited_access
);
2128 pp_string (buffer
, "<unnamed type>");
2130 else if (TREE_CODE (node
) == INTEGER_TYPE
)
2132 append_withs ("Interfaces.C.Extensions", false);
2133 bitfield_used
= true;
2135 if (TYPE_PRECISION (node
) == 1)
2136 pp_string (buffer
, "Extensions.Unsigned_1");
2139 pp_string (buffer
, TYPE_UNSIGNED (node
)
2140 ? "Extensions.Unsigned_"
2141 : "Extensions.Signed_");
2142 pp_decimal_int (buffer
, TYPE_PRECISION (node
));
2146 pp_string (buffer
, "<unnamed type>");
2150 case REFERENCE_TYPE
:
2151 if (name_only
&& TYPE_NAME (node
))
2152 dump_ada_node (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
,
2155 else if (TREE_CODE (TREE_TYPE (node
)) == FUNCTION_TYPE
)
2157 if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (node
))))
2158 pp_string (buffer
, "access procedure");
2160 pp_string (buffer
, "access function");
2162 dump_ada_function_declaration (buffer
, node
, false, false, false,
2165 /* If we are dumping the full type, it means we are part of a
2166 type definition and need also a Convention C aspect. */
2169 newline_and_indent (buffer
, spc
);
2170 pp_string (buffer
, "with Convention => C");
2175 const unsigned int quals
= TYPE_QUALS (TREE_TYPE (node
));
2176 bool is_access
= false;
2178 if (VOID_TYPE_P (TREE_TYPE (node
)))
2181 pp_string (buffer
, "new ");
2184 append_withs ("System", false);
2185 pp_string (buffer
, "System.Address");
2188 pp_string (buffer
, "address");
2192 if (TREE_CODE (node
) == POINTER_TYPE
2193 && TREE_CODE (TREE_TYPE (node
)) == INTEGER_TYPE
2194 && id_equal (DECL_NAME (TYPE_NAME (TREE_TYPE (node
))),
2198 pp_string (buffer
, "new ");
2202 pp_string (buffer
, "Interfaces.C.Strings.chars_ptr");
2203 append_withs ("Interfaces.C.Strings", false);
2206 pp_string (buffer
, "chars_ptr");
2210 tree type_name
= TYPE_NAME (TREE_TYPE (node
));
2212 /* For now, handle access-to-access as System.Address. */
2213 if (TREE_CODE (TREE_TYPE (node
)) == POINTER_TYPE
)
2217 append_withs ("System", false);
2219 pp_string (buffer
, "new ");
2220 pp_string (buffer
, "System.Address");
2223 pp_string (buffer
, "address");
2227 if (!package_prefix
)
2228 pp_string (buffer
, "access");
2229 else if (AGGREGATE_TYPE_P (TREE_TYPE (node
)))
2231 if (!type
|| TREE_CODE (type
) != FUNCTION_DECL
)
2233 pp_string (buffer
, "access ");
2236 if (quals
& TYPE_QUAL_CONST
)
2237 pp_string (buffer
, "constant ");
2238 else if (!name_only
)
2239 pp_string (buffer
, "all ");
2241 else if (quals
& TYPE_QUAL_CONST
)
2242 pp_string (buffer
, "in ");
2246 pp_string (buffer
, "access ");
2247 /* ??? should be configurable: access or in out. */
2253 pp_string (buffer
, "access ");
2256 pp_string (buffer
, "all ");
2259 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node
)) && type_name
)
2260 dump_ada_node (buffer
, type_name
, TREE_TYPE (node
), spc
,
2263 dump_ada_node (buffer
, TREE_TYPE (node
), TREE_TYPE (node
),
2272 dump_ada_node (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
,
2275 dump_ada_array_type (buffer
, node
, type
, spc
);
2281 dump_ada_node (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
,
2284 dump_ada_structure (buffer
, node
, type
, false, spc
);
2288 /* We treat the upper half of the sizetype range as negative. This
2289 is consistent with the internal treatment and makes it possible
2290 to generate the (0 .. -1) range for flexible array members. */
2291 if (TREE_TYPE (node
) == sizetype
)
2292 node
= fold_convert (ssizetype
, node
);
2293 if (tree_fits_shwi_p (node
))
2294 pp_wide_integer (buffer
, tree_to_shwi (node
));
2295 else if (tree_fits_uhwi_p (node
))
2296 pp_unsigned_wide_integer (buffer
, tree_to_uhwi (node
));
2299 wide_int val
= wi::to_wide (node
);
2301 if (wi::neg_p (val
))
2306 sprintf (pp_buffer (buffer
)->digit_buffer
,
2307 "16#%" HOST_WIDE_INT_PRINT
"x",
2308 val
.elt (val
.get_len () - 1));
2309 for (i
= val
.get_len () - 2; i
>= 0; i
--)
2310 sprintf (pp_buffer (buffer
)->digit_buffer
,
2311 HOST_WIDE_INT_PRINT_PADDED_HEX
, val
.elt (i
));
2312 pp_string (buffer
, pp_buffer (buffer
)->digit_buffer
);
2324 if (DECL_IS_BUILTIN (node
))
2326 /* Don't print the declaration of built-in types. */
2329 /* If we're in the middle of a declaration, defaults to
2333 append_withs ("System", false);
2334 pp_string (buffer
, "System.Address");
2337 pp_string (buffer
, "address");
2343 dump_ada_decl_name (buffer
, node
, limited_access
);
2346 if (is_tagged_type (TREE_TYPE (node
)))
2350 /* Look for ancestors. */
2351 for (tree fld
= TYPE_FIELDS (TREE_TYPE (node
));
2353 fld
= TREE_CHAIN (fld
))
2355 if (!DECL_NAME (fld
) && is_tagged_type (TREE_TYPE (fld
)))
2359 pp_string (buffer
, "limited new ");
2363 pp_string (buffer
, " and ");
2365 dump_ada_decl_name (buffer
, TYPE_NAME (TREE_TYPE (fld
)),
2370 pp_string (buffer
, first
? "tagged limited " : " with ");
2372 else if (has_nontrivial_methods (TREE_TYPE (node
)))
2373 pp_string (buffer
, "limited ");
2375 dump_ada_node (buffer
, TREE_TYPE (node
), type
, spc
, false, false);
2384 case NAMESPACE_DECL
:
2385 dump_ada_decl_name (buffer
, node
, false);
2389 /* Ignore other nodes (e.g. expressions). */
2396 /* Dump in BUFFER NODE's methods. SPC is the indentation level. Return 1 if
2397 methods were printed, 0 otherwise. */
2400 dump_ada_methods (pretty_printer
*buffer
, tree node
, int spc
)
2402 if (!has_nontrivial_methods (node
))
2405 pp_semicolon (buffer
);
2408 for (tree fld
= TYPE_FIELDS (node
); fld
; fld
= DECL_CHAIN (fld
))
2409 if (TREE_CODE (fld
) == FUNCTION_DECL
)
2413 pp_newline (buffer
);
2414 pp_newline (buffer
);
2417 res
= dump_ada_declaration (buffer
, fld
, node
, spc
);
2423 /* Dump in BUFFER a forward declaration for TYPE present inside T.
2424 SPC is the indentation level. */
2427 dump_forward_type (pretty_printer
*buffer
, tree type
, tree t
, int spc
)
2429 tree decl
= get_underlying_decl (type
);
2431 /* Anonymous pointer and function types. */
2434 if (TREE_CODE (type
) == POINTER_TYPE
)
2435 dump_forward_type (buffer
, TREE_TYPE (type
), t
, spc
);
2436 else if (TREE_CODE (type
) == FUNCTION_TYPE
)
2438 function_args_iterator args_iter
;
2440 dump_forward_type (buffer
, TREE_TYPE (type
), t
, spc
);
2441 FOREACH_FUNCTION_ARGS (type
, arg
, args_iter
)
2442 dump_forward_type (buffer
, arg
, t
, spc
);
2447 if (DECL_IS_BUILTIN (decl
) || TREE_VISITED (decl
))
2450 /* Forward declarations are only needed within a given file. */
2451 if (DECL_SOURCE_FILE (decl
) != DECL_SOURCE_FILE (t
))
2454 if (TREE_CODE (type
) == FUNCTION_TYPE
)
2457 /* Generate an incomplete type declaration. */
2458 pp_string (buffer
, "type ");
2459 dump_ada_node (buffer
, decl
, NULL_TREE
, spc
, false, true);
2460 pp_semicolon (buffer
);
2461 newline_and_indent (buffer
, spc
);
2463 /* Only one incomplete declaration is legal for a given type. */
2464 TREE_VISITED (decl
) = 1;
2467 static void dump_nested_type (pretty_printer
*, tree
, tree
, tree
, bitmap
, int);
2469 /* Dump in BUFFER anonymous types nested inside T's definition. PARENT is the
2470 parent node of T. DUMPED_TYPES is the bitmap of already dumped types. SPC
2471 is the indentation level.
2473 In C anonymous nested tagged types have no name whereas in C++ they have
2474 one. In C their TYPE_DECL is at top level whereas in C++ it is nested.
2475 In both languages untagged types (pointers and arrays) have no name.
2476 In C++ the nested TYPE_DECLs can come after their associated FIELD_DECL.
2478 Therefore, in order to have a common processing for both languages, we
2479 disregard anonymous TYPE_DECLs at top level and here we make a first
2480 pass on the nested TYPE_DECLs and a second pass on the unnamed types. */
2483 dump_nested_types_1 (pretty_printer
*buffer
, tree t
, tree parent
,
2484 bitmap dumped_types
, int spc
)
2488 /* Find possible anonymous pointers/arrays/structs/unions recursively. */
2489 type
= TREE_TYPE (t
);
2493 for (field
= TYPE_FIELDS (type
); field
; field
= TREE_CHAIN (field
))
2494 if (TREE_CODE (field
) == TYPE_DECL
2495 && DECL_NAME (field
) != DECL_NAME (t
)
2496 && !DECL_ORIGINAL_TYPE (field
)
2497 && TYPE_NAME (TREE_TYPE (field
)) != TYPE_NAME (type
))
2498 dump_nested_type (buffer
, field
, t
, parent
, dumped_types
, spc
);
2500 for (field
= TYPE_FIELDS (type
); field
; field
= TREE_CHAIN (field
))
2501 if (TREE_CODE (field
) == FIELD_DECL
&& !TYPE_NAME (TREE_TYPE (field
)))
2502 dump_nested_type (buffer
, field
, t
, parent
, dumped_types
, spc
);
2505 /* Likewise, but to be invoked only at top level. We dump each anonymous type
2506 nested inside T's definition exactly once, even if it is referenced several
2507 times in it (typically an array type), with a name prefixed by that of T. */
2510 dump_nested_types (pretty_printer
*buffer
, tree t
, int spc
)
2512 auto_bitmap dumped_types
;
2513 dump_nested_types_1 (buffer
, t
, t
, dumped_types
, spc
);
2516 /* Dump in BUFFER the anonymous type of FIELD inside T. PARENT is the parent
2517 node of T. DUMPED_TYPES is the bitmap of already dumped types. SPC is the
2518 indentation level. */
2521 dump_nested_type (pretty_printer
*buffer
, tree field
, tree t
, tree parent
,
2522 bitmap dumped_types
, int spc
)
2524 tree field_type
= TREE_TYPE (field
);
2527 switch (TREE_CODE (field_type
))
2530 tmp
= TREE_TYPE (field_type
);
2531 dump_forward_type (buffer
, tmp
, t
, spc
);
2535 /* Anonymous array types are shared. */
2536 if (!bitmap_set_bit (dumped_types
, TYPE_UID (field_type
)))
2539 /* Recurse on the element type if need be. */
2540 tmp
= TREE_TYPE (field_type
);
2541 while (TREE_CODE (tmp
) == ARRAY_TYPE
)
2542 tmp
= TREE_TYPE (tmp
);
2543 decl
= get_underlying_decl (tmp
);
2545 && !DECL_NAME (decl
)
2546 && DECL_SOURCE_FILE (decl
) == DECL_SOURCE_FILE (t
)
2547 && !TREE_VISITED (decl
))
2549 /* Generate full declaration. */
2550 dump_nested_type (buffer
, decl
, t
, parent
, dumped_types
, spc
);
2551 TREE_VISITED (decl
) = 1;
2553 else if (!decl
&& TREE_CODE (tmp
) == POINTER_TYPE
)
2554 dump_forward_type (buffer
, TREE_TYPE (tmp
), t
, spc
);
2556 /* Special case char arrays. */
2557 if (is_char_array (field_type
))
2558 pp_string (buffer
, "subtype ");
2560 pp_string (buffer
, "type ");
2562 dump_anonymous_type_name (buffer
, field_type
, parent
);
2563 pp_string (buffer
, " is ");
2564 dump_ada_array_type (buffer
, field_type
, parent
, spc
);
2565 pp_semicolon (buffer
);
2566 newline_and_indent (buffer
, spc
);
2570 if (is_simple_enum (field_type
))
2571 pp_string (buffer
, "type ");
2573 pp_string (buffer
, "subtype ");
2575 if (TYPE_NAME (field_type
))
2576 dump_ada_node (buffer
, field_type
, NULL_TREE
, spc
, false, true);
2578 dump_anonymous_type_name (buffer
, field_type
, parent
);
2579 pp_string (buffer
, " is ");
2580 dump_ada_enum_type (buffer
, field_type
, spc
);
2581 pp_semicolon (buffer
);
2582 newline_and_indent (buffer
, spc
);
2587 dump_nested_types_1 (buffer
, field
, parent
, dumped_types
, spc
);
2589 pp_string (buffer
, "type ");
2591 if (TYPE_NAME (field_type
))
2592 dump_ada_node (buffer
, field_type
, NULL_TREE
, spc
, false, true);
2594 dump_anonymous_type_name (buffer
, field_type
, parent
);
2596 if (TREE_CODE (field_type
) == UNION_TYPE
)
2597 pp_string (buffer
, " (discr : unsigned := 0)");
2599 pp_string (buffer
, " is ");
2600 dump_ada_structure (buffer
, field_type
, t
, true, spc
);
2602 pp_string (buffer
, "with Convention => C_Pass_By_Copy");
2604 if (TREE_CODE (field_type
) == UNION_TYPE
)
2607 newline_and_indent (buffer
, spc
+ 5);
2608 pp_string (buffer
, "Unchecked_Union => True");
2611 pp_semicolon (buffer
);
2612 newline_and_indent (buffer
, spc
);
2620 /* Hash table of overloaded names that we cannot support. It is needed even
2621 in Ada 2012 because we merge different types, e.g. void * and const void *
2622 in System.Address, so we cannot have overloading for them in Ada. */
2624 struct overloaded_name_hash
{
2630 struct overloaded_name_hasher
: delete_ptr_hash
<overloaded_name_hash
>
2632 static inline hashval_t
hash (overloaded_name_hash
*t
)
2634 static inline bool equal (overloaded_name_hash
*a
, overloaded_name_hash
*b
)
2635 { return a
->name
== b
->name
; }
2638 static hash_table
<overloaded_name_hasher
> *overloaded_names
;
2640 /* Initialize the table with the problematic overloaded names. */
2642 static hash_table
<overloaded_name_hasher
> *
2643 init_overloaded_names (void)
2645 static const char *names
[] =
2646 /* The overloaded names from the /usr/include/string.h file. */
2647 { "memchr", "rawmemchr", "memrchr", "strchr", "strrchr", "strchrnul",
2648 "strpbrk", "strstr", "strcasestr", "index", "rindex", "basename" };
2650 hash_table
<overloaded_name_hasher
> *table
2651 = new hash_table
<overloaded_name_hasher
> (64);
2653 for (unsigned int i
= 0; i
< ARRAY_SIZE (names
); i
++)
2655 struct overloaded_name_hash in
, *h
, **slot
;
2656 tree id
= get_identifier (names
[i
]);
2657 hashval_t hash
= htab_hash_pointer (id
);
2660 slot
= table
->find_slot_with_hash (&in
, hash
, INSERT
);
2661 h
= new overloaded_name_hash
;
2671 /* Return whether NAME cannot be supported as overloaded name. */
2674 overloaded_name_p (tree name
)
2676 if (!overloaded_names
)
2677 overloaded_names
= init_overloaded_names ();
2679 struct overloaded_name_hash in
, *h
;
2680 hashval_t hash
= htab_hash_pointer (name
);
2683 h
= overloaded_names
->find_with_hash (&in
, hash
);
2684 return h
&& ++h
->n
> 1;
2687 /* Dump in BUFFER constructor spec corresponding to T for TYPE. */
2690 print_constructor (pretty_printer
*buffer
, tree t
, tree type
)
2692 tree decl_name
= DECL_NAME (TYPE_NAME (type
));
2694 pp_string (buffer
, "New_");
2695 pp_ada_tree_identifier (buffer
, decl_name
, t
, false);
2698 /* Dump in BUFFER destructor spec corresponding to T. */
2701 print_destructor (pretty_printer
*buffer
, tree t
, tree type
)
2703 tree decl_name
= DECL_NAME (TYPE_NAME (type
));
2705 pp_string (buffer
, "Delete_");
2706 if (strncmp (IDENTIFIER_POINTER (DECL_NAME (t
)), "__dt_del", 8) == 0)
2707 pp_string (buffer
, "And_Free_");
2708 pp_ada_tree_identifier (buffer
, decl_name
, t
, false);
2711 /* Dump in BUFFER assignment operator spec corresponding to T. */
2714 print_assignment_operator (pretty_printer
*buffer
, tree t
, tree type
)
2716 tree decl_name
= DECL_NAME (TYPE_NAME (type
));
2718 pp_string (buffer
, "Assign_");
2719 pp_ada_tree_identifier (buffer
, decl_name
, t
, false);
2722 /* Return the name of type T. */
2727 tree n
= TYPE_NAME (t
);
2729 if (TREE_CODE (n
) == IDENTIFIER_NODE
)
2730 return IDENTIFIER_POINTER (n
);
2732 return IDENTIFIER_POINTER (DECL_NAME (n
));
2735 /* Dump in BUFFER the declaration of object T of type TYPE in Ada syntax.
2736 SPC is the indentation level. Return 1 if a declaration was printed,
2740 dump_ada_declaration (pretty_printer
*buffer
, tree t
, tree type
, int spc
)
2742 bool is_var
= false;
2743 bool need_indent
= false;
2744 bool is_class
= false;
2745 tree name
= TYPE_NAME (TREE_TYPE (t
));
2746 tree decl_name
= DECL_NAME (t
);
2747 tree orig
= NULL_TREE
;
2749 if (cpp_check
&& cpp_check (t
, IS_TEMPLATE
))
2750 return dump_ada_template (buffer
, t
, spc
);
2752 /* Skip enumeral values: will be handled as part of the type itself. */
2753 if (TREE_CODE (t
) == CONST_DECL
&& TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
)
2756 if (TREE_CODE (t
) == TYPE_DECL
)
2758 orig
= DECL_ORIGINAL_TYPE (t
);
2760 /* This is a typedef. */
2761 if (orig
&& TYPE_STUB_DECL (orig
))
2763 tree stub
= TYPE_STUB_DECL (orig
);
2765 /* If this is a typedef of a named type, then output it as a subtype
2766 declaration. ??? Use a derived type declaration instead. */
2767 if (TYPE_NAME (orig
))
2769 /* If the types have the same name (ignoring casing), then ignore
2770 the second type, but forward declare the first if need be. */
2771 if (type_name (orig
) == type_name (TREE_TYPE (t
))
2772 || !strcasecmp (type_name (orig
), type_name (TREE_TYPE (t
))))
2774 if (RECORD_OR_UNION_TYPE_P (orig
) && !TREE_VISITED (stub
))
2777 dump_forward_type (buffer
, orig
, t
, 0);
2780 TREE_VISITED (t
) = 1;
2786 if (RECORD_OR_UNION_TYPE_P (orig
) && !TREE_VISITED (stub
))
2787 dump_forward_type (buffer
, orig
, t
, spc
);
2789 pp_string (buffer
, "subtype ");
2790 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2791 pp_string (buffer
, " is ");
2792 dump_ada_node (buffer
, orig
, type
, spc
, false, true);
2793 pp_string (buffer
, "; -- ");
2794 dump_sloc (buffer
, t
);
2796 TREE_VISITED (t
) = 1;
2800 /* This is a typedef of an anonymous type. We'll output the full
2801 type declaration of the anonymous type with the typedef'ed name
2802 below. Prevent forward declarations for the anonymous type to
2803 be emitted from now on. */
2804 TREE_VISITED (stub
) = 1;
2807 /* Skip unnamed or anonymous structs/unions/enum types. */
2808 if (!orig
&& !decl_name
&& !name
2809 && (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
))
2810 || TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
))
2813 /* Skip anonymous enum types (duplicates of real types). */
2815 && TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
2817 && (*IDENTIFIER_POINTER (decl_name
) == '.'
2818 || *IDENTIFIER_POINTER (decl_name
) == '$'))
2823 switch (TREE_CODE (TREE_TYPE (t
)))
2827 if (!COMPLETE_TYPE_P (TREE_TYPE (t
)))
2829 pp_string (buffer
, "type ");
2830 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2831 pp_string (buffer
, " is null record; -- incomplete struct");
2832 TREE_VISITED (t
) = 1;
2837 && (*IDENTIFIER_POINTER (decl_name
) == '.'
2838 || *IDENTIFIER_POINTER (decl_name
) == '$'))
2840 pp_string (buffer
, "-- skipped anonymous struct ");
2841 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2842 TREE_VISITED (t
) = 1;
2846 /* ??? Packed record layout is not supported. */
2847 if (TYPE_PACKED (TREE_TYPE (t
)))
2849 warning_at (DECL_SOURCE_LOCATION (t
), 0,
2850 "unsupported record layout");
2851 pp_string (buffer
, "pragma Compile_Time_Warning (True, ");
2852 pp_string (buffer
, "\"probably incorrect record layout\");");
2853 newline_and_indent (buffer
, spc
);
2856 if (orig
&& TYPE_NAME (orig
))
2857 pp_string (buffer
, "subtype ");
2860 dump_nested_types (buffer
, t
, spc
);
2862 if (separate_class_package (t
))
2865 pp_string (buffer
, "package Class_");
2866 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2867 pp_string (buffer
, " is");
2869 newline_and_indent (buffer
, spc
);
2872 pp_string (buffer
, "type ");
2877 case REFERENCE_TYPE
:
2878 dump_forward_type (buffer
, TREE_TYPE (TREE_TYPE (t
)), t
, spc
);
2882 if ((orig
&& TYPE_NAME (orig
)) || is_char_array (TREE_TYPE (t
)))
2883 pp_string (buffer
, "subtype ");
2885 pp_string (buffer
, "type ");
2889 pp_string (buffer
, "-- skipped function type ");
2890 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2894 if ((orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
2895 || !is_simple_enum (TREE_TYPE (t
)))
2896 pp_string (buffer
, "subtype ");
2898 pp_string (buffer
, "type ");
2902 pp_string (buffer
, "subtype ");
2905 TREE_VISITED (t
) = 1;
2911 && *IDENTIFIER_POINTER (decl_name
) == '_')
2917 /* Print the type and name. */
2918 if (TREE_CODE (TREE_TYPE (t
)) == ARRAY_TYPE
)
2923 /* Print variable's name. */
2924 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2926 if (TREE_CODE (t
) == TYPE_DECL
)
2928 pp_string (buffer
, " is ");
2930 if (orig
&& TYPE_NAME (orig
))
2931 dump_ada_node (buffer
, TYPE_NAME (orig
), type
, spc
, false, true);
2933 dump_ada_array_type (buffer
, TREE_TYPE (t
), type
, spc
);
2937 if (spc
== INDENT_INCR
|| TREE_STATIC (t
))
2940 pp_string (buffer
, " : ");
2942 if (TREE_CODE (TREE_TYPE (TREE_TYPE (t
))) != POINTER_TYPE
)
2943 pp_string (buffer
, "aliased ");
2945 if (TYPE_NAME (TREE_TYPE (t
)))
2946 dump_ada_node (buffer
, TREE_TYPE (t
), type
, spc
, false, true);
2948 dump_anonymous_type_name (buffer
, TREE_TYPE (t
), type
);
2950 dump_ada_array_type (buffer
, TREE_TYPE (t
), type
, spc
);
2953 else if (TREE_CODE (t
) == FUNCTION_DECL
)
2955 bool is_abstract_class
= false;
2956 bool is_method
= TREE_CODE (TREE_TYPE (t
)) == METHOD_TYPE
;
2957 tree decl_name
= DECL_NAME (t
);
2958 bool is_abstract
= false;
2959 bool is_assignment_operator
= false;
2960 bool is_constructor
= false;
2961 bool is_destructor
= false;
2962 bool is_copy_constructor
= false;
2963 bool is_move_constructor
= false;
2965 if (!decl_name
|| overloaded_name_p (decl_name
))
2970 is_abstract
= cpp_check (t
, IS_ABSTRACT
);
2971 is_assignment_operator
= cpp_check (t
, IS_ASSIGNMENT_OPERATOR
);
2972 is_constructor
= cpp_check (t
, IS_CONSTRUCTOR
);
2973 is_destructor
= cpp_check (t
, IS_DESTRUCTOR
);
2974 is_copy_constructor
= cpp_check (t
, IS_COPY_CONSTRUCTOR
);
2975 is_move_constructor
= cpp_check (t
, IS_MOVE_CONSTRUCTOR
);
2978 /* Skip copy constructors and C++11 move constructors: some are internal
2979 only and those that are not cannot be called easily from Ada. */
2980 if (is_copy_constructor
|| is_move_constructor
)
2983 if (is_constructor
|| is_destructor
)
2985 /* ??? Skip implicit constructors/destructors for now. */
2986 if (DECL_ARTIFICIAL (t
))
2989 /* Only consider complete constructors and deleting destructors. */
2990 if (strncmp (IDENTIFIER_POINTER (decl_name
), "__ct_comp", 9) != 0
2991 && strncmp (IDENTIFIER_POINTER (decl_name
), "__dt_comp", 9) != 0
2992 && strncmp (IDENTIFIER_POINTER (decl_name
), "__dt_del", 8) != 0)
2996 else if (is_assignment_operator
)
2998 /* ??? Skip implicit or non-method assignment operators for now. */
2999 if (DECL_ARTIFICIAL (t
) || !is_method
)
3003 /* If this function has an entry in the vtable, we cannot omit it. */
3004 else if (!DECL_VINDEX (t
) && *IDENTIFIER_POINTER (decl_name
) == '_')
3007 pp_string (buffer
, "-- skipped func ");
3008 pp_string (buffer
, IDENTIFIER_POINTER (decl_name
));
3014 dump_forward_type (buffer
, TREE_TYPE (t
), t
, spc
);
3016 if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t
))) && !is_constructor
)
3017 pp_string (buffer
, "procedure ");
3019 pp_string (buffer
, "function ");
3022 print_constructor (buffer
, t
, type
);
3023 else if (is_destructor
)
3024 print_destructor (buffer
, t
, type
);
3025 else if (is_assignment_operator
)
3026 print_assignment_operator (buffer
, t
, type
);
3028 dump_ada_decl_name (buffer
, t
, false);
3030 dump_ada_function_declaration
3031 (buffer
, t
, is_method
, is_constructor
, is_destructor
, spc
);
3033 if (is_constructor
&& RECORD_OR_UNION_TYPE_P (type
))
3034 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= DECL_CHAIN (fld
))
3035 if (TREE_CODE (fld
) == FUNCTION_DECL
&& cpp_check (fld
, IS_ABSTRACT
))
3037 is_abstract_class
= true;
3041 if (is_abstract
|| is_abstract_class
)
3042 pp_string (buffer
, " is abstract");
3044 if (is_abstract
|| !DECL_ASSEMBLER_NAME (t
))
3046 pp_semicolon (buffer
);
3047 pp_string (buffer
, " -- ");
3048 dump_sloc (buffer
, t
);
3050 else if (is_constructor
)
3052 pp_semicolon (buffer
);
3053 pp_string (buffer
, " -- ");
3054 dump_sloc (buffer
, t
);
3056 newline_and_indent (buffer
, spc
);
3057 pp_string (buffer
, "pragma CPP_Constructor (");
3058 print_constructor (buffer
, t
, type
);
3059 pp_string (buffer
, ", \"");
3060 pp_asm_name (buffer
, t
);
3061 pp_string (buffer
, "\");");
3065 pp_string (buffer
, " -- ");
3066 dump_sloc (buffer
, t
);
3068 newline_and_indent (buffer
, spc
);
3069 dump_ada_import (buffer
, t
, spc
);
3074 else if (TREE_CODE (t
) == TYPE_DECL
&& !orig
)
3076 bool is_interface
= false;
3077 bool is_abstract_record
= false;
3079 /* Anonymous structs/unions. */
3080 dump_ada_node (buffer
, TREE_TYPE (t
), t
, spc
, false, true);
3082 if (TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
)
3083 pp_string (buffer
, " (discr : unsigned := 0)");
3085 pp_string (buffer
, " is ");
3087 /* Check whether we have an Ada interface compatible class.
3088 That is only have a vtable non-static data member and no
3089 non-abstract methods. */
3091 && RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
)))
3093 bool has_fields
= false;
3095 /* Check that there are no fields other than the virtual table. */
3096 for (tree fld
= TYPE_FIELDS (TREE_TYPE (t
));
3098 fld
= TREE_CHAIN (fld
))
3100 if (TREE_CODE (fld
) == FIELD_DECL
)
3102 if (!has_fields
&& DECL_VIRTUAL_P (fld
))
3103 is_interface
= true;
3105 is_interface
= false;
3108 else if (TREE_CODE (fld
) == FUNCTION_DECL
3109 && !DECL_ARTIFICIAL (fld
))
3111 if (cpp_check (fld
, IS_ABSTRACT
))
3112 is_abstract_record
= true;
3114 is_interface
= false;
3119 TREE_VISITED (t
) = 1;
3122 pp_string (buffer
, "limited interface -- ");
3123 dump_sloc (buffer
, t
);
3124 newline_and_indent (buffer
, spc
);
3125 pp_string (buffer
, "with Import => True,");
3126 newline_and_indent (buffer
, spc
+ 5);
3127 pp_string (buffer
, "Convention => CPP");
3129 dump_ada_methods (buffer
, TREE_TYPE (t
), spc
);
3133 if (is_abstract_record
)
3134 pp_string (buffer
, "abstract ");
3135 dump_ada_node (buffer
, t
, t
, spc
, false, false);
3143 if (TREE_CODE (t
) == FIELD_DECL
&& DECL_NAME (t
))
3144 check_name (buffer
, t
);
3146 /* Print variable/type's name. */
3147 dump_ada_node (buffer
, t
, t
, spc
, false, true);
3149 if (TREE_CODE (t
) == TYPE_DECL
)
3151 const bool is_subtype
= TYPE_NAME (orig
);
3153 if (!is_subtype
&& TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
)
3154 pp_string (buffer
, " (discr : unsigned := 0)");
3156 pp_string (buffer
, " is ");
3158 dump_ada_node (buffer
, orig
, t
, spc
, false, is_subtype
);
3162 if (spc
== INDENT_INCR
|| TREE_STATIC (t
))
3165 pp_string (buffer
, " : ");
3167 if (TREE_CODE (TREE_TYPE (t
)) != POINTER_TYPE
3168 && (TYPE_NAME (TREE_TYPE (t
))
3169 || (TREE_CODE (TREE_TYPE (t
)) != INTEGER_TYPE
3170 && TREE_CODE (TREE_TYPE (t
)) != ENUMERAL_TYPE
)))
3171 pp_string (buffer
, "aliased ");
3173 if (TREE_READONLY (t
) && TREE_CODE (t
) != FIELD_DECL
)
3174 pp_string (buffer
, "constant ");
3176 if (TYPE_NAME (TREE_TYPE (t
))
3177 || (!RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
))
3178 && TREE_CODE (TREE_TYPE (t
)) != ENUMERAL_TYPE
))
3179 dump_ada_node (buffer
, TREE_TYPE (t
), t
, spc
, false, true);
3181 dump_anonymous_type_name (buffer
, TREE_TYPE (t
), type
);
3188 newline_and_indent (buffer
, spc
);
3189 pp_string (buffer
, "end;");
3190 newline_and_indent (buffer
, spc
);
3191 pp_string (buffer
, "use Class_");
3192 dump_ada_node (buffer
, t
, type
, spc
, false, true);
3193 pp_semicolon (buffer
);
3194 pp_newline (buffer
);
3196 /* All needed indentation/newline performed already, so return 0. */
3201 pp_string (buffer
, " -- ");
3202 dump_sloc (buffer
, t
);
3203 newline_and_indent (buffer
, spc
);
3204 dump_ada_import (buffer
, t
, spc
);
3209 pp_string (buffer
, "; -- ");
3210 dump_sloc (buffer
, t
);
3216 /* Dump in BUFFER a structure NODE of type TYPE in Ada syntax. If NESTED is
3217 true, it's an anonymous nested type. SPC is the indentation level. */
3220 dump_ada_structure (pretty_printer
*buffer
, tree node
, tree type
, bool nested
,
3223 const bool is_union
= (TREE_CODE (node
) == UNION_TYPE
);
3226 int field_spc
= spc
+ INDENT_INCR
;
3229 bitfield_used
= false;
3231 /* Print the contents of the structure. */
3232 pp_string (buffer
, "record");
3236 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
3237 pp_string (buffer
, "case discr is");
3238 field_spc
= spc
+ INDENT_INCR
* 3;
3241 pp_newline (buffer
);
3243 /* Print the non-static fields of the structure. */
3244 for (tree tmp
= TYPE_FIELDS (node
); tmp
; tmp
= TREE_CHAIN (tmp
))
3246 /* Add parent field if needed. */
3247 if (!DECL_NAME (tmp
))
3249 if (!is_tagged_type (TREE_TYPE (tmp
)))
3251 if (!TYPE_NAME (TREE_TYPE (tmp
)))
3252 dump_ada_declaration (buffer
, tmp
, type
, field_spc
);
3258 pp_string (buffer
, "parent : aliased ");
3261 sprintf (buf
, "field_%d : aliased ", field_num
+ 1);
3262 pp_string (buffer
, buf
);
3264 dump_ada_decl_name (buffer
, TYPE_NAME (TREE_TYPE (tmp
)),
3266 pp_semicolon (buffer
);
3269 pp_newline (buffer
);
3273 else if (TREE_CODE (tmp
) == FIELD_DECL
)
3275 /* Skip internal virtual table field. */
3276 if (!DECL_VIRTUAL_P (tmp
))
3280 if (TREE_CHAIN (tmp
)
3281 && TREE_TYPE (TREE_CHAIN (tmp
)) != node
3282 && TREE_CODE (TREE_CHAIN (tmp
)) != TYPE_DECL
)
3283 sprintf (buf
, "when %d =>", field_num
);
3285 sprintf (buf
, "when others =>");
3287 INDENT (spc
+ INDENT_INCR
* 2);
3288 pp_string (buffer
, buf
);
3289 pp_newline (buffer
);
3292 if (dump_ada_declaration (buffer
, tmp
, type
, field_spc
))
3294 pp_newline (buffer
);
3303 INDENT (spc
+ INDENT_INCR
);
3304 pp_string (buffer
, "end case;");
3305 pp_newline (buffer
);
3310 INDENT (spc
+ INDENT_INCR
);
3311 pp_string (buffer
, "null;");
3312 pp_newline (buffer
);
3316 pp_string (buffer
, "end record");
3318 newline_and_indent (buffer
, spc
);
3320 /* We disregard the methods for anonymous nested types. */
3324 if (has_nontrivial_methods (node
))
3326 pp_string (buffer
, "with Import => True,");
3327 newline_and_indent (buffer
, spc
+ 5);
3328 pp_string (buffer
, "Convention => CPP");
3331 pp_string (buffer
, "with Convention => C_Pass_By_Copy");
3336 newline_and_indent (buffer
, spc
+ 5);
3337 pp_string (buffer
, "Unchecked_Union => True");
3343 newline_and_indent (buffer
, spc
+ 5);
3344 pp_string (buffer
, "Pack => True");
3345 bitfield_used
= false;
3348 need_semicolon
= !dump_ada_methods (buffer
, node
, spc
);
3350 /* Print the static fields of the structure, if any. */
3351 for (tree tmp
= TYPE_FIELDS (node
); tmp
; tmp
= TREE_CHAIN (tmp
))
3353 if (TREE_CODE (tmp
) == VAR_DECL
&& DECL_NAME (tmp
))
3357 need_semicolon
= false;
3358 pp_semicolon (buffer
);
3360 pp_newline (buffer
);
3361 pp_newline (buffer
);
3362 dump_ada_declaration (buffer
, tmp
, type
, spc
);
3367 /* Dump all the declarations in SOURCE_FILE to an Ada spec.
3368 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3369 nodes for SOURCE_FILE. CHECK is used to perform C++ queries on nodes. */
3372 dump_ads (const char *source_file
,
3373 void (*collect_all_refs
)(const char *),
3374 int (*check
)(tree
, cpp_operation
))
3381 pkg_name
= get_ada_package (source_file
);
3383 /* Construct the .ads filename and package name. */
3384 ads_name
= xstrdup (pkg_name
);
3386 for (s
= ads_name
; *s
; s
++)
3392 ads_name
= reconcat (ads_name
, ads_name
, ".ads", NULL
);
3394 /* Write out the .ads file. */
3395 f
= fopen (ads_name
, "w");
3400 pp_needs_newline (&pp
) = true;
3401 pp
.buffer
->stream
= f
;
3403 /* Dump all relevant macros. */
3404 dump_ada_macros (&pp
, source_file
);
3406 /* Reset the table of withs for this file. */
3409 (*collect_all_refs
) (source_file
);
3411 /* Dump all references. */
3413 dump_ada_nodes (&pp
, source_file
);
3415 /* We require Ada 2012 syntax, so generate corresponding pragma. */
3416 fputs ("pragma Ada_2012;\n", f
);
3418 /* Disable style checks and warnings on unused entities since this file
3419 is auto-generated and always has a with clause for Interfaces.C. */
3420 fputs ("pragma Style_Checks (Off);\npragma Warnings (\"U\");\n\n", f
);
3425 fprintf (f
, "\npackage %s is\n\n", pkg_name
);
3426 pp_write_text_to_stream (&pp
);
3427 /* ??? need to free pp */
3428 fprintf (f
, "end %s;\n", pkg_name
);
3436 static const char **source_refs
= NULL
;
3437 static int source_refs_used
= 0;
3438 static int source_refs_allocd
= 0;
3440 /* Add an entry for FILENAME to the table SOURCE_REFS. */
3443 collect_source_ref (const char *filename
)
3450 if (source_refs_allocd
== 0)
3452 source_refs_allocd
= 1024;
3453 source_refs
= XNEWVEC (const char *, source_refs_allocd
);
3456 for (i
= 0; i
< source_refs_used
; i
++)
3457 if (filename
== source_refs
[i
])
3460 if (source_refs_used
== source_refs_allocd
)
3462 source_refs_allocd
*= 2;
3463 source_refs
= XRESIZEVEC (const char *, source_refs
, source_refs_allocd
);
3466 source_refs
[source_refs_used
++] = filename
;
3469 /* Main entry point: dump all Ada specs corresponding to SOURCE_REFS
3470 using callbacks COLLECT_ALL_REFS and CHECK.
3471 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3472 nodes for a given source file.
3473 CHECK is used to perform C++ queries on nodes, or NULL for the C
3477 dump_ada_specs (void (*collect_all_refs
)(const char *),
3478 int (*check
)(tree
, cpp_operation
))
3480 bitmap_obstack_initialize (NULL
);
3482 /* Iterate over the list of files to dump specs for. */
3483 for (int i
= 0; i
< source_refs_used
; i
++)
3484 dump_ads (source_refs
[i
], collect_all_refs
, check
);
3486 /* Free various tables. */
3488 delete overloaded_names
;
3490 bitmap_obstack_release (NULL
);