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-2021 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
;
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 pp_string (buffer
, "External_Name => \"");
1532 pp_string (buffer
, IDENTIFIER_POINTER (DECL_NAME (t
)));
1534 pp_asm_name (buffer
, t
);
1536 pp_string (buffer
, "\";");
1539 /* Check whether T and its type have different names, and append "the_"
1540 otherwise in BUFFER. */
1543 check_type_name_conflict (pretty_printer
*buffer
, tree t
)
1545 tree tmp
= TREE_TYPE (t
);
1547 while (TREE_CODE (tmp
) == POINTER_TYPE
&& !TYPE_NAME (tmp
))
1548 tmp
= TREE_TYPE (tmp
);
1550 if (TREE_CODE (tmp
) != FUNCTION_TYPE
)
1554 if (TREE_CODE (tmp
) == IDENTIFIER_NODE
)
1555 s
= IDENTIFIER_POINTER (tmp
);
1556 else if (!TYPE_NAME (tmp
))
1558 else if (TREE_CODE (TYPE_NAME (tmp
)) == IDENTIFIER_NODE
)
1559 s
= IDENTIFIER_POINTER (TYPE_NAME (tmp
));
1561 s
= IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp
)));
1563 if (!strcasecmp (IDENTIFIER_POINTER (DECL_NAME (t
)), s
))
1564 pp_string (buffer
, "the_");
1568 /* Dump in BUFFER a function declaration FUNC in Ada syntax.
1569 IS_METHOD indicates whether FUNC is a C++ method.
1570 IS_CONSTRUCTOR whether FUNC is a C++ constructor.
1571 IS_DESTRUCTOR whether FUNC is a C++ destructor.
1572 SPC is the current indentation level. */
1575 dump_ada_function_declaration (pretty_printer
*buffer
, tree func
,
1576 bool is_method
, bool is_constructor
,
1577 bool is_destructor
, int spc
)
1579 tree type
= TREE_TYPE (func
);
1580 tree arg
= TYPE_ARG_TYPES (type
);
1583 int num
, num_args
= 0, have_args
= true, have_ellipsis
= false;
1585 /* Compute number of arguments. */
1588 while (TREE_CHAIN (arg
) && arg
!= error_mark_node
)
1591 arg
= TREE_CHAIN (arg
);
1594 if (TREE_CODE (TREE_VALUE (arg
)) != VOID_TYPE
)
1597 have_ellipsis
= true;
1608 newline_and_indent (buffer
, spc
+ 1);
1613 pp_left_paren (buffer
);
1616 /* For a function, see if we have the corresponding arguments. */
1617 if (TREE_CODE (func
) == FUNCTION_DECL
)
1619 arg
= DECL_ARGUMENTS (func
);
1620 for (t
= arg
, num
= 0; t
; t
= DECL_CHAIN (t
))
1628 /* Otherwise, only print the types. */
1632 arg
= TYPE_ARG_TYPES (type
);
1636 arg
= TREE_CHAIN (arg
);
1638 /* Print the argument names (if available) and types. */
1639 for (num
= 1; num
<= num_args
; num
++)
1643 if (DECL_NAME (arg
))
1645 check_type_name_conflict (buffer
, arg
);
1646 pp_ada_tree_identifier (buffer
, DECL_NAME (arg
), NULL_TREE
,
1648 pp_string (buffer
, " : ");
1652 sprintf (buf
, "arg%d : ", num
);
1653 pp_string (buffer
, buf
);
1656 dump_ada_node (buffer
, TREE_TYPE (arg
), type
, spc
, false, true);
1660 sprintf (buf
, "arg%d : ", num
);
1661 pp_string (buffer
, buf
);
1662 dump_ada_node (buffer
, TREE_VALUE (arg
), type
, spc
, false, true);
1665 /* If the type is a pointer to a tagged type, we need to differentiate
1666 virtual methods from the rest (non-virtual methods, static member
1667 or regular functions) and import only them as primitive operations,
1668 because they make up the virtual table which is mirrored on the Ada
1669 side by the dispatch table. So we add 'Class to the type of every
1670 parameter that is not the first one of a method which either has a
1671 slot in the virtual table or is a constructor. */
1673 && POINTER_TYPE_P (TREE_TYPE (arg
))
1674 && is_tagged_type (TREE_TYPE (TREE_TYPE (arg
)))
1675 && !(num
== 1 && is_method
&& (DECL_VINDEX (func
) || is_constructor
)))
1676 pp_string (buffer
, "'Class");
1678 arg
= TREE_CHAIN (arg
);
1682 pp_semicolon (buffer
);
1685 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
1693 pp_string (buffer
, " -- , ...");
1694 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
1698 pp_right_paren (buffer
);
1700 if (is_constructor
|| !VOID_TYPE_P (TREE_TYPE (type
)))
1702 pp_string (buffer
, " return ");
1703 tree rtype
= is_constructor
? DECL_CONTEXT (func
) : TREE_TYPE (type
);
1704 dump_ada_node (buffer
, rtype
, rtype
, spc
, false, true);
1708 /* Dump in BUFFER all the domains associated with an array NODE,
1709 in Ada syntax. SPC is the current indentation level. */
1712 dump_ada_array_domains (pretty_printer
*buffer
, tree node
, int spc
)
1716 pp_left_paren (buffer
);
1718 for (; TREE_CODE (node
) == ARRAY_TYPE
; node
= TREE_TYPE (node
))
1720 tree domain
= TYPE_DOMAIN (node
);
1724 tree min
= TYPE_MIN_VALUE (domain
);
1725 tree max
= TYPE_MAX_VALUE (domain
);
1728 pp_string (buffer
, ", ");
1732 dump_ada_node (buffer
, min
, NULL_TREE
, spc
, false, true);
1733 pp_string (buffer
, " .. ");
1735 /* If the upper bound is zero, gcc may generate a NULL_TREE
1736 for TYPE_MAX_VALUE rather than an integer_cst. */
1738 dump_ada_node (buffer
, max
, NULL_TREE
, spc
, false, true);
1740 pp_string (buffer
, "0");
1744 pp_string (buffer
, "size_t");
1748 pp_right_paren (buffer
);
1751 /* Dump in BUFFER file:line information related to NODE. */
1754 dump_sloc (pretty_printer
*buffer
, tree node
)
1756 expanded_location xloc
;
1759 xloc
= expand_location (DECL_SOURCE_LOCATION (node
));
1760 else if (EXPR_HAS_LOCATION (node
))
1761 xloc
= expand_location (EXPR_LOCATION (node
));
1767 pp_string (buffer
, xloc
.file
);
1769 pp_decimal_int (buffer
, xloc
.line
);
1773 /* Return true if type T designates a 1-dimension array of "char". */
1776 is_char_array (tree t
)
1780 while (TREE_CODE (t
) == ARRAY_TYPE
)
1787 && TREE_CODE (t
) == INTEGER_TYPE
1788 && id_equal (DECL_NAME (TYPE_NAME (t
)), "char");
1791 /* Dump in BUFFER an array type NODE in Ada syntax. SPC is the indentation
1795 dump_ada_array_type (pretty_printer
*buffer
, tree node
, int spc
)
1797 const bool char_array
= is_char_array (node
);
1799 /* Special case char arrays. */
1801 pp_string (buffer
, "Interfaces.C.char_array ");
1803 pp_string (buffer
, "array ");
1805 /* Print the dimensions. */
1806 dump_ada_array_domains (buffer
, node
, spc
);
1808 /* Print the component type. */
1812 while (TREE_CODE (tmp
) == ARRAY_TYPE
)
1813 tmp
= TREE_TYPE (tmp
);
1815 pp_string (buffer
, " of ");
1817 if (TREE_CODE (tmp
) != POINTER_TYPE
)
1818 pp_string (buffer
, "aliased ");
1821 || (!RECORD_OR_UNION_TYPE_P (tmp
)
1822 && TREE_CODE (tmp
) != ENUMERAL_TYPE
))
1823 dump_ada_node (buffer
, tmp
, node
, spc
, false, true);
1825 dump_anonymous_type_name (buffer
, tmp
);
1829 /* Dump in BUFFER type names associated with a template, each prepended with
1830 '_'. TYPES is the TREE_PURPOSE of a DECL_TEMPLATE_INSTANTIATIONS. SPC is
1831 the indentation level. */
1834 dump_template_types (pretty_printer
*buffer
, tree types
, int spc
)
1836 for (int i
= 0; i
< TREE_VEC_LENGTH (types
); i
++)
1838 tree elem
= TREE_VEC_ELT (types
, i
);
1839 pp_underscore (buffer
);
1841 if (!dump_ada_node (buffer
, elem
, NULL_TREE
, spc
, false, true))
1843 pp_string (buffer
, "unknown");
1844 pp_scalar (buffer
, "%lu", (unsigned long) TREE_HASH (elem
));
1849 /* Dump in BUFFER the contents of all class instantiations associated with
1850 a given template T. SPC is the indentation level. */
1853 dump_ada_template (pretty_printer
*buffer
, tree t
, int spc
)
1855 /* DECL_SIZE_UNIT is DECL_TEMPLATE_INSTANTIATIONS in this context. */
1856 tree inst
= DECL_SIZE_UNIT (t
);
1857 /* This emulates DECL_TEMPLATE_RESULT in this context. */
1858 struct tree_template_decl
{
1859 struct tree_decl_common common
;
1863 tree result
= ((struct tree_template_decl
*) t
)->result
;
1866 /* Don't look at template declarations declaring something coming from
1867 another file. This can occur for template friend declarations. */
1868 if (LOCATION_FILE (decl_sloc (result
, false))
1869 != LOCATION_FILE (decl_sloc (t
, false)))
1872 for (; inst
&& inst
!= error_mark_node
; inst
= TREE_CHAIN (inst
))
1874 tree types
= TREE_PURPOSE (inst
);
1875 tree instance
= TREE_VALUE (inst
);
1877 if (TREE_VEC_LENGTH (types
) == 0)
1880 if (!RECORD_OR_UNION_TYPE_P (instance
))
1883 /* We are interested in concrete template instantiations only: skip
1884 partially specialized nodes. */
1885 if (RECORD_OR_UNION_TYPE_P (instance
)
1887 && cpp_check (instance
, HAS_DEPENDENT_TEMPLATE_ARGS
))
1892 pp_string (buffer
, "package ");
1893 package_prefix
= false;
1894 dump_ada_node (buffer
, instance
, t
, spc
, false, true);
1895 dump_template_types (buffer
, types
, spc
);
1896 pp_string (buffer
, " is");
1898 newline_and_indent (buffer
, spc
);
1900 TREE_VISITED (get_underlying_decl (instance
)) = 1;
1901 pp_string (buffer
, "type ");
1902 dump_ada_node (buffer
, instance
, t
, spc
, false, true);
1903 package_prefix
= true;
1905 if (is_tagged_type (instance
))
1906 pp_string (buffer
, " is tagged limited ");
1908 pp_string (buffer
, " is limited ");
1910 dump_ada_node (buffer
, instance
, t
, spc
, false, false);
1911 pp_newline (buffer
);
1913 newline_and_indent (buffer
, spc
);
1915 pp_string (buffer
, "end;");
1916 newline_and_indent (buffer
, spc
);
1917 pp_string (buffer
, "use ");
1918 package_prefix
= false;
1919 dump_ada_node (buffer
, instance
, t
, spc
, false, true);
1920 dump_template_types (buffer
, types
, spc
);
1921 package_prefix
= true;
1922 pp_semicolon (buffer
);
1923 pp_newline (buffer
);
1924 pp_newline (buffer
);
1927 return num_inst
> 0;
1930 /* Return true if NODE is a simple enumeral type that can be mapped to an
1931 Ada enumeration type directly. */
1934 is_simple_enum (tree node
)
1936 HOST_WIDE_INT count
= 0;
1938 for (tree value
= TYPE_VALUES (node
); value
; value
= TREE_CHAIN (value
))
1940 tree int_val
= TREE_VALUE (value
);
1942 if (TREE_CODE (int_val
) != INTEGER_CST
)
1943 int_val
= DECL_INITIAL (int_val
);
1945 if (!tree_fits_shwi_p (int_val
) || tree_to_shwi (int_val
) != count
)
1954 /* Dump in BUFFER the declaration of enumeral NODE of type TYPE in Ada syntax.
1955 SPC is the indentation level. */
1958 dump_ada_enum_type (pretty_printer
*buffer
, tree node
, tree type
, int spc
)
1960 if (is_simple_enum (node
))
1964 newline_and_indent (buffer
, spc
- 1);
1965 pp_left_paren (buffer
);
1966 for (tree value
= TYPE_VALUES (node
); value
; value
= TREE_CHAIN (value
))
1973 newline_and_indent (buffer
, spc
);
1976 pp_ada_tree_identifier (buffer
, TREE_PURPOSE (value
), node
, false);
1978 pp_string (buffer
, ")");
1980 newline_and_indent (buffer
, spc
);
1981 pp_string (buffer
, "with Convention => C");
1985 if (TYPE_UNSIGNED (node
))
1986 pp_string (buffer
, "unsigned");
1988 pp_string (buffer
, "int");
1990 for (tree value
= TYPE_VALUES (node
); value
; value
= TREE_CHAIN (value
))
1992 tree int_val
= TREE_VALUE (value
);
1994 if (TREE_CODE (int_val
) != INTEGER_CST
)
1995 int_val
= DECL_INITIAL (int_val
);
1997 pp_semicolon (buffer
);
1998 newline_and_indent (buffer
, spc
);
2000 if (TYPE_NAME (node
))
2001 dump_ada_node (buffer
, node
, NULL_TREE
, spc
, false, true);
2003 dump_ada_node (buffer
, type
, NULL_TREE
, spc
, false, true);
2005 dump_anonymous_type_name (buffer
, node
);
2006 pp_underscore (buffer
);
2007 pp_ada_tree_identifier (buffer
, TREE_PURPOSE (value
), node
, false);
2009 pp_string (buffer
, " : constant ");
2011 if (TYPE_NAME (node
))
2012 dump_ada_node (buffer
, node
, NULL_TREE
, spc
, false, true);
2014 dump_ada_node (buffer
, type
, NULL_TREE
, spc
, false, true);
2016 dump_anonymous_type_name (buffer
, node
);
2018 pp_string (buffer
, " := ");
2019 dump_ada_node (buffer
, int_val
, node
, spc
, false, true);
2024 /* Return true if NODE is the __float128/_Float128 type. */
2027 is_float128 (tree node
)
2029 if (!TYPE_NAME (node
) || TREE_CODE (TYPE_NAME (node
)) != TYPE_DECL
)
2032 tree name
= DECL_NAME (TYPE_NAME (node
));
2034 if (IDENTIFIER_POINTER (name
) [0] != '_')
2037 return id_equal (name
, "__float128") || id_equal (name
, "_Float128");
2040 static bool bitfield_used
= false;
2041 static bool packed_layout
= false;
2043 /* Recursively dump in BUFFER Ada declarations corresponding to NODE of type
2044 TYPE. SPC is the indentation level. LIMITED_ACCESS indicates whether NODE
2045 can be referenced via a "limited with" clause. NAME_ONLY indicates whether
2046 we should only dump the name of NODE, instead of its full declaration. */
2049 dump_ada_node (pretty_printer
*buffer
, tree node
, tree type
, int spc
,
2050 bool limited_access
, bool name_only
)
2052 if (node
== NULL_TREE
)
2055 switch (TREE_CODE (node
))
2058 pp_string (buffer
, "<<< error >>>");
2061 case IDENTIFIER_NODE
:
2062 pp_ada_tree_identifier (buffer
, node
, type
, limited_access
);
2066 pp_string (buffer
, "--- unexpected node: TREE_LIST");
2070 dump_ada_node (buffer
, BINFO_TYPE (node
), type
, spc
, limited_access
,
2075 pp_string (buffer
, "--- unexpected node: TREE_VEC");
2082 append_withs ("System", false);
2083 pp_string (buffer
, "System.Address");
2086 pp_string (buffer
, "address");
2090 pp_string (buffer
, "<vector>");
2094 if (is_float128 (TREE_TYPE (node
)))
2096 append_withs ("Interfaces.C.Extensions", false);
2097 pp_string (buffer
, "Extensions.CFloat_128");
2100 pp_string (buffer
, "<complex>");
2105 dump_ada_node (buffer
, TYPE_NAME (node
), node
, spc
, false, true);
2107 dump_ada_enum_type (buffer
, node
, type
, spc
);
2111 if (is_float128 (node
))
2113 append_withs ("Interfaces.C.Extensions", false);
2114 pp_string (buffer
, "Extensions.Float_128");
2121 case FIXED_POINT_TYPE
:
2123 if (TYPE_NAME (node
)
2124 && !(TREE_CODE (TYPE_NAME (node
)) == TYPE_DECL
2125 && !strcmp (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (node
))),
2128 if (TREE_CODE (TYPE_NAME (node
)) == IDENTIFIER_NODE
)
2129 pp_ada_tree_identifier (buffer
, TYPE_NAME (node
), node
,
2131 else if (TREE_CODE (TYPE_NAME (node
)) == TYPE_DECL
2132 && DECL_NAME (TYPE_NAME (node
)))
2133 dump_ada_decl_name (buffer
, TYPE_NAME (node
), limited_access
);
2135 pp_string (buffer
, "<unnamed type>");
2137 else if (TREE_CODE (node
) == INTEGER_TYPE
)
2139 append_withs ("Interfaces.C.Extensions", false);
2140 bitfield_used
= true;
2142 if (TYPE_PRECISION (node
) == 1)
2143 pp_string (buffer
, "Extensions.Unsigned_1");
2146 pp_string (buffer
, TYPE_UNSIGNED (node
)
2147 ? "Extensions.Unsigned_"
2148 : "Extensions.Signed_");
2149 pp_decimal_int (buffer
, TYPE_PRECISION (node
));
2153 pp_string (buffer
, "<unnamed type>");
2157 case REFERENCE_TYPE
:
2158 if (name_only
&& TYPE_NAME (node
))
2159 dump_ada_node (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
,
2162 else if (TREE_CODE (TREE_TYPE (node
)) == FUNCTION_TYPE
)
2164 if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (node
))))
2165 pp_string (buffer
, "access procedure");
2167 pp_string (buffer
, "access function");
2169 dump_ada_function_declaration (buffer
, node
, false, false, false,
2172 /* If we are dumping the full type, it means we are part of a
2173 type definition and need also a Convention C aspect. */
2176 newline_and_indent (buffer
, spc
);
2177 pp_string (buffer
, "with Convention => C");
2182 const unsigned int quals
= TYPE_QUALS (TREE_TYPE (node
));
2183 bool is_access
= false;
2185 if (VOID_TYPE_P (TREE_TYPE (node
)))
2188 pp_string (buffer
, "new ");
2191 append_withs ("System", false);
2192 pp_string (buffer
, "System.Address");
2195 pp_string (buffer
, "address");
2199 if (TREE_CODE (node
) == POINTER_TYPE
2200 && TREE_CODE (TREE_TYPE (node
)) == INTEGER_TYPE
2201 && id_equal (DECL_NAME (TYPE_NAME (TREE_TYPE (node
))),
2205 pp_string (buffer
, "new ");
2209 pp_string (buffer
, "Interfaces.C.Strings.chars_ptr");
2210 append_withs ("Interfaces.C.Strings", false);
2213 pp_string (buffer
, "chars_ptr");
2217 tree type_name
= TYPE_NAME (TREE_TYPE (node
));
2219 /* Generate "access <type>" instead of "access <subtype>"
2220 if the subtype comes from another file, because subtype
2221 declarations do not contribute to the limited view of a
2222 package and thus subtypes cannot be referenced through
2223 a limited_with clause. */
2225 && TREE_CODE (type_name
) == TYPE_DECL
2226 && DECL_ORIGINAL_TYPE (type_name
)
2227 && TYPE_NAME (DECL_ORIGINAL_TYPE (type_name
)))
2229 const expanded_location xloc
2230 = expand_location (decl_sloc (type_name
, false));
2233 && xloc
.file
!= current_source_file
)
2234 type_name
= DECL_ORIGINAL_TYPE (type_name
);
2237 /* For now, handle access-to-access as System.Address. */
2238 if (TREE_CODE (TREE_TYPE (node
)) == POINTER_TYPE
)
2242 append_withs ("System", false);
2244 pp_string (buffer
, "new ");
2245 pp_string (buffer
, "System.Address");
2248 pp_string (buffer
, "address");
2252 if (!package_prefix
)
2253 pp_string (buffer
, "access");
2254 else if (AGGREGATE_TYPE_P (TREE_TYPE (node
)))
2256 if (!type
|| TREE_CODE (type
) != FUNCTION_DECL
)
2259 pp_string (buffer
, "access ");
2261 if (quals
& TYPE_QUAL_CONST
)
2262 pp_string (buffer
, "constant ");
2263 else if (!name_only
)
2264 pp_string (buffer
, "all ");
2266 else if (quals
& TYPE_QUAL_CONST
)
2267 pp_string (buffer
, "in ");
2271 pp_string (buffer
, "access ");
2272 /* ??? should be configurable: access or in out. */
2278 pp_string (buffer
, "access ");
2281 pp_string (buffer
, "all ");
2284 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node
)) && type_name
)
2285 dump_ada_node (buffer
, type_name
, TREE_TYPE (node
), spc
,
2288 dump_ada_node (buffer
, TREE_TYPE (node
), TREE_TYPE (node
),
2297 dump_ada_node (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
,
2300 dump_ada_array_type (buffer
, node
, spc
);
2306 dump_ada_node (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
,
2309 dump_ada_structure (buffer
, node
, type
, false, spc
);
2313 /* We treat the upper half of the sizetype range as negative. This
2314 is consistent with the internal treatment and makes it possible
2315 to generate the (0 .. -1) range for flexible array members. */
2316 if (TREE_TYPE (node
) == sizetype
)
2317 node
= fold_convert (ssizetype
, node
);
2318 if (tree_fits_shwi_p (node
))
2319 pp_wide_integer (buffer
, tree_to_shwi (node
));
2320 else if (tree_fits_uhwi_p (node
))
2321 pp_unsigned_wide_integer (buffer
, tree_to_uhwi (node
));
2324 wide_int val
= wi::to_wide (node
);
2326 if (wi::neg_p (val
))
2331 sprintf (pp_buffer (buffer
)->digit_buffer
,
2332 "16#%" HOST_WIDE_INT_PRINT
"x",
2333 val
.elt (val
.get_len () - 1));
2334 for (i
= val
.get_len () - 2; i
>= 0; i
--)
2335 sprintf (pp_buffer (buffer
)->digit_buffer
,
2336 HOST_WIDE_INT_PRINT_PADDED_HEX
, val
.elt (i
));
2337 pp_string (buffer
, pp_buffer (buffer
)->digit_buffer
);
2349 if (DECL_IS_UNDECLARED_BUILTIN (node
))
2351 /* Don't print the declaration of built-in types. */
2354 /* If we're in the middle of a declaration, defaults to
2358 append_withs ("System", false);
2359 pp_string (buffer
, "System.Address");
2362 pp_string (buffer
, "address");
2368 dump_ada_decl_name (buffer
, node
, limited_access
);
2371 if (is_tagged_type (TREE_TYPE (node
)))
2375 /* Look for ancestors. */
2376 for (tree fld
= TYPE_FIELDS (TREE_TYPE (node
));
2378 fld
= TREE_CHAIN (fld
))
2380 if (!DECL_NAME (fld
) && is_tagged_type (TREE_TYPE (fld
)))
2384 pp_string (buffer
, "limited new ");
2388 pp_string (buffer
, " and ");
2390 dump_ada_decl_name (buffer
, TYPE_NAME (TREE_TYPE (fld
)),
2395 pp_string (buffer
, first
? "tagged limited " : " with ");
2397 else if (has_nontrivial_methods (TREE_TYPE (node
)))
2398 pp_string (buffer
, "limited ");
2400 dump_ada_node (buffer
, TREE_TYPE (node
), type
, spc
, false, false);
2409 case NAMESPACE_DECL
:
2410 dump_ada_decl_name (buffer
, node
, false);
2414 /* Ignore other nodes (e.g. expressions). */
2421 /* Dump in BUFFER NODE's methods. SPC is the indentation level. Return 1 if
2422 methods were printed, 0 otherwise. */
2425 dump_ada_methods (pretty_printer
*buffer
, tree node
, int spc
)
2427 if (!has_nontrivial_methods (node
))
2430 pp_semicolon (buffer
);
2433 for (tree fld
= TYPE_FIELDS (node
); fld
; fld
= DECL_CHAIN (fld
))
2434 if (TREE_CODE (fld
) == FUNCTION_DECL
)
2438 pp_newline (buffer
);
2439 pp_newline (buffer
);
2442 res
= dump_ada_declaration (buffer
, fld
, node
, spc
);
2448 /* Dump in BUFFER a forward declaration for TYPE present inside T.
2449 SPC is the indentation level. */
2452 dump_forward_type (pretty_printer
*buffer
, tree type
, tree t
, int spc
)
2454 tree decl
= get_underlying_decl (type
);
2456 /* Anonymous pointer and function types. */
2459 if (TREE_CODE (type
) == POINTER_TYPE
)
2460 dump_forward_type (buffer
, TREE_TYPE (type
), t
, spc
);
2461 else if (TREE_CODE (type
) == FUNCTION_TYPE
)
2463 function_args_iterator args_iter
;
2465 dump_forward_type (buffer
, TREE_TYPE (type
), t
, spc
);
2466 FOREACH_FUNCTION_ARGS (type
, arg
, args_iter
)
2467 dump_forward_type (buffer
, arg
, t
, spc
);
2472 if (DECL_IS_UNDECLARED_BUILTIN (decl
) || TREE_VISITED (decl
))
2475 /* Forward declarations are only needed within a given file. */
2476 if (DECL_SOURCE_FILE (decl
) != DECL_SOURCE_FILE (t
))
2479 if (TREE_CODE (type
) == FUNCTION_TYPE
)
2482 /* Generate an incomplete type declaration. */
2483 pp_string (buffer
, "type ");
2484 dump_ada_node (buffer
, decl
, NULL_TREE
, spc
, false, true);
2485 pp_semicolon (buffer
);
2486 newline_and_indent (buffer
, spc
);
2488 /* Only one incomplete declaration is legal for a given type. */
2489 TREE_VISITED (decl
) = 1;
2492 /* Bitmap of anonymous types already dumped. Anonymous array types are shared
2493 throughout the compilation so it needs to be global. */
2495 static bitmap dumped_anonymous_types
;
2497 static void dump_nested_type (pretty_printer
*, tree
, tree
, int);
2499 /* Dump in BUFFER anonymous types nested inside T's definition. PARENT is the
2500 parent node of T. DUMPED_TYPES is the bitmap of already dumped types. SPC
2501 is the indentation level.
2503 In C anonymous nested tagged types have no name whereas in C++ they have
2504 one. In C their TYPE_DECL is at top level whereas in C++ it is nested.
2505 In both languages untagged types (pointers and arrays) have no name.
2506 In C++ the nested TYPE_DECLs can come after their associated FIELD_DECL.
2508 Therefore, in order to have a common processing for both languages, we
2509 disregard anonymous TYPE_DECLs at top level and here we make a first
2510 pass on the nested TYPE_DECLs and a second pass on the unnamed types. */
2513 dump_nested_types (pretty_printer
*buffer
, tree t
, int spc
)
2517 /* Find possible anonymous pointers/arrays/structs/unions recursively. */
2518 type
= TREE_TYPE (t
);
2522 for (field
= TYPE_FIELDS (type
); field
; field
= TREE_CHAIN (field
))
2523 if (TREE_CODE (field
) == TYPE_DECL
2524 && DECL_NAME (field
) != DECL_NAME (t
)
2525 && !DECL_ORIGINAL_TYPE (field
)
2526 && TYPE_NAME (TREE_TYPE (field
)) != TYPE_NAME (type
))
2527 dump_nested_type (buffer
, field
, t
, spc
);
2529 for (field
= TYPE_FIELDS (type
); field
; field
= TREE_CHAIN (field
))
2530 if (TREE_CODE (field
) == FIELD_DECL
&& !TYPE_NAME (TREE_TYPE (field
)))
2531 dump_nested_type (buffer
, field
, t
, spc
);
2534 /* Dump in BUFFER the anonymous type of FIELD inside T. SPC is the indentation
2538 dump_nested_type (pretty_printer
*buffer
, tree field
, tree t
, int spc
)
2540 tree field_type
= TREE_TYPE (field
);
2543 switch (TREE_CODE (field_type
))
2546 tmp
= TREE_TYPE (field_type
);
2547 dump_forward_type (buffer
, tmp
, t
, spc
);
2551 /* Anonymous array types are shared. */
2552 if (!bitmap_set_bit (dumped_anonymous_types
, TYPE_UID (field_type
)))
2555 /* Recurse on the element type if need be. */
2556 tmp
= TREE_TYPE (field_type
);
2557 while (TREE_CODE (tmp
) == ARRAY_TYPE
)
2558 tmp
= TREE_TYPE (tmp
);
2559 decl
= get_underlying_decl (tmp
);
2561 && !DECL_NAME (decl
)
2562 && DECL_SOURCE_FILE (decl
) == DECL_SOURCE_FILE (t
)
2563 && !TREE_VISITED (decl
))
2565 /* Generate full declaration. */
2566 dump_nested_type (buffer
, decl
, t
, spc
);
2567 TREE_VISITED (decl
) = 1;
2569 else if (!decl
&& TREE_CODE (tmp
) == POINTER_TYPE
)
2570 dump_forward_type (buffer
, TREE_TYPE (tmp
), t
, spc
);
2572 /* Special case char arrays. */
2573 if (is_char_array (field_type
))
2574 pp_string (buffer
, "subtype ");
2576 pp_string (buffer
, "type ");
2578 dump_anonymous_type_name (buffer
, field_type
);
2579 pp_string (buffer
, " is ");
2580 dump_ada_array_type (buffer
, field_type
, spc
);
2581 pp_semicolon (buffer
);
2582 newline_and_indent (buffer
, spc
);
2586 if (is_simple_enum (field_type
))
2587 pp_string (buffer
, "type ");
2589 pp_string (buffer
, "subtype ");
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
);
2595 pp_string (buffer
, " is ");
2596 dump_ada_enum_type (buffer
, field_type
, NULL_TREE
, spc
);
2597 pp_semicolon (buffer
);
2598 newline_and_indent (buffer
, spc
);
2603 dump_nested_types (buffer
, field
, spc
);
2605 pp_string (buffer
, "type ");
2607 if (TYPE_NAME (field_type
))
2608 dump_ada_node (buffer
, field_type
, NULL_TREE
, spc
, false, true);
2610 dump_anonymous_type_name (buffer
, field_type
);
2612 if (TREE_CODE (field_type
) == UNION_TYPE
)
2613 pp_string (buffer
, " (discr : unsigned := 0)");
2615 pp_string (buffer
, " is ");
2616 dump_ada_structure (buffer
, field_type
, t
, true, spc
);
2617 pp_semicolon (buffer
);
2618 newline_and_indent (buffer
, spc
);
2626 /* Hash table of overloaded names that we cannot support. It is needed even
2627 in Ada 2012 because we merge different types, e.g. void * and const void *
2628 in System.Address, so we cannot have overloading for them in Ada. */
2630 struct overloaded_name_hash
{
2636 struct overloaded_name_hasher
: delete_ptr_hash
<overloaded_name_hash
>
2638 static inline hashval_t
hash (overloaded_name_hash
*t
)
2640 static inline bool equal (overloaded_name_hash
*a
, overloaded_name_hash
*b
)
2641 { return a
->name
== b
->name
; }
2644 typedef hash_table
<overloaded_name_hasher
> htable_t
;
2646 static htable_t
*overloaded_names
;
2648 /* Add an overloaded NAME with N occurrences to TABLE. */
2651 add_name (const char *name
, unsigned int n
, htable_t
*table
)
2653 struct overloaded_name_hash in
, *h
, **slot
;
2654 tree id
= get_identifier (name
);
2655 hashval_t hash
= htab_hash_pointer (id
);
2658 slot
= table
->find_slot_with_hash (&in
, hash
, INSERT
);
2659 h
= new overloaded_name_hash
;
2666 /* Initialize the table with the problematic overloaded names. */
2669 init_overloaded_names (void)
2671 static const char *names
[] =
2672 /* The overloaded names from the /usr/include/string.h file. */
2673 { "memchr", "rawmemchr", "memrchr", "strchr", "strrchr", "strchrnul",
2674 "strpbrk", "strstr", "strcasestr", "index", "rindex", "basename" };
2676 htable_t
*table
= new htable_t (64);
2678 for (unsigned int i
= 0; i
< ARRAY_SIZE (names
); i
++)
2679 add_name (names
[i
], 0, table
);
2681 /* Consider that sigaction() is overloaded by struct sigaction for QNX. */
2682 add_name ("sigaction", 1, table
);
2684 /* Consider that stat() is overloaded by struct stat for QNX. */
2685 add_name ("stat", 1, table
);
2690 /* Return the overloading index of NAME or 0 if NAME is not overloaded. */
2693 overloading_index (tree name
)
2695 struct overloaded_name_hash in
, *h
;
2696 hashval_t hash
= htab_hash_pointer (name
);
2699 h
= overloaded_names
->find_with_hash (&in
, hash
);
2700 return h
? ++h
->n
: 0;
2703 /* Dump in BUFFER constructor spec corresponding to T for TYPE. */
2706 print_constructor (pretty_printer
*buffer
, tree t
, tree type
)
2708 tree decl_name
= DECL_NAME (TYPE_NAME (type
));
2710 pp_string (buffer
, "New_");
2711 pp_ada_tree_identifier (buffer
, decl_name
, t
, false);
2714 /* Dump in BUFFER destructor spec corresponding to T. */
2717 print_destructor (pretty_printer
*buffer
, tree t
, tree type
)
2719 tree decl_name
= DECL_NAME (TYPE_NAME (type
));
2721 pp_string (buffer
, "Delete_");
2722 if (startswith (IDENTIFIER_POINTER (DECL_NAME (t
)), "__dt_del"))
2723 pp_string (buffer
, "And_Free_");
2724 pp_ada_tree_identifier (buffer
, decl_name
, t
, false);
2727 /* Dump in BUFFER assignment operator spec corresponding to T. */
2730 print_assignment_operator (pretty_printer
*buffer
, tree t
, tree type
)
2732 tree decl_name
= DECL_NAME (TYPE_NAME (type
));
2734 pp_string (buffer
, "Assign_");
2735 pp_ada_tree_identifier (buffer
, decl_name
, t
, false);
2738 /* Return the name of type T. */
2743 tree n
= TYPE_NAME (t
);
2745 if (TREE_CODE (n
) == IDENTIFIER_NODE
)
2746 return IDENTIFIER_POINTER (n
);
2748 return IDENTIFIER_POINTER (DECL_NAME (n
));
2751 /* Dump in BUFFER the declaration of object T of type TYPE in Ada syntax.
2752 SPC is the indentation level. Return 1 if a declaration was printed,
2756 dump_ada_declaration (pretty_printer
*buffer
, tree t
, tree type
, int spc
)
2758 bool is_var
= false;
2759 bool need_indent
= false;
2760 bool is_class
= false;
2761 tree name
= TYPE_NAME (TREE_TYPE (t
));
2762 tree decl_name
= DECL_NAME (t
);
2763 tree orig
= NULL_TREE
;
2765 if (cpp_check
&& cpp_check (t
, IS_TEMPLATE
))
2766 return dump_ada_template (buffer
, t
, spc
);
2768 /* Skip enumeral values: will be handled as part of the type itself. */
2769 if (TREE_CODE (t
) == CONST_DECL
&& TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
)
2772 if (TREE_CODE (t
) == TYPE_DECL
)
2774 orig
= DECL_ORIGINAL_TYPE (t
);
2776 /* This is a typedef. */
2777 if (orig
&& TYPE_STUB_DECL (orig
))
2779 tree stub
= TYPE_STUB_DECL (orig
);
2781 /* If this is a typedef of a named type, then output it as a subtype
2782 declaration. ??? Use a derived type declaration instead. */
2783 if (TYPE_NAME (orig
))
2785 /* If the types have the same name (ignoring casing), then ignore
2786 the second type, but forward declare the first if need be. */
2787 if (type_name (orig
) == type_name (TREE_TYPE (t
))
2788 || !strcasecmp (type_name (orig
), type_name (TREE_TYPE (t
))))
2790 if (RECORD_OR_UNION_TYPE_P (orig
) && !TREE_VISITED (stub
))
2793 dump_forward_type (buffer
, orig
, t
, 0);
2796 TREE_VISITED (t
) = 1;
2802 if (RECORD_OR_UNION_TYPE_P (orig
) && !TREE_VISITED (stub
))
2803 dump_forward_type (buffer
, orig
, t
, spc
);
2805 pp_string (buffer
, "subtype ");
2806 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2807 pp_string (buffer
, " is ");
2808 dump_ada_node (buffer
, orig
, type
, spc
, false, true);
2809 pp_string (buffer
, "; -- ");
2810 dump_sloc (buffer
, t
);
2812 TREE_VISITED (t
) = 1;
2816 /* This is a typedef of an anonymous type. We'll output the full
2817 type declaration of the anonymous type with the typedef'ed name
2818 below. Prevent forward declarations for the anonymous type to
2819 be emitted from now on. */
2820 TREE_VISITED (stub
) = 1;
2823 /* Skip unnamed or anonymous structs/unions/enum types. */
2825 && (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
))
2826 || TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
)
2831 /* Skip duplicates of structs/unions/enum types built in C++. */
2833 && (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
))
2834 || TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
)
2836 && (*IDENTIFIER_POINTER (decl_name
) == '.'
2837 || *IDENTIFIER_POINTER (decl_name
) == '$'))
2842 switch (TREE_CODE (TREE_TYPE (t
)))
2846 if (!COMPLETE_TYPE_P (TREE_TYPE (t
)))
2848 pp_string (buffer
, "type ");
2849 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2850 pp_string (buffer
, " is null record; -- incomplete struct");
2851 TREE_VISITED (t
) = 1;
2855 /* Packed record layout is not fully supported. */
2856 if (TYPE_PACKED (TREE_TYPE (t
)))
2858 warning_at (DECL_SOURCE_LOCATION (t
), 0, "packed layout");
2859 pp_string (buffer
, "pragma Compile_Time_Warning (True, ");
2860 pp_string (buffer
, "\"packed layout may be incorrect\");");
2861 newline_and_indent (buffer
, spc
);
2862 packed_layout
= true;
2865 if (orig
&& TYPE_NAME (orig
))
2866 pp_string (buffer
, "subtype ");
2869 if (separate_class_package (t
))
2872 pp_string (buffer
, "package Class_");
2873 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2874 pp_string (buffer
, " is");
2876 newline_and_indent (buffer
, spc
);
2879 dump_nested_types (buffer
, t
, spc
);
2881 pp_string (buffer
, "type ");
2886 case REFERENCE_TYPE
:
2887 dump_forward_type (buffer
, TREE_TYPE (TREE_TYPE (t
)), t
, spc
);
2888 if (orig
&& TYPE_NAME (orig
))
2889 pp_string (buffer
, "subtype ");
2891 pp_string (buffer
, "type ");
2895 if ((orig
&& TYPE_NAME (orig
)) || is_char_array (TREE_TYPE (t
)))
2896 pp_string (buffer
, "subtype ");
2898 pp_string (buffer
, "type ");
2902 pp_string (buffer
, "-- skipped function type ");
2903 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2907 if ((orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
2908 || !is_simple_enum (TREE_TYPE (t
)))
2909 pp_string (buffer
, "subtype ");
2911 pp_string (buffer
, "type ");
2915 pp_string (buffer
, "subtype ");
2918 TREE_VISITED (t
) = 1;
2924 && *IDENTIFIER_POINTER (decl_name
) == '_')
2930 /* Print the type and name. */
2931 if (TREE_CODE (TREE_TYPE (t
)) == ARRAY_TYPE
)
2936 /* Print variable's name. */
2937 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2939 if (TREE_CODE (t
) == TYPE_DECL
)
2941 pp_string (buffer
, " is ");
2943 if (orig
&& TYPE_NAME (orig
))
2944 dump_ada_node (buffer
, TYPE_NAME (orig
), type
, spc
, false, true);
2946 dump_ada_array_type (buffer
, TREE_TYPE (t
), spc
);
2950 if (spc
== INDENT_INCR
|| TREE_STATIC (t
))
2953 pp_string (buffer
, " : ");
2955 if (TREE_CODE (TREE_TYPE (TREE_TYPE (t
))) != POINTER_TYPE
2957 pp_string (buffer
, "aliased ");
2959 if (TYPE_NAME (TREE_TYPE (t
)))
2960 dump_ada_node (buffer
, TREE_TYPE (t
), type
, spc
, false, true);
2962 dump_anonymous_type_name (buffer
, TREE_TYPE (t
));
2964 dump_ada_array_type (buffer
, TREE_TYPE (t
), spc
);
2967 else if (TREE_CODE (t
) == FUNCTION_DECL
)
2969 tree decl_name
= DECL_NAME (t
);
2970 bool is_abstract_class
= false;
2971 bool is_method
= TREE_CODE (TREE_TYPE (t
)) == METHOD_TYPE
;
2972 bool is_abstract
= false;
2973 bool is_assignment_operator
= false;
2974 bool is_constructor
= false;
2975 bool is_destructor
= false;
2976 bool is_copy_constructor
= false;
2977 bool is_move_constructor
= false;
2984 is_abstract
= cpp_check (t
, IS_ABSTRACT
);
2985 is_assignment_operator
= cpp_check (t
, IS_ASSIGNMENT_OPERATOR
);
2986 is_constructor
= cpp_check (t
, IS_CONSTRUCTOR
);
2987 is_destructor
= cpp_check (t
, IS_DESTRUCTOR
);
2988 is_copy_constructor
= cpp_check (t
, IS_COPY_CONSTRUCTOR
);
2989 is_move_constructor
= cpp_check (t
, IS_MOVE_CONSTRUCTOR
);
2992 /* Skip copy constructors and C++11 move constructors: some are internal
2993 only and those that are not cannot be called easily from Ada. */
2994 if (is_copy_constructor
|| is_move_constructor
)
2997 if (is_constructor
|| is_destructor
)
2999 /* ??? Skip implicit constructors/destructors for now. */
3000 if (DECL_ARTIFICIAL (t
))
3003 /* Only consider complete constructors and deleting destructors. */
3004 if (!startswith (IDENTIFIER_POINTER (decl_name
), "__ct_comp")
3005 && !startswith (IDENTIFIER_POINTER (decl_name
), "__dt_comp")
3006 && !startswith (IDENTIFIER_POINTER (decl_name
), "__dt_del"))
3010 else if (is_assignment_operator
)
3012 /* ??? Skip implicit or non-method assignment operators for now. */
3013 if (DECL_ARTIFICIAL (t
) || !is_method
)
3017 /* If this function has an entry in the vtable, we cannot omit it. */
3018 else if (!DECL_VINDEX (t
) && *IDENTIFIER_POINTER (decl_name
) == '_')
3021 pp_string (buffer
, "-- skipped func ");
3022 pp_string (buffer
, IDENTIFIER_POINTER (decl_name
));
3028 dump_forward_type (buffer
, TREE_TYPE (t
), t
, spc
);
3030 if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t
))) && !is_constructor
)
3031 pp_string (buffer
, "procedure ");
3033 pp_string (buffer
, "function ");
3036 print_constructor (buffer
, t
, type
);
3037 else if (is_destructor
)
3038 print_destructor (buffer
, t
, type
);
3039 else if (is_assignment_operator
)
3040 print_assignment_operator (buffer
, t
, type
);
3043 const unsigned int suffix
= overloading_index (decl_name
);
3044 pp_ada_tree_identifier (buffer
, decl_name
, t
, false);
3046 pp_decimal_int (buffer
, suffix
);
3049 dump_ada_function_declaration
3050 (buffer
, t
, is_method
, is_constructor
, is_destructor
, spc
);
3052 if (is_constructor
&& RECORD_OR_UNION_TYPE_P (type
))
3053 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= DECL_CHAIN (fld
))
3054 if (TREE_CODE (fld
) == FUNCTION_DECL
&& cpp_check (fld
, IS_ABSTRACT
))
3056 is_abstract_class
= true;
3060 if (is_abstract
|| is_abstract_class
)
3061 pp_string (buffer
, " is abstract");
3063 if (is_abstract
|| !DECL_ASSEMBLER_NAME (t
))
3065 pp_semicolon (buffer
);
3066 pp_string (buffer
, " -- ");
3067 dump_sloc (buffer
, t
);
3069 else if (is_constructor
)
3071 pp_semicolon (buffer
);
3072 pp_string (buffer
, " -- ");
3073 dump_sloc (buffer
, t
);
3075 newline_and_indent (buffer
, spc
);
3076 pp_string (buffer
, "pragma CPP_Constructor (");
3077 print_constructor (buffer
, t
, type
);
3078 pp_string (buffer
, ", \"");
3079 pp_asm_name (buffer
, t
);
3080 pp_string (buffer
, "\");");
3084 pp_string (buffer
, " -- ");
3085 dump_sloc (buffer
, t
);
3087 newline_and_indent (buffer
, spc
);
3088 dump_ada_import (buffer
, t
, spc
);
3093 else if (TREE_CODE (t
) == TYPE_DECL
&& !orig
)
3095 bool is_interface
= false;
3096 bool is_abstract_record
= false;
3098 /* Anonymous structs/unions. */
3099 dump_ada_node (buffer
, TREE_TYPE (t
), t
, spc
, false, true);
3101 if (TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
)
3102 pp_string (buffer
, " (discr : unsigned := 0)");
3104 pp_string (buffer
, " is ");
3106 /* Check whether we have an Ada interface compatible class.
3107 That is only have a vtable non-static data member and no
3108 non-abstract methods. */
3110 && RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
)))
3112 bool has_fields
= false;
3114 /* Check that there are no fields other than the virtual table. */
3115 for (tree fld
= TYPE_FIELDS (TREE_TYPE (t
));
3117 fld
= TREE_CHAIN (fld
))
3119 if (TREE_CODE (fld
) == FIELD_DECL
)
3121 if (!has_fields
&& DECL_VIRTUAL_P (fld
))
3122 is_interface
= true;
3124 is_interface
= false;
3127 else if (TREE_CODE (fld
) == FUNCTION_DECL
3128 && !DECL_ARTIFICIAL (fld
))
3130 if (cpp_check (fld
, IS_ABSTRACT
))
3131 is_abstract_record
= true;
3133 is_interface
= false;
3138 TREE_VISITED (t
) = 1;
3141 pp_string (buffer
, "limited interface -- ");
3142 dump_sloc (buffer
, t
);
3143 newline_and_indent (buffer
, spc
);
3144 pp_string (buffer
, "with Import => True,");
3145 newline_and_indent (buffer
, spc
+ 5);
3146 pp_string (buffer
, "Convention => CPP");
3148 dump_ada_methods (buffer
, TREE_TYPE (t
), spc
);
3152 if (is_abstract_record
)
3153 pp_string (buffer
, "abstract ");
3154 dump_ada_node (buffer
, t
, t
, spc
, false, false);
3162 if ((TREE_CODE (t
) == FIELD_DECL
|| TREE_CODE (t
) == VAR_DECL
)
3164 check_type_name_conflict (buffer
, t
);
3166 /* Print variable/type's name. */
3167 dump_ada_node (buffer
, t
, t
, spc
, false, true);
3169 if (TREE_CODE (t
) == TYPE_DECL
)
3171 const bool is_subtype
= TYPE_NAME (orig
);
3173 if (!is_subtype
&& TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
)
3174 pp_string (buffer
, " (discr : unsigned := 0)");
3176 pp_string (buffer
, " is ");
3178 dump_ada_node (buffer
, orig
, t
, spc
, false, is_subtype
);
3182 if (spc
== INDENT_INCR
|| TREE_STATIC (t
))
3185 pp_string (buffer
, " : ");
3187 if (TREE_CODE (TREE_TYPE (t
)) != POINTER_TYPE
3188 && (TYPE_NAME (TREE_TYPE (t
))
3189 || (TREE_CODE (TREE_TYPE (t
)) != INTEGER_TYPE
3190 && TREE_CODE (TREE_TYPE (t
)) != ENUMERAL_TYPE
))
3192 pp_string (buffer
, "aliased ");
3194 if (TREE_READONLY (t
) && TREE_CODE (t
) != FIELD_DECL
)
3195 pp_string (buffer
, "constant ");
3197 if (TYPE_NAME (TREE_TYPE (t
))
3198 || (!RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
))
3199 && TREE_CODE (TREE_TYPE (t
)) != ENUMERAL_TYPE
))
3200 dump_ada_node (buffer
, TREE_TYPE (t
), t
, spc
, false, true);
3202 dump_anonymous_type_name (buffer
, TREE_TYPE (t
));
3209 newline_and_indent (buffer
, spc
);
3210 pp_string (buffer
, "end;");
3211 newline_and_indent (buffer
, spc
);
3212 pp_string (buffer
, "use Class_");
3213 dump_ada_node (buffer
, t
, type
, spc
, false, true);
3214 pp_semicolon (buffer
);
3215 pp_newline (buffer
);
3217 /* All needed indentation/newline performed already, so return 0. */
3222 pp_string (buffer
, " -- ");
3223 dump_sloc (buffer
, t
);
3224 newline_and_indent (buffer
, spc
);
3225 dump_ada_import (buffer
, t
, spc
);
3230 pp_string (buffer
, "; -- ");
3231 dump_sloc (buffer
, t
);
3237 /* Dump in BUFFER a structure NODE of type TYPE in Ada syntax. If NESTED is
3238 true, it's an anonymous nested type. SPC is the indentation level. */
3241 dump_ada_structure (pretty_printer
*buffer
, tree node
, tree type
, bool nested
,
3244 const bool is_union
= (TREE_CODE (node
) == UNION_TYPE
);
3247 int field_spc
= spc
+ INDENT_INCR
;
3250 bitfield_used
= false;
3252 /* Print the contents of the structure. */
3253 pp_string (buffer
, "record");
3257 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
3258 pp_string (buffer
, "case discr is");
3259 field_spc
= spc
+ INDENT_INCR
* 3;
3262 pp_newline (buffer
);
3264 /* Print the non-static fields of the structure. */
3265 for (tree tmp
= TYPE_FIELDS (node
); tmp
; tmp
= TREE_CHAIN (tmp
))
3267 /* Add parent field if needed. */
3268 if (!DECL_NAME (tmp
))
3270 if (!is_tagged_type (TREE_TYPE (tmp
)))
3272 if (!TYPE_NAME (TREE_TYPE (tmp
)))
3273 dump_ada_declaration (buffer
, tmp
, type
, field_spc
);
3279 pp_string (buffer
, "parent : aliased ");
3282 sprintf (buf
, "field_%d : aliased ", field_num
+ 1);
3283 pp_string (buffer
, buf
);
3285 dump_ada_decl_name (buffer
, TYPE_NAME (TREE_TYPE (tmp
)),
3287 pp_semicolon (buffer
);
3290 pp_newline (buffer
);
3294 else if (TREE_CODE (tmp
) == FIELD_DECL
)
3296 /* Skip internal virtual table field. */
3297 if (!DECL_VIRTUAL_P (tmp
))
3301 if (TREE_CHAIN (tmp
)
3302 && TREE_TYPE (TREE_CHAIN (tmp
)) != node
3303 && TREE_CODE (TREE_CHAIN (tmp
)) != TYPE_DECL
)
3304 sprintf (buf
, "when %d =>", field_num
);
3306 sprintf (buf
, "when others =>");
3308 INDENT (spc
+ INDENT_INCR
* 2);
3309 pp_string (buffer
, buf
);
3310 pp_newline (buffer
);
3313 if (dump_ada_declaration (buffer
, tmp
, type
, field_spc
))
3315 pp_newline (buffer
);
3324 INDENT (spc
+ INDENT_INCR
);
3325 pp_string (buffer
, "end case;");
3326 pp_newline (buffer
);
3331 INDENT (spc
+ INDENT_INCR
);
3332 pp_string (buffer
, "null;");
3333 pp_newline (buffer
);
3337 pp_string (buffer
, "end record");
3339 newline_and_indent (buffer
, spc
);
3341 /* We disregard the methods for anonymous nested types. */
3342 if (has_nontrivial_methods (node
) && !nested
)
3344 pp_string (buffer
, "with Import => True,");
3345 newline_and_indent (buffer
, spc
+ 5);
3346 pp_string (buffer
, "Convention => CPP");
3349 pp_string (buffer
, "with Convention => C_Pass_By_Copy");
3354 newline_and_indent (buffer
, spc
+ 5);
3355 pp_string (buffer
, "Unchecked_Union => True");
3358 if (bitfield_used
|| packed_layout
)
3362 newline_and_indent (buffer
, spc
+ 5);
3363 pp_string (buffer
, "Pack => True");
3365 newline_and_indent (buffer
, spc
+ 5);
3366 sprintf (buf
, "Alignment => %d", TYPE_ALIGN (node
) / BITS_PER_UNIT
);
3367 pp_string (buffer
, buf
);
3368 bitfield_used
= false;
3369 packed_layout
= false;
3375 need_semicolon
= !dump_ada_methods (buffer
, node
, spc
);
3377 /* Print the static fields of the structure, if any. */
3378 for (tree tmp
= TYPE_FIELDS (node
); tmp
; tmp
= TREE_CHAIN (tmp
))
3380 if (TREE_CODE (tmp
) == VAR_DECL
&& DECL_NAME (tmp
))
3384 need_semicolon
= false;
3385 pp_semicolon (buffer
);
3387 pp_newline (buffer
);
3388 pp_newline (buffer
);
3389 dump_ada_declaration (buffer
, tmp
, type
, spc
);
3394 /* Dump all the declarations in SOURCE_FILE to an Ada spec.
3395 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3396 nodes for SOURCE_FILE. CHECK is used to perform C++ queries on nodes. */
3399 dump_ads (const char *source_file
,
3400 void (*collect_all_refs
)(const char *),
3401 int (*check
)(tree
, cpp_operation
))
3408 pkg_name
= get_ada_package (source_file
);
3410 /* Construct the .ads filename and package name. */
3411 ads_name
= xstrdup (pkg_name
);
3413 for (s
= ads_name
; *s
; s
++)
3419 ads_name
= reconcat (ads_name
, ads_name
, ".ads", NULL
);
3421 /* Write out the .ads file. */
3422 f
= fopen (ads_name
, "w");
3427 pp_needs_newline (&pp
) = true;
3428 pp
.buffer
->stream
= f
;
3430 /* Dump all relevant macros. */
3431 dump_ada_macros (&pp
, source_file
);
3433 /* Reset the table of withs for this file. */
3436 (*collect_all_refs
) (source_file
);
3438 /* Dump all references. */
3440 dump_ada_nodes (&pp
, source_file
);
3442 /* We require Ada 2012 syntax, so generate corresponding pragma. */
3443 fputs ("pragma Ada_2012;\n\n", f
);
3445 /* Disable style checks and warnings on unused entities since this file
3446 is auto-generated and always has a with clause for Interfaces.C. */
3447 fputs ("pragma Style_Checks (Off);\n", f
);
3448 fputs ("pragma Warnings (Off, \"-gnatwu\");\n\n", f
);
3453 fprintf (f
, "\npackage %s is\n\n", pkg_name
);
3454 pp_write_text_to_stream (&pp
);
3455 /* ??? need to free pp */
3456 fprintf (f
, "end %s;\n\n", pkg_name
);
3458 fputs ("pragma Style_Checks (On);\n", f
);
3459 fputs ("pragma Warnings (On, \"-gnatwu\");\n", f
);
3467 static const char **source_refs
= NULL
;
3468 static int source_refs_used
= 0;
3469 static int source_refs_allocd
= 0;
3471 /* Add an entry for FILENAME to the table SOURCE_REFS. */
3474 collect_source_ref (const char *filename
)
3481 if (source_refs_allocd
== 0)
3483 source_refs_allocd
= 1024;
3484 source_refs
= XNEWVEC (const char *, source_refs_allocd
);
3487 for (i
= 0; i
< source_refs_used
; i
++)
3488 if (filename
== source_refs
[i
])
3491 if (source_refs_used
== source_refs_allocd
)
3493 source_refs_allocd
*= 2;
3494 source_refs
= XRESIZEVEC (const char *, source_refs
, source_refs_allocd
);
3497 source_refs
[source_refs_used
++] = filename
;
3500 /* Main entry point: dump all Ada specs corresponding to SOURCE_REFS
3501 using callbacks COLLECT_ALL_REFS and CHECK.
3502 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3503 nodes for a given source file.
3504 CHECK is used to perform C++ queries on nodes, or NULL for the C
3508 dump_ada_specs (void (*collect_all_refs
)(const char *),
3509 int (*check
)(tree
, cpp_operation
))
3511 bitmap_obstack_initialize (NULL
);
3513 overloaded_names
= init_overloaded_names ();
3515 /* Iterate over the list of files to dump specs for. */
3516 for (int i
= 0; i
< source_refs_used
; i
++)
3518 dumped_anonymous_types
= BITMAP_ALLOC (NULL
);
3519 dump_ads (source_refs
[i
], collect_all_refs
, check
);
3520 BITMAP_FREE (dumped_anonymous_types
);
3523 /* Free various tables. */
3525 delete overloaded_names
;
3527 bitmap_obstack_release (NULL
);