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-2022 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 (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
;
411 chars_seen
= sprintf ((char *) buffer
,
412 "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_decimal_int (pp
, 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_UNDECLARED_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_UNDECLARED_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
);
1346 /* If the entity comes from another file, generate a package prefix. */
1347 const expanded_location xloc
= expand_location (decl_sloc (decl
, false));
1349 if (xloc
.line
&& xloc
.file
&& xloc
.file
!= current_source_file
)
1351 switch (TREE_CODE (type
))
1356 case FIXED_POINT_TYPE
:
1358 case REFERENCE_TYPE
:
1366 char *s1
= get_ada_package (xloc
.file
);
1367 append_withs (s1
, limited_access
);
1368 pp_string (buffer
, s1
);
1377 /* Generate the additional package prefix for C++ classes. */
1378 if (separate_class_package (decl
))
1380 pp_string (buffer
, "Class_");
1381 pp_string (buffer
, s
);
1388 if (!strcmp (s
, "short_int"))
1389 pp_string (buffer
, "short");
1390 else if (!strcmp (s
, "short_unsigned_int"))
1391 pp_string (buffer
, "unsigned_short");
1392 else if (!strcmp (s
, "unsigned_int"))
1393 pp_string (buffer
, "unsigned");
1394 else if (!strcmp (s
, "long_int"))
1395 pp_string (buffer
, "long");
1396 else if (!strcmp (s
, "long_unsigned_int"))
1397 pp_string (buffer
, "unsigned_long");
1398 else if (!strcmp (s
, "long_long_int"))
1399 pp_string (buffer
, "Long_Long_Integer");
1400 else if (!strcmp (s
, "long_long_unsigned_int"))
1404 append_withs ("Interfaces.C.Extensions", false);
1405 pp_string (buffer
, "Extensions.unsigned_long_long");
1408 pp_string (buffer
, "unsigned_long_long");
1411 pp_string(buffer
, s
);
1413 if (!strcmp (s
, "u_Bool") || !strcmp (s
, "bool"))
1417 append_withs ("Interfaces.C.Extensions", false);
1418 pp_string (buffer
, "Extensions.bool");
1421 pp_string (buffer
, "bool");
1424 pp_string(buffer
, s
);
1429 /* Dump in BUFFER the assembly name of T. */
1432 pp_asm_name (pretty_printer
*buffer
, tree t
)
1434 tree name
= DECL_ASSEMBLER_NAME (t
);
1435 char *ada_name
= XALLOCAVEC (char, IDENTIFIER_LENGTH (name
) + 1), *s
;
1436 const char *ident
= IDENTIFIER_POINTER (name
);
1438 for (s
= ada_name
; *ident
; ident
++)
1442 else if (*ident
!= '*')
1447 pp_string (buffer
, ada_name
);
1450 /* Dump in BUFFER the name of a DECL node if set, in Ada syntax.
1451 LIMITED_ACCESS indicates whether NODE can be accessed via a
1452 limited 'with' clause rather than a regular 'with' clause. */
1455 dump_ada_decl_name (pretty_printer
*buffer
, tree decl
, bool limited_access
)
1457 if (DECL_NAME (decl
))
1458 pp_ada_tree_identifier (buffer
, DECL_NAME (decl
), decl
, limited_access
);
1461 tree type_name
= TYPE_NAME (TREE_TYPE (decl
));
1465 pp_string (buffer
, "anon");
1466 if (TREE_CODE (decl
) == FIELD_DECL
)
1467 pp_decimal_int (buffer
, DECL_UID (decl
));
1469 pp_decimal_int (buffer
, TYPE_UID (TREE_TYPE (decl
)));
1471 else if (TREE_CODE (type_name
) == IDENTIFIER_NODE
)
1472 pp_ada_tree_identifier (buffer
, type_name
, decl
, limited_access
);
1476 /* Dump in BUFFER a name for the type T, which is a TYPE without TYPE_NAME. */
1479 dump_anonymous_type_name (pretty_printer
*buffer
, tree t
)
1481 pp_string (buffer
, "anon");
1483 switch (TREE_CODE (t
))
1486 pp_string (buffer
, "_array");
1489 pp_string (buffer
, "_enum");
1492 pp_string (buffer
, "_struct");
1495 pp_string (buffer
, "_union");
1498 pp_string (buffer
, "_unknown");
1502 pp_decimal_int (buffer
, TYPE_UID (t
));
1505 /* Dump in BUFFER aspect Import on a given node T. SPC is the current
1506 indentation level. */
1509 dump_ada_import (pretty_printer
*buffer
, tree t
, int spc
)
1511 const char *name
= IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (t
));
1512 const bool is_stdcall
1513 = TREE_CODE (t
) == FUNCTION_DECL
1514 && lookup_attribute ("stdcall", TYPE_ATTRIBUTES (TREE_TYPE (t
)));
1516 pp_string (buffer
, "with Import => True, ");
1518 newline_and_indent (buffer
, spc
+ 5);
1521 pp_string (buffer
, "Convention => Stdcall, ");
1522 else if (name
[0] == '_' && name
[1] == 'Z')
1523 pp_string (buffer
, "Convention => CPP, ");
1525 pp_string (buffer
, "Convention => C, ");
1527 newline_and_indent (buffer
, spc
+ 5);
1529 tree sec
= lookup_attribute ("section", DECL_ATTRIBUTES (t
));
1532 pp_string (buffer
, "Linker_Section => \"");
1533 pp_string (buffer
, TREE_STRING_POINTER (TREE_VALUE (TREE_VALUE (sec
))));
1534 pp_string (buffer
, "\", ");
1535 newline_and_indent (buffer
, spc
+ 5);
1538 pp_string (buffer
, "External_Name => \"");
1541 pp_string (buffer
, IDENTIFIER_POINTER (DECL_NAME (t
)));
1543 pp_asm_name (buffer
, t
);
1545 pp_string (buffer
, "\";");
1548 /* Check whether T and its type have different names, and append "the_"
1549 otherwise in BUFFER. */
1552 check_type_name_conflict (pretty_printer
*buffer
, tree t
)
1554 tree tmp
= TREE_TYPE (t
);
1556 while (TREE_CODE (tmp
) == POINTER_TYPE
&& !TYPE_NAME (tmp
))
1557 tmp
= TREE_TYPE (tmp
);
1559 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_type_name_conflict (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
)
1725 pp_left_paren (buffer
);
1727 for (; TREE_CODE (node
) == ARRAY_TYPE
; node
= TREE_TYPE (node
))
1729 tree domain
= TYPE_DOMAIN (node
);
1733 tree min
= TYPE_MIN_VALUE (domain
);
1734 tree max
= TYPE_MAX_VALUE (domain
);
1737 pp_string (buffer
, ", ");
1741 dump_ada_node (buffer
, min
, NULL_TREE
, spc
, false, true);
1742 pp_string (buffer
, " .. ");
1744 /* If the upper bound is zero, gcc may generate a NULL_TREE
1745 for TYPE_MAX_VALUE rather than an integer_cst. */
1747 dump_ada_node (buffer
, max
, NULL_TREE
, spc
, false, true);
1749 pp_string (buffer
, "0");
1753 pp_string (buffer
, "size_t");
1757 pp_right_paren (buffer
);
1760 /* Dump in BUFFER file:line information related to NODE. */
1763 dump_sloc (pretty_printer
*buffer
, tree node
)
1765 expanded_location xloc
;
1768 xloc
= expand_location (DECL_SOURCE_LOCATION (node
));
1769 else if (EXPR_HAS_LOCATION (node
))
1770 xloc
= expand_location (EXPR_LOCATION (node
));
1776 pp_string (buffer
, xloc
.file
);
1778 pp_decimal_int (buffer
, xloc
.line
);
1782 /* Return true if type T designates a 1-dimension array of "char". */
1785 is_char_array (tree t
)
1789 while (TREE_CODE (t
) == ARRAY_TYPE
)
1796 && TREE_CODE (t
) == INTEGER_TYPE
1797 && id_equal (DECL_NAME (TYPE_NAME (t
)), "char");
1800 /* Dump in BUFFER an array type NODE in Ada syntax. SPC is the indentation
1804 dump_ada_array_type (pretty_printer
*buffer
, tree node
, int spc
)
1806 const bool char_array
= is_char_array (node
);
1808 /* Special case char arrays. */
1810 pp_string (buffer
, "Interfaces.C.char_array ");
1812 pp_string (buffer
, "array ");
1814 /* Print the dimensions. */
1815 dump_ada_array_domains (buffer
, node
, spc
);
1817 /* Print the component type. */
1821 while (TREE_CODE (tmp
) == ARRAY_TYPE
)
1822 tmp
= TREE_TYPE (tmp
);
1824 pp_string (buffer
, " of ");
1826 if (TREE_CODE (tmp
) != POINTER_TYPE
)
1827 pp_string (buffer
, "aliased ");
1830 || (!RECORD_OR_UNION_TYPE_P (tmp
)
1831 && TREE_CODE (tmp
) != ENUMERAL_TYPE
))
1832 dump_ada_node (buffer
, tmp
, node
, spc
, false, true);
1834 dump_anonymous_type_name (buffer
, tmp
);
1838 /* Dump in BUFFER type names associated with a template, each prepended with
1839 '_'. TYPES is the TREE_PURPOSE of a DECL_TEMPLATE_INSTANTIATIONS. SPC is
1840 the indentation level. */
1843 dump_template_types (pretty_printer
*buffer
, tree types
, int spc
)
1845 for (int i
= 0; i
< TREE_VEC_LENGTH (types
); i
++)
1847 tree elem
= TREE_VEC_ELT (types
, i
);
1848 pp_underscore (buffer
);
1850 if (!dump_ada_node (buffer
, elem
, NULL_TREE
, spc
, false, true))
1852 pp_string (buffer
, "unknown");
1853 pp_scalar (buffer
, "%lu", (unsigned long) TREE_HASH (elem
));
1858 /* Dump in BUFFER the contents of all class instantiations associated with
1859 a given template T. SPC is the indentation level. */
1862 dump_ada_template (pretty_printer
*buffer
, tree t
, int spc
)
1864 /* DECL_SIZE_UNIT is DECL_TEMPLATE_INSTANTIATIONS in this context. */
1865 tree inst
= DECL_SIZE_UNIT (t
);
1866 /* This emulates DECL_TEMPLATE_RESULT in this context. */
1867 struct tree_template_decl
{
1868 struct tree_decl_common common
;
1872 tree result
= ((struct tree_template_decl
*) t
)->result
;
1875 /* Don't look at template declarations declaring something coming from
1876 another file. This can occur for template friend declarations. */
1877 if (LOCATION_FILE (decl_sloc (result
, false))
1878 != LOCATION_FILE (decl_sloc (t
, false)))
1881 for (; inst
&& inst
!= error_mark_node
; inst
= TREE_CHAIN (inst
))
1883 tree types
= TREE_PURPOSE (inst
);
1884 tree instance
= TREE_VALUE (inst
);
1886 if (TREE_VEC_LENGTH (types
) == 0)
1889 if (!RECORD_OR_UNION_TYPE_P (instance
))
1892 /* We are interested in concrete template instantiations only: skip
1893 partially specialized nodes. */
1894 if (RECORD_OR_UNION_TYPE_P (instance
)
1896 && cpp_check (instance
, HAS_DEPENDENT_TEMPLATE_ARGS
))
1901 pp_string (buffer
, "package ");
1902 package_prefix
= false;
1903 dump_ada_node (buffer
, instance
, t
, spc
, false, true);
1904 dump_template_types (buffer
, types
, spc
);
1905 pp_string (buffer
, " is");
1907 newline_and_indent (buffer
, spc
);
1909 TREE_VISITED (get_underlying_decl (instance
)) = 1;
1910 pp_string (buffer
, "type ");
1911 dump_ada_node (buffer
, instance
, t
, spc
, false, true);
1912 package_prefix
= true;
1914 if (is_tagged_type (instance
))
1915 pp_string (buffer
, " is tagged limited ");
1917 pp_string (buffer
, " is limited ");
1919 dump_ada_node (buffer
, instance
, t
, spc
, false, false);
1920 pp_newline (buffer
);
1922 newline_and_indent (buffer
, spc
);
1924 pp_string (buffer
, "end;");
1925 newline_and_indent (buffer
, spc
);
1926 pp_string (buffer
, "use ");
1927 package_prefix
= false;
1928 dump_ada_node (buffer
, instance
, t
, spc
, false, true);
1929 dump_template_types (buffer
, types
, spc
);
1930 package_prefix
= true;
1931 pp_semicolon (buffer
);
1932 pp_newline (buffer
);
1933 pp_newline (buffer
);
1936 return num_inst
> 0;
1939 /* Return true if NODE is a simple enumeral type that can be mapped to an
1940 Ada enumeration type directly. */
1943 is_simple_enum (tree node
)
1945 HOST_WIDE_INT count
= 0;
1947 for (tree value
= TYPE_VALUES (node
); value
; value
= TREE_CHAIN (value
))
1949 tree int_val
= TREE_VALUE (value
);
1951 if (TREE_CODE (int_val
) != INTEGER_CST
)
1952 int_val
= DECL_INITIAL (int_val
);
1954 if (!tree_fits_shwi_p (int_val
) || tree_to_shwi (int_val
) != count
)
1963 /* Dump in BUFFER the declaration of enumeral NODE of type TYPE in Ada syntax.
1964 SPC is the indentation level. */
1967 dump_ada_enum_type (pretty_printer
*buffer
, tree node
, tree type
, int spc
)
1969 if (is_simple_enum (node
))
1973 newline_and_indent (buffer
, spc
- 1);
1974 pp_left_paren (buffer
);
1975 for (tree value
= TYPE_VALUES (node
); value
; value
= TREE_CHAIN (value
))
1982 newline_and_indent (buffer
, spc
);
1985 pp_ada_tree_identifier (buffer
, TREE_PURPOSE (value
), node
, false);
1987 pp_string (buffer
, ")");
1989 newline_and_indent (buffer
, spc
);
1990 pp_string (buffer
, "with Convention => C");
1994 if (TYPE_UNSIGNED (node
))
1995 pp_string (buffer
, "unsigned");
1997 pp_string (buffer
, "int");
1999 for (tree value
= TYPE_VALUES (node
); value
; value
= TREE_CHAIN (value
))
2001 tree int_val
= TREE_VALUE (value
);
2003 if (TREE_CODE (int_val
) != INTEGER_CST
)
2004 int_val
= DECL_INITIAL (int_val
);
2006 pp_semicolon (buffer
);
2007 newline_and_indent (buffer
, spc
);
2009 if (TYPE_NAME (node
))
2010 dump_ada_node (buffer
, node
, NULL_TREE
, spc
, false, true);
2012 dump_ada_node (buffer
, type
, NULL_TREE
, spc
, false, true);
2014 dump_anonymous_type_name (buffer
, node
);
2015 pp_underscore (buffer
);
2016 pp_ada_tree_identifier (buffer
, TREE_PURPOSE (value
), node
, false);
2018 pp_string (buffer
, " : constant ");
2020 if (TYPE_NAME (node
))
2021 dump_ada_node (buffer
, node
, NULL_TREE
, spc
, false, true);
2023 dump_ada_node (buffer
, type
, NULL_TREE
, spc
, false, true);
2025 dump_anonymous_type_name (buffer
, node
);
2027 pp_string (buffer
, " := ");
2028 dump_ada_node (buffer
, int_val
, node
, spc
, false, true);
2033 /* Return true if NODE is the _Float32/_Float32x type. */
2036 is_float32 (tree node
)
2038 if (!TYPE_NAME (node
) || TREE_CODE (TYPE_NAME (node
)) != TYPE_DECL
)
2041 tree name
= DECL_NAME (TYPE_NAME (node
));
2043 if (IDENTIFIER_POINTER (name
) [0] != '_')
2046 return id_equal (name
, "_Float32") || id_equal (name
, "_Float32x");
2049 /* Return true if NODE is the _Float64/_Float64x type. */
2052 is_float64 (tree node
)
2054 if (!TYPE_NAME (node
) || TREE_CODE (TYPE_NAME (node
)) != TYPE_DECL
)
2057 tree name
= DECL_NAME (TYPE_NAME (node
));
2059 if (IDENTIFIER_POINTER (name
) [0] != '_')
2062 return id_equal (name
, "_Float64") || id_equal (name
, "_Float64x");
2065 /* Return true if NODE is the __float128/_Float128/_Float128x type. */
2068 is_float128 (tree node
)
2070 if (!TYPE_NAME (node
) || TREE_CODE (TYPE_NAME (node
)) != TYPE_DECL
)
2073 tree name
= DECL_NAME (TYPE_NAME (node
));
2075 if (IDENTIFIER_POINTER (name
) [0] != '_')
2078 return id_equal (name
, "__float128")
2079 || id_equal (name
, "_Float128")
2080 || id_equal (name
, "_Float128x");
2083 static bool bitfield_used
= false;
2084 static bool packed_layout
= false;
2086 /* Recursively dump in BUFFER Ada declarations corresponding to NODE of type
2087 TYPE. SPC is the indentation level. LIMITED_ACCESS indicates whether NODE
2088 can be referenced via a "limited with" clause. NAME_ONLY indicates whether
2089 we should only dump the name of NODE, instead of its full declaration. */
2092 dump_ada_node (pretty_printer
*buffer
, tree node
, tree type
, int spc
,
2093 bool limited_access
, bool name_only
)
2095 if (node
== NULL_TREE
)
2098 switch (TREE_CODE (node
))
2101 pp_string (buffer
, "<<< error >>>");
2104 case IDENTIFIER_NODE
:
2105 pp_ada_tree_identifier (buffer
, node
, type
, limited_access
);
2109 pp_string (buffer
, "--- unexpected node: TREE_LIST");
2113 dump_ada_node (buffer
, BINFO_TYPE (node
), type
, spc
, limited_access
,
2118 pp_string (buffer
, "--- unexpected node: TREE_VEC");
2125 append_withs ("System", false);
2126 pp_string (buffer
, "System.Address");
2129 pp_string (buffer
, "address");
2133 pp_string (buffer
, "<vector>");
2137 if (is_float128 (TREE_TYPE (node
)))
2139 append_withs ("Interfaces.C.Extensions", false);
2140 pp_string (buffer
, "Extensions.CFloat_128");
2142 else if (TREE_TYPE (node
) == float_type_node
)
2144 append_withs ("Ada.Numerics.Complex_Types", false);
2145 pp_string (buffer
, "Ada.Numerics.Complex_Types.Complex");
2147 else if (TREE_TYPE (node
) == double_type_node
)
2149 append_withs ("Ada.Numerics.Long_Complex_Types", false);
2150 pp_string (buffer
, "Ada.Numerics.Long_Complex_Types.Complex");
2152 else if (TREE_TYPE (node
) == long_double_type_node
)
2154 append_withs ("Ada.Numerics.Long_Long_Complex_Types", false);
2155 pp_string (buffer
, "Ada.Numerics.Long_Long_Complex_Types.Complex");
2158 pp_string (buffer
, "<complex>");
2163 dump_ada_node (buffer
, TYPE_NAME (node
), node
, spc
, false, true);
2165 dump_ada_enum_type (buffer
, node
, type
, spc
);
2169 if (is_float32 (node
))
2171 pp_string (buffer
, "Float");
2174 else if (is_float64 (node
))
2176 pp_string (buffer
, "Long_Float");
2179 else if (is_float128 (node
))
2181 append_withs ("Interfaces.C.Extensions", false);
2182 pp_string (buffer
, "Extensions.Float_128");
2189 case FIXED_POINT_TYPE
:
2191 if (TYPE_NAME (node
)
2192 && !(TREE_CODE (TYPE_NAME (node
)) == TYPE_DECL
2193 && !strcmp (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (node
))),
2196 if (TREE_CODE (TYPE_NAME (node
)) == IDENTIFIER_NODE
)
2197 pp_ada_tree_identifier (buffer
, TYPE_NAME (node
), node
,
2199 else if (TREE_CODE (TYPE_NAME (node
)) == TYPE_DECL
2200 && DECL_NAME (TYPE_NAME (node
)))
2201 dump_ada_decl_name (buffer
, TYPE_NAME (node
), limited_access
);
2203 pp_string (buffer
, "<unnamed type>");
2205 else if (TREE_CODE (node
) == INTEGER_TYPE
)
2207 append_withs ("Interfaces.C.Extensions", false);
2208 bitfield_used
= true;
2210 if (TYPE_PRECISION (node
) == 1)
2211 pp_string (buffer
, "Extensions.Unsigned_1");
2214 pp_string (buffer
, TYPE_UNSIGNED (node
)
2215 ? "Extensions.Unsigned_"
2216 : "Extensions.Signed_");
2217 pp_decimal_int (buffer
, TYPE_PRECISION (node
));
2221 pp_string (buffer
, "<unnamed type>");
2225 case REFERENCE_TYPE
:
2226 if (name_only
&& TYPE_NAME (node
))
2227 dump_ada_node (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
,
2230 else if (TREE_CODE (TREE_TYPE (node
)) == FUNCTION_TYPE
)
2232 if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (node
))))
2233 pp_string (buffer
, "access procedure");
2235 pp_string (buffer
, "access function");
2237 dump_ada_function_declaration (buffer
, node
, false, false, false,
2240 /* If we are dumping the full type, it means we are part of a
2241 type definition and need also a Convention C aspect. */
2244 newline_and_indent (buffer
, spc
);
2245 pp_string (buffer
, "with Convention => C");
2250 tree ref_type
= TREE_TYPE (node
);
2251 const unsigned int quals
= TYPE_QUALS (ref_type
);
2254 if (VOID_TYPE_P (ref_type
))
2257 pp_string (buffer
, "new ");
2260 append_withs ("System", false);
2261 pp_string (buffer
, "System.Address");
2264 pp_string (buffer
, "address");
2268 if (TREE_CODE (node
) == POINTER_TYPE
2269 && TREE_CODE (ref_type
) == INTEGER_TYPE
2270 && id_equal (DECL_NAME (TYPE_NAME (ref_type
)), "char"))
2273 pp_string (buffer
, "new ");
2277 pp_string (buffer
, "Interfaces.C.Strings.chars_ptr");
2278 append_withs ("Interfaces.C.Strings", false);
2281 pp_string (buffer
, "chars_ptr");
2285 tree stub
= TYPE_STUB_DECL (ref_type
);
2286 tree type_name
= TYPE_NAME (ref_type
);
2288 /* For now, handle access-to-access as System.Address. */
2289 if (TREE_CODE (ref_type
) == POINTER_TYPE
)
2293 append_withs ("System", false);
2295 pp_string (buffer
, "new ");
2296 pp_string (buffer
, "System.Address");
2299 pp_string (buffer
, "address");
2303 if (!package_prefix
)
2306 pp_string (buffer
, "access");
2308 else if (AGGREGATE_TYPE_P (ref_type
))
2310 if (!type
|| TREE_CODE (type
) != FUNCTION_DECL
)
2313 pp_string (buffer
, "access ");
2315 if (quals
& TYPE_QUAL_CONST
)
2316 pp_string (buffer
, "constant ");
2317 else if (!name_only
)
2318 pp_string (buffer
, "all ");
2320 else if (quals
& TYPE_QUAL_CONST
)
2323 pp_string (buffer
, "in ");
2328 pp_string (buffer
, "access ");
2333 /* We want to use regular with clauses for scalar types,
2334 as they are not involved in circular declarations. */
2336 pp_string (buffer
, "access ");
2339 pp_string (buffer
, "all ");
2342 /* If this is the anonymous original type of a typedef'ed
2343 type, then use the name of the latter. */
2346 && DECL_CHAIN (stub
)
2347 && TREE_CODE (DECL_CHAIN (stub
)) == TYPE_DECL
2348 && DECL_ORIGINAL_TYPE (DECL_CHAIN (stub
)) == ref_type
)
2349 ref_type
= TREE_TYPE (DECL_CHAIN (stub
));
2351 /* Generate "access <type>" instead of "access <subtype>"
2352 if the subtype comes from another file, because subtype
2353 declarations do not contribute to the limited view of a
2354 package and thus subtypes cannot be referenced through
2355 a limited_with clause. */
2358 && TREE_CODE (type_name
) == TYPE_DECL
2359 && DECL_ORIGINAL_TYPE (type_name
)
2360 && TYPE_NAME (DECL_ORIGINAL_TYPE (type_name
)))
2362 const expanded_location xloc
2363 = expand_location (decl_sloc (type_name
, false));
2366 && xloc
.file
!= current_source_file
)
2368 ref_type
= DECL_ORIGINAL_TYPE (type_name
);
2369 type_name
= TYPE_NAME (ref_type
);
2375 dump_ada_node (buffer
, ref_type
, ref_type
, spc
, is_access
,
2384 dump_ada_node (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
,
2387 dump_ada_array_type (buffer
, node
, spc
);
2393 dump_ada_node (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
,
2396 dump_ada_structure (buffer
, node
, type
, false, spc
);
2400 /* We treat the upper half of the sizetype range as negative. This
2401 is consistent with the internal treatment and makes it possible
2402 to generate the (0 .. -1) range for flexible array members. */
2403 if (TREE_TYPE (node
) == sizetype
)
2404 node
= fold_convert (ssizetype
, node
);
2405 if (tree_fits_shwi_p (node
))
2406 pp_wide_integer (buffer
, tree_to_shwi (node
));
2407 else if (tree_fits_uhwi_p (node
))
2408 pp_unsigned_wide_integer (buffer
, tree_to_uhwi (node
));
2411 wide_int val
= wi::to_wide (node
);
2413 if (wi::neg_p (val
))
2418 sprintf (pp_buffer (buffer
)->digit_buffer
,
2419 "16#%" HOST_WIDE_INT_PRINT
"x",
2420 val
.elt (val
.get_len () - 1));
2421 for (i
= val
.get_len () - 2; i
>= 0; i
--)
2422 sprintf (pp_buffer (buffer
)->digit_buffer
,
2423 HOST_WIDE_INT_PRINT_PADDED_HEX
, val
.elt (i
));
2424 pp_string (buffer
, pp_buffer (buffer
)->digit_buffer
);
2436 if (DECL_IS_UNDECLARED_BUILTIN (node
))
2438 /* Don't print the declaration of built-in types. */
2441 /* If we're in the middle of a declaration, defaults to
2445 append_withs ("System", false);
2446 pp_string (buffer
, "System.Address");
2449 pp_string (buffer
, "address");
2453 dump_ada_decl_name (buffer
, node
, limited_access
);
2456 if (is_tagged_type (TREE_TYPE (node
)))
2460 /* Look for ancestors. */
2461 for (tree fld
= TYPE_FIELDS (TREE_TYPE (node
));
2463 fld
= TREE_CHAIN (fld
))
2465 if (!DECL_NAME (fld
) && is_tagged_type (TREE_TYPE (fld
)))
2469 pp_string (buffer
, "limited new ");
2473 pp_string (buffer
, " and ");
2475 dump_ada_decl_name (buffer
, TYPE_NAME (TREE_TYPE (fld
)),
2480 pp_string (buffer
, first
? "tagged limited " : " with ");
2482 else if (has_nontrivial_methods (TREE_TYPE (node
)))
2483 pp_string (buffer
, "limited ");
2485 dump_ada_node (buffer
, TREE_TYPE (node
), type
, spc
, false, false);
2494 case NAMESPACE_DECL
:
2495 dump_ada_decl_name (buffer
, node
, false);
2499 /* Ignore other nodes (e.g. expressions). */
2506 /* Dump in BUFFER NODE's methods. SPC is the indentation level. Return 1 if
2507 methods were printed, 0 otherwise. */
2510 dump_ada_methods (pretty_printer
*buffer
, tree node
, int spc
)
2512 if (!has_nontrivial_methods (node
))
2515 pp_semicolon (buffer
);
2518 for (tree fld
= TYPE_FIELDS (node
); fld
; fld
= DECL_CHAIN (fld
))
2519 if (TREE_CODE (fld
) == FUNCTION_DECL
)
2523 pp_newline (buffer
);
2524 pp_newline (buffer
);
2527 res
= dump_ada_declaration (buffer
, fld
, node
, spc
);
2533 /* Dump in BUFFER a forward declaration for TYPE present inside T.
2534 SPC is the indentation level. */
2537 dump_forward_type (pretty_printer
*buffer
, tree type
, tree t
, int spc
)
2539 tree decl
= get_underlying_decl (type
);
2541 /* Anonymous pointer and function types. */
2544 if (TREE_CODE (type
) == POINTER_TYPE
)
2545 dump_forward_type (buffer
, TREE_TYPE (type
), t
, spc
);
2546 else if (TREE_CODE (type
) == FUNCTION_TYPE
)
2548 function_args_iterator args_iter
;
2550 dump_forward_type (buffer
, TREE_TYPE (type
), t
, spc
);
2551 FOREACH_FUNCTION_ARGS (type
, arg
, args_iter
)
2552 dump_forward_type (buffer
, arg
, t
, spc
);
2557 if (DECL_IS_UNDECLARED_BUILTIN (decl
) || TREE_VISITED (decl
))
2560 /* Forward declarations are only needed within a given file. */
2561 if (DECL_SOURCE_FILE (decl
) != DECL_SOURCE_FILE (t
))
2564 if (TREE_CODE (type
) == FUNCTION_TYPE
)
2567 /* Generate an incomplete type declaration. */
2568 pp_string (buffer
, "type ");
2569 dump_ada_node (buffer
, decl
, NULL_TREE
, spc
, false, true);
2570 pp_semicolon (buffer
);
2571 newline_and_indent (buffer
, spc
);
2573 /* Only one incomplete declaration is legal for a given type. */
2574 TREE_VISITED (decl
) = 1;
2577 /* Bitmap of anonymous types already dumped. Anonymous array types are shared
2578 throughout the compilation so it needs to be global. */
2580 static bitmap dumped_anonymous_types
;
2582 static void dump_nested_type (pretty_printer
*, tree
, tree
, int);
2584 /* Dump in BUFFER anonymous types nested inside T's definition. PARENT is the
2585 parent node of T. DUMPED_TYPES is the bitmap of already dumped types. SPC
2586 is the indentation level.
2588 In C anonymous nested tagged types have no name whereas in C++ they have
2589 one. In C their TYPE_DECL is at top level whereas in C++ it is nested.
2590 In both languages untagged types (pointers and arrays) have no name.
2591 In C++ the nested TYPE_DECLs can come after their associated FIELD_DECL.
2593 Therefore, in order to have a common processing for both languages, we
2594 disregard anonymous TYPE_DECLs at top level and here we make a first
2595 pass on the nested TYPE_DECLs and a second pass on the unnamed types. */
2598 dump_nested_types (pretty_printer
*buffer
, tree t
, int spc
)
2602 /* Find possible anonymous pointers/arrays/structs/unions recursively. */
2603 type
= TREE_TYPE (t
);
2607 for (field
= TYPE_FIELDS (type
); field
; field
= TREE_CHAIN (field
))
2608 if (TREE_CODE (field
) == TYPE_DECL
2609 && DECL_NAME (field
) != DECL_NAME (t
)
2610 && !DECL_ORIGINAL_TYPE (field
)
2611 && TYPE_NAME (TREE_TYPE (field
)) != TYPE_NAME (type
))
2612 dump_nested_type (buffer
, field
, t
, spc
);
2614 for (field
= TYPE_FIELDS (type
); field
; field
= TREE_CHAIN (field
))
2615 if (TREE_CODE (field
) == FIELD_DECL
&& !TYPE_NAME (TREE_TYPE (field
)))
2616 dump_nested_type (buffer
, field
, t
, spc
);
2619 /* Dump in BUFFER the anonymous type of FIELD inside T. SPC is the indentation
2623 dump_nested_type (pretty_printer
*buffer
, tree field
, tree t
, int spc
)
2625 tree field_type
= TREE_TYPE (field
);
2628 switch (TREE_CODE (field_type
))
2631 tmp
= TREE_TYPE (field_type
);
2632 dump_forward_type (buffer
, tmp
, t
, spc
);
2636 /* Anonymous array types are shared. */
2637 if (!bitmap_set_bit (dumped_anonymous_types
, TYPE_UID (field_type
)))
2640 /* Recurse on the element type if need be. */
2641 tmp
= TREE_TYPE (field_type
);
2642 while (TREE_CODE (tmp
) == ARRAY_TYPE
)
2643 tmp
= TREE_TYPE (tmp
);
2644 decl
= get_underlying_decl (tmp
);
2646 && !DECL_NAME (decl
)
2647 && DECL_SOURCE_FILE (decl
) == DECL_SOURCE_FILE (t
)
2648 && !TREE_VISITED (decl
))
2650 /* Generate full declaration. */
2651 dump_nested_type (buffer
, decl
, t
, spc
);
2652 TREE_VISITED (decl
) = 1;
2654 else if (!decl
&& TREE_CODE (tmp
) == POINTER_TYPE
)
2655 dump_forward_type (buffer
, TREE_TYPE (tmp
), t
, spc
);
2657 /* Special case char arrays. */
2658 if (is_char_array (field_type
))
2659 pp_string (buffer
, "subtype ");
2661 pp_string (buffer
, "type ");
2663 dump_anonymous_type_name (buffer
, field_type
);
2664 pp_string (buffer
, " is ");
2665 dump_ada_array_type (buffer
, field_type
, spc
);
2666 pp_semicolon (buffer
);
2667 newline_and_indent (buffer
, spc
);
2671 if (is_simple_enum (field_type
))
2672 pp_string (buffer
, "type ");
2674 pp_string (buffer
, "subtype ");
2676 if (TYPE_NAME (field_type
))
2677 dump_ada_node (buffer
, field_type
, NULL_TREE
, spc
, false, true);
2679 dump_anonymous_type_name (buffer
, field_type
);
2680 pp_string (buffer
, " is ");
2681 dump_ada_enum_type (buffer
, field_type
, NULL_TREE
, spc
);
2682 pp_semicolon (buffer
);
2683 newline_and_indent (buffer
, spc
);
2688 dump_nested_types (buffer
, field
, spc
);
2690 pp_string (buffer
, "type ");
2692 if (TYPE_NAME (field_type
))
2693 dump_ada_node (buffer
, field_type
, NULL_TREE
, spc
, false, true);
2695 dump_anonymous_type_name (buffer
, field_type
);
2697 if (TREE_CODE (field_type
) == UNION_TYPE
)
2698 pp_string (buffer
, " (discr : unsigned := 0)");
2700 pp_string (buffer
, " is ");
2701 dump_ada_structure (buffer
, field_type
, t
, true, spc
);
2702 pp_semicolon (buffer
);
2703 newline_and_indent (buffer
, spc
);
2711 /* Hash table of overloaded names that we cannot support. It is needed even
2712 in Ada 2012 because we merge different types, e.g. void * and const void *
2713 in System.Address, so we cannot have overloading for them in Ada. */
2715 struct overloaded_name_hash
{
2721 struct overloaded_name_hasher
: delete_ptr_hash
<overloaded_name_hash
>
2723 static inline hashval_t
hash (overloaded_name_hash
*t
)
2725 static inline bool equal (overloaded_name_hash
*a
, overloaded_name_hash
*b
)
2726 { return a
->name
== b
->name
; }
2729 typedef hash_table
<overloaded_name_hasher
> htable_t
;
2731 static htable_t
*overloaded_names
;
2733 /* Add an overloaded NAME with N occurrences to TABLE. */
2736 add_name (const char *name
, unsigned int n
, htable_t
*table
)
2738 struct overloaded_name_hash in
, *h
, **slot
;
2739 tree id
= get_identifier (name
);
2740 hashval_t hash
= htab_hash_pointer (id
);
2743 slot
= table
->find_slot_with_hash (&in
, hash
, INSERT
);
2744 h
= new overloaded_name_hash
;
2751 /* Initialize the table with the problematic overloaded names. */
2754 init_overloaded_names (void)
2756 static const char *names
[] =
2757 /* The overloaded names from the /usr/include/string.h file. */
2758 { "memchr", "rawmemchr", "memrchr", "strchr", "strrchr", "strchrnul",
2759 "strpbrk", "strstr", "strcasestr", "index", "rindex", "basename" };
2761 htable_t
*table
= new htable_t (64);
2763 for (unsigned int i
= 0; i
< ARRAY_SIZE (names
); i
++)
2764 add_name (names
[i
], 0, table
);
2766 /* Consider that sigaction() is overloaded by struct sigaction for QNX. */
2767 add_name ("sigaction", 1, table
);
2769 /* Consider that stat() is overloaded by struct stat for QNX. */
2770 add_name ("stat", 1, table
);
2775 /* Return the overloading index of NAME or 0 if NAME is not overloaded. */
2778 overloading_index (tree name
)
2780 struct overloaded_name_hash in
, *h
;
2781 hashval_t hash
= htab_hash_pointer (name
);
2784 h
= overloaded_names
->find_with_hash (&in
, hash
);
2785 return h
? ++h
->n
: 0;
2788 /* Dump in BUFFER constructor spec corresponding to T for TYPE. */
2791 print_constructor (pretty_printer
*buffer
, tree t
, tree type
)
2793 tree decl_name
= DECL_NAME (TYPE_NAME (type
));
2795 pp_string (buffer
, "New_");
2796 pp_ada_tree_identifier (buffer
, decl_name
, t
, false);
2799 /* Dump in BUFFER destructor spec corresponding to T. */
2802 print_destructor (pretty_printer
*buffer
, tree t
, tree type
)
2804 tree decl_name
= DECL_NAME (TYPE_NAME (type
));
2806 pp_string (buffer
, "Delete_");
2807 if (startswith (IDENTIFIER_POINTER (DECL_NAME (t
)), "__dt_del"))
2808 pp_string (buffer
, "And_Free_");
2809 pp_ada_tree_identifier (buffer
, decl_name
, t
, false);
2812 /* Dump in BUFFER assignment operator spec corresponding to T. */
2815 print_assignment_operator (pretty_printer
*buffer
, tree t
, tree type
)
2817 tree decl_name
= DECL_NAME (TYPE_NAME (type
));
2819 pp_string (buffer
, "Assign_");
2820 pp_ada_tree_identifier (buffer
, decl_name
, t
, false);
2823 /* Return the name of type T. */
2828 tree n
= TYPE_NAME (t
);
2830 if (TREE_CODE (n
) == IDENTIFIER_NODE
)
2831 return IDENTIFIER_POINTER (n
);
2833 return IDENTIFIER_POINTER (DECL_NAME (n
));
2836 /* Dump in BUFFER the declaration of object T of type TYPE in Ada syntax.
2837 SPC is the indentation level. Return 1 if a declaration was printed,
2841 dump_ada_declaration (pretty_printer
*buffer
, tree t
, tree type
, int spc
)
2843 bool is_var
= false;
2844 bool need_indent
= false;
2845 bool is_class
= false;
2846 tree name
= TYPE_NAME (TREE_TYPE (t
));
2847 tree decl_name
= DECL_NAME (t
);
2848 tree orig
= NULL_TREE
;
2850 if (cpp_check
&& cpp_check (t
, IS_TEMPLATE
))
2851 return dump_ada_template (buffer
, t
, spc
);
2853 /* Skip enumeral values: will be handled as part of the type itself. */
2854 if (TREE_CODE (t
) == CONST_DECL
&& TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
)
2857 if (TREE_CODE (t
) == TYPE_DECL
)
2859 orig
= DECL_ORIGINAL_TYPE (t
);
2861 /* This is a typedef. */
2862 if (orig
&& TYPE_STUB_DECL (orig
))
2864 tree stub
= TYPE_STUB_DECL (orig
);
2866 /* If this is a typedef of a named type, then output it as a subtype
2867 declaration. ??? Use a derived type declaration instead. */
2868 if (TYPE_NAME (orig
))
2870 /* If the types have the same name (ignoring casing), then ignore
2871 the second type, but forward declare the first if need be. */
2872 if (type_name (orig
) == type_name (TREE_TYPE (t
))
2873 || !strcasecmp (type_name (orig
), type_name (TREE_TYPE (t
))))
2875 if (RECORD_OR_UNION_TYPE_P (orig
) && !TREE_VISITED (stub
))
2878 dump_forward_type (buffer
, orig
, t
, 0);
2881 TREE_VISITED (t
) = 1;
2887 if (RECORD_OR_UNION_TYPE_P (orig
) && !TREE_VISITED (stub
))
2888 dump_forward_type (buffer
, orig
, t
, spc
);
2890 pp_string (buffer
, "subtype ");
2891 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2892 pp_string (buffer
, " is ");
2893 dump_ada_node (buffer
, orig
, type
, spc
, false, true);
2894 pp_string (buffer
, "; -- ");
2895 dump_sloc (buffer
, t
);
2897 TREE_VISITED (t
) = 1;
2901 /* This is a typedef of an anonymous type. We'll output the full
2902 type declaration of the anonymous type with the typedef'ed name
2903 below. Prevent forward declarations for the anonymous type to
2904 be emitted from now on. */
2905 TREE_VISITED (stub
) = 1;
2908 /* Skip unnamed or anonymous structs/unions/enum types. */
2910 && (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
))
2911 || TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
)
2916 /* Skip duplicates of structs/unions/enum types built in C++. */
2918 && (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
))
2919 || TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
)
2921 && (*IDENTIFIER_POINTER (decl_name
) == '.'
2922 || *IDENTIFIER_POINTER (decl_name
) == '$'))
2927 switch (TREE_CODE (TREE_TYPE (t
)))
2931 if (!COMPLETE_TYPE_P (TREE_TYPE (t
)))
2933 pp_string (buffer
, "type ");
2934 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2935 pp_string (buffer
, " is null record; -- incomplete struct");
2936 TREE_VISITED (t
) = 1;
2940 /* Packed record layout is not fully supported. */
2941 if (TYPE_PACKED (TREE_TYPE (t
)))
2943 warning_at (DECL_SOURCE_LOCATION (t
), 0, "packed layout");
2944 pp_string (buffer
, "pragma Compile_Time_Warning (True, ");
2945 pp_string (buffer
, "\"packed layout may be incorrect\");");
2946 newline_and_indent (buffer
, spc
);
2947 packed_layout
= true;
2950 if (orig
&& TYPE_NAME (orig
))
2951 pp_string (buffer
, "subtype ");
2954 if (separate_class_package (t
))
2957 pp_string (buffer
, "package Class_");
2958 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2959 pp_string (buffer
, " is");
2961 newline_and_indent (buffer
, spc
);
2964 dump_nested_types (buffer
, t
, spc
);
2966 pp_string (buffer
, "type ");
2971 case REFERENCE_TYPE
:
2972 dump_forward_type (buffer
, TREE_TYPE (TREE_TYPE (t
)), t
, spc
);
2973 if (orig
&& TYPE_NAME (orig
))
2974 pp_string (buffer
, "subtype ");
2976 pp_string (buffer
, "type ");
2980 if ((orig
&& TYPE_NAME (orig
)) || is_char_array (TREE_TYPE (t
)))
2981 pp_string (buffer
, "subtype ");
2983 pp_string (buffer
, "type ");
2987 pp_string (buffer
, "-- skipped function type ");
2988 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2992 if ((orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
2993 || !is_simple_enum (TREE_TYPE (t
)))
2994 pp_string (buffer
, "subtype ");
2996 pp_string (buffer
, "type ");
3000 pp_string (buffer
, "subtype ");
3003 TREE_VISITED (t
) = 1;
3009 && *IDENTIFIER_POINTER (decl_name
) == '_')
3015 /* Print the type and name. */
3016 if (TREE_CODE (TREE_TYPE (t
)) == ARRAY_TYPE
)
3021 /* Print variable's name. */
3022 dump_ada_node (buffer
, t
, type
, spc
, false, true);
3024 if (TREE_CODE (t
) == TYPE_DECL
)
3026 pp_string (buffer
, " is ");
3028 if (orig
&& TYPE_NAME (orig
))
3029 dump_ada_node (buffer
, TYPE_NAME (orig
), type
, spc
, false, true);
3031 dump_ada_array_type (buffer
, TREE_TYPE (t
), spc
);
3035 if (spc
== INDENT_INCR
|| TREE_STATIC (t
))
3038 pp_string (buffer
, " : ");
3040 if (TREE_CODE (TREE_TYPE (TREE_TYPE (t
))) != POINTER_TYPE
3042 pp_string (buffer
, "aliased ");
3044 if (TYPE_NAME (TREE_TYPE (t
)))
3045 dump_ada_node (buffer
, TREE_TYPE (t
), type
, spc
, false, true);
3047 dump_anonymous_type_name (buffer
, TREE_TYPE (t
));
3049 dump_ada_array_type (buffer
, TREE_TYPE (t
), spc
);
3052 else if (TREE_CODE (t
) == FUNCTION_DECL
)
3054 tree decl_name
= DECL_NAME (t
);
3055 bool is_abstract_class
= false;
3056 bool is_method
= TREE_CODE (TREE_TYPE (t
)) == METHOD_TYPE
;
3057 bool is_abstract
= false;
3058 bool is_assignment_operator
= false;
3059 bool is_constructor
= false;
3060 bool is_destructor
= false;
3061 bool is_copy_constructor
= false;
3062 bool is_move_constructor
= false;
3069 is_abstract
= cpp_check (t
, IS_ABSTRACT
);
3070 is_assignment_operator
= cpp_check (t
, IS_ASSIGNMENT_OPERATOR
);
3071 is_constructor
= cpp_check (t
, IS_CONSTRUCTOR
);
3072 is_destructor
= cpp_check (t
, IS_DESTRUCTOR
);
3073 is_copy_constructor
= cpp_check (t
, IS_COPY_CONSTRUCTOR
);
3074 is_move_constructor
= cpp_check (t
, IS_MOVE_CONSTRUCTOR
);
3077 /* Skip copy constructors and C++11 move constructors: some are internal
3078 only and those that are not cannot be called easily from Ada. */
3079 if (is_copy_constructor
|| is_move_constructor
)
3082 if (is_constructor
|| is_destructor
)
3084 /* ??? Skip implicit constructors/destructors for now. */
3085 if (DECL_ARTIFICIAL (t
))
3088 /* Only consider complete constructors and deleting destructors. */
3089 if (!startswith (IDENTIFIER_POINTER (decl_name
), "__ct_comp")
3090 && !startswith (IDENTIFIER_POINTER (decl_name
), "__dt_comp")
3091 && !startswith (IDENTIFIER_POINTER (decl_name
), "__dt_del"))
3095 else if (is_assignment_operator
)
3097 /* ??? Skip implicit or non-method assignment operators for now. */
3098 if (DECL_ARTIFICIAL (t
) || !is_method
)
3102 /* If this function has an entry in the vtable, we cannot omit it. */
3103 else if (!DECL_VINDEX (t
) && *IDENTIFIER_POINTER (decl_name
) == '_')
3106 pp_string (buffer
, "-- skipped func ");
3107 pp_string (buffer
, IDENTIFIER_POINTER (decl_name
));
3113 dump_forward_type (buffer
, TREE_TYPE (t
), t
, spc
);
3115 if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t
))) && !is_constructor
)
3116 pp_string (buffer
, "procedure ");
3118 pp_string (buffer
, "function ");
3121 print_constructor (buffer
, t
, type
);
3122 else if (is_destructor
)
3123 print_destructor (buffer
, t
, type
);
3124 else if (is_assignment_operator
)
3125 print_assignment_operator (buffer
, t
, type
);
3128 const unsigned int suffix
= overloading_index (decl_name
);
3129 pp_ada_tree_identifier (buffer
, decl_name
, t
, false);
3131 pp_decimal_int (buffer
, suffix
);
3134 dump_ada_function_declaration
3135 (buffer
, t
, is_method
, is_constructor
, is_destructor
, spc
);
3137 if (is_constructor
&& RECORD_OR_UNION_TYPE_P (type
))
3138 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= DECL_CHAIN (fld
))
3139 if (TREE_CODE (fld
) == FUNCTION_DECL
&& cpp_check (fld
, IS_ABSTRACT
))
3141 is_abstract_class
= true;
3145 if (is_abstract
|| is_abstract_class
)
3146 pp_string (buffer
, " is abstract");
3148 if (is_abstract
|| !DECL_ASSEMBLER_NAME (t
))
3150 pp_semicolon (buffer
);
3151 pp_string (buffer
, " -- ");
3152 dump_sloc (buffer
, t
);
3154 else if (is_constructor
)
3156 pp_semicolon (buffer
);
3157 pp_string (buffer
, " -- ");
3158 dump_sloc (buffer
, t
);
3160 newline_and_indent (buffer
, spc
);
3161 pp_string (buffer
, "pragma CPP_Constructor (");
3162 print_constructor (buffer
, t
, type
);
3163 pp_string (buffer
, ", \"");
3164 pp_asm_name (buffer
, t
);
3165 pp_string (buffer
, "\");");
3169 pp_string (buffer
, " -- ");
3170 dump_sloc (buffer
, t
);
3172 newline_and_indent (buffer
, spc
);
3173 dump_ada_import (buffer
, t
, spc
);
3178 else if (TREE_CODE (t
) == TYPE_DECL
&& !orig
)
3180 bool is_interface
= false;
3181 bool is_abstract_record
= false;
3183 /* Anonymous structs/unions. */
3184 dump_ada_node (buffer
, TREE_TYPE (t
), t
, spc
, false, true);
3186 if (TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
)
3187 pp_string (buffer
, " (discr : unsigned := 0)");
3189 pp_string (buffer
, " is ");
3191 /* Check whether we have an Ada interface compatible class.
3192 That is only have a vtable non-static data member and no
3193 non-abstract methods. */
3195 && RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
)))
3197 bool has_fields
= false;
3199 /* Check that there are no fields other than the virtual table. */
3200 for (tree fld
= TYPE_FIELDS (TREE_TYPE (t
));
3202 fld
= TREE_CHAIN (fld
))
3204 if (TREE_CODE (fld
) == FIELD_DECL
)
3206 if (!has_fields
&& DECL_VIRTUAL_P (fld
))
3207 is_interface
= true;
3209 is_interface
= false;
3212 else if (TREE_CODE (fld
) == FUNCTION_DECL
3213 && !DECL_ARTIFICIAL (fld
))
3215 if (cpp_check (fld
, IS_ABSTRACT
))
3216 is_abstract_record
= true;
3218 is_interface
= false;
3223 TREE_VISITED (t
) = 1;
3226 pp_string (buffer
, "limited interface -- ");
3227 dump_sloc (buffer
, t
);
3228 newline_and_indent (buffer
, spc
);
3229 pp_string (buffer
, "with Import => True,");
3230 newline_and_indent (buffer
, spc
+ 5);
3231 pp_string (buffer
, "Convention => CPP");
3233 dump_ada_methods (buffer
, TREE_TYPE (t
), spc
);
3237 if (is_abstract_record
)
3238 pp_string (buffer
, "abstract ");
3239 dump_ada_node (buffer
, t
, t
, spc
, false, false);
3247 if ((TREE_CODE (t
) == FIELD_DECL
|| TREE_CODE (t
) == VAR_DECL
)
3249 check_type_name_conflict (buffer
, t
);
3251 /* Print variable/type's name. */
3252 dump_ada_node (buffer
, t
, t
, spc
, false, true);
3254 if (TREE_CODE (t
) == TYPE_DECL
)
3256 const bool is_subtype
= TYPE_NAME (orig
);
3258 if (!is_subtype
&& TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
)
3259 pp_string (buffer
, " (discr : unsigned := 0)");
3261 pp_string (buffer
, " is ");
3263 dump_ada_node (buffer
, orig
, t
, spc
, false, is_subtype
);
3267 if (spc
== INDENT_INCR
|| TREE_STATIC (t
))
3270 pp_string (buffer
, " : ");
3272 if (TREE_CODE (TREE_TYPE (t
)) != POINTER_TYPE
3273 && (TYPE_NAME (TREE_TYPE (t
))
3274 || (TREE_CODE (TREE_TYPE (t
)) != INTEGER_TYPE
3275 && TREE_CODE (TREE_TYPE (t
)) != ENUMERAL_TYPE
))
3277 pp_string (buffer
, "aliased ");
3279 if (TREE_READONLY (t
) && TREE_CODE (t
) != FIELD_DECL
)
3280 pp_string (buffer
, "constant ");
3282 if (TYPE_NAME (TREE_TYPE (t
))
3283 || (!RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
))
3284 && TREE_CODE (TREE_TYPE (t
)) != ENUMERAL_TYPE
))
3285 dump_ada_node (buffer
, TREE_TYPE (t
), t
, spc
, false, true);
3287 dump_anonymous_type_name (buffer
, TREE_TYPE (t
));
3294 newline_and_indent (buffer
, spc
);
3295 pp_string (buffer
, "end;");
3296 newline_and_indent (buffer
, spc
);
3297 pp_string (buffer
, "use Class_");
3298 dump_ada_node (buffer
, t
, type
, spc
, false, true);
3299 pp_semicolon (buffer
);
3300 pp_newline (buffer
);
3302 /* All needed indentation/newline performed already, so return 0. */
3307 pp_string (buffer
, " -- ");
3308 dump_sloc (buffer
, t
);
3309 newline_and_indent (buffer
, spc
);
3310 dump_ada_import (buffer
, t
, spc
);
3315 pp_string (buffer
, "; -- ");
3316 dump_sloc (buffer
, t
);
3322 /* Dump in BUFFER a structure NODE of type TYPE in Ada syntax. If NESTED is
3323 true, it's an anonymous nested type. SPC is the indentation level. */
3326 dump_ada_structure (pretty_printer
*buffer
, tree node
, tree type
, bool nested
,
3329 const bool is_union
= (TREE_CODE (node
) == UNION_TYPE
);
3332 int field_spc
= spc
+ INDENT_INCR
;
3335 bitfield_used
= false;
3337 /* Print the contents of the structure. */
3338 pp_string (buffer
, "record");
3342 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
3343 pp_string (buffer
, "case discr is");
3344 field_spc
= spc
+ INDENT_INCR
* 3;
3347 pp_newline (buffer
);
3349 /* Print the non-static fields of the structure. */
3350 for (tree tmp
= TYPE_FIELDS (node
); tmp
; tmp
= TREE_CHAIN (tmp
))
3352 /* Add parent field if needed. */
3353 if (!DECL_NAME (tmp
))
3355 if (!is_tagged_type (TREE_TYPE (tmp
)))
3357 if (!TYPE_NAME (TREE_TYPE (tmp
)))
3358 dump_ada_declaration (buffer
, tmp
, type
, field_spc
);
3364 pp_string (buffer
, "parent : aliased ");
3367 sprintf (buf
, "field_%d : aliased ", field_num
+ 1);
3368 pp_string (buffer
, buf
);
3370 dump_ada_decl_name (buffer
, TYPE_NAME (TREE_TYPE (tmp
)),
3372 pp_semicolon (buffer
);
3375 pp_newline (buffer
);
3379 else if (TREE_CODE (tmp
) == FIELD_DECL
)
3381 /* Skip internal virtual table field. */
3382 if (!DECL_VIRTUAL_P (tmp
))
3386 if (TREE_CHAIN (tmp
)
3387 && TREE_TYPE (TREE_CHAIN (tmp
)) != node
3388 && TREE_CODE (TREE_CHAIN (tmp
)) != TYPE_DECL
)
3389 sprintf (buf
, "when %d =>", field_num
);
3391 sprintf (buf
, "when others =>");
3393 INDENT (spc
+ INDENT_INCR
* 2);
3394 pp_string (buffer
, buf
);
3395 pp_newline (buffer
);
3398 if (dump_ada_declaration (buffer
, tmp
, type
, field_spc
))
3400 pp_newline (buffer
);
3409 INDENT (spc
+ INDENT_INCR
);
3410 pp_string (buffer
, "end case;");
3411 pp_newline (buffer
);
3416 INDENT (spc
+ INDENT_INCR
);
3417 pp_string (buffer
, "null;");
3418 pp_newline (buffer
);
3422 pp_string (buffer
, "end record");
3424 newline_and_indent (buffer
, spc
);
3426 /* We disregard the methods for anonymous nested types. */
3427 if (has_nontrivial_methods (node
) && !nested
)
3429 pp_string (buffer
, "with Import => True,");
3430 newline_and_indent (buffer
, spc
+ 5);
3431 pp_string (buffer
, "Convention => CPP");
3434 pp_string (buffer
, "with Convention => C_Pass_By_Copy");
3439 newline_and_indent (buffer
, spc
+ 5);
3440 pp_string (buffer
, "Unchecked_Union => True");
3443 if (bitfield_used
|| packed_layout
)
3447 newline_and_indent (buffer
, spc
+ 5);
3448 pp_string (buffer
, "Pack => True");
3450 newline_and_indent (buffer
, spc
+ 5);
3451 sprintf (buf
, "Alignment => %d", TYPE_ALIGN (node
) / BITS_PER_UNIT
);
3452 pp_string (buffer
, buf
);
3453 bitfield_used
= false;
3454 packed_layout
= false;
3460 need_semicolon
= !dump_ada_methods (buffer
, node
, spc
);
3462 /* Print the static fields of the structure, if any. */
3463 for (tree tmp
= TYPE_FIELDS (node
); tmp
; tmp
= TREE_CHAIN (tmp
))
3465 if (TREE_CODE (tmp
) == VAR_DECL
&& DECL_NAME (tmp
))
3469 need_semicolon
= false;
3470 pp_semicolon (buffer
);
3472 pp_newline (buffer
);
3473 pp_newline (buffer
);
3474 dump_ada_declaration (buffer
, tmp
, type
, spc
);
3479 /* Dump all the declarations in SOURCE_FILE to an Ada spec.
3480 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3481 nodes for SOURCE_FILE. CHECK is used to perform C++ queries on nodes. */
3484 dump_ads (const char *source_file
,
3485 void (*collect_all_refs
)(const char *),
3486 int (*check
)(tree
, cpp_operation
))
3493 pkg_name
= get_ada_package (source_file
);
3495 /* Construct the .ads filename and package name. */
3496 ads_name
= xstrdup (pkg_name
);
3498 for (s
= ads_name
; *s
; s
++)
3504 ads_name
= reconcat (ads_name
, ads_name
, ".ads", NULL
);
3506 /* Write out the .ads file. */
3507 f
= fopen (ads_name
, "w");
3512 pp_needs_newline (&pp
) = true;
3513 pp
.buffer
->stream
= f
;
3515 /* Dump all relevant macros. */
3516 dump_ada_macros (&pp
, source_file
);
3518 /* Reset the table of withs for this file. */
3521 (*collect_all_refs
) (source_file
);
3523 /* Dump all references. */
3525 dump_ada_nodes (&pp
, source_file
);
3527 /* We require Ada 2012 syntax, so generate corresponding pragma. */
3528 fputs ("pragma Ada_2012;\n\n", f
);
3530 /* Disable style checks and warnings on unused entities since this file
3531 is auto-generated and always has a with clause for Interfaces.C. */
3532 fputs ("pragma Style_Checks (Off);\n", f
);
3533 fputs ("pragma Warnings (Off, \"-gnatwu\");\n\n", f
);
3538 fprintf (f
, "\npackage %s is\n\n", pkg_name
);
3539 pp_write_text_to_stream (&pp
);
3540 /* ??? need to free pp */
3541 fprintf (f
, "end %s;\n\n", pkg_name
);
3543 fputs ("pragma Style_Checks (On);\n", f
);
3544 fputs ("pragma Warnings (On, \"-gnatwu\");\n", f
);
3552 static const char **source_refs
= NULL
;
3553 static int source_refs_used
= 0;
3554 static int source_refs_allocd
= 0;
3556 /* Add an entry for FILENAME to the table SOURCE_REFS. */
3559 collect_source_ref (const char *filename
)
3566 if (source_refs_allocd
== 0)
3568 source_refs_allocd
= 1024;
3569 source_refs
= XNEWVEC (const char *, source_refs_allocd
);
3572 for (i
= 0; i
< source_refs_used
; i
++)
3573 if (filename
== source_refs
[i
])
3576 if (source_refs_used
== source_refs_allocd
)
3578 source_refs_allocd
*= 2;
3579 source_refs
= XRESIZEVEC (const char *, source_refs
, source_refs_allocd
);
3582 source_refs
[source_refs_used
++] = filename
;
3585 /* Main entry point: dump all Ada specs corresponding to SOURCE_REFS
3586 using callbacks COLLECT_ALL_REFS and CHECK.
3587 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3588 nodes for a given source file.
3589 CHECK is used to perform C++ queries on nodes, or NULL for the C
3593 dump_ada_specs (void (*collect_all_refs
)(const char *),
3594 int (*check
)(tree
, cpp_operation
))
3596 bitmap_obstack_initialize (NULL
);
3598 overloaded_names
= init_overloaded_names ();
3600 /* Iterate over the list of files to dump specs for. */
3601 for (int i
= 0; i
< source_refs_used
; i
++)
3603 dumped_anonymous_types
= BITMAP_ALLOC (NULL
);
3604 dump_ads (source_refs
[i
], collect_all_refs
, check
);
3605 BITMAP_FREE (dumped_anonymous_types
);
3608 /* Free various tables. */
3610 delete overloaded_names
;
3612 bitmap_obstack_release (NULL
);