1 /* Print GENERIC declaration (functions, variables, types) trees coming from
2 the C and C++ front-ends as well as macros in Ada syntax.
3 Copyright (C) 2010-2024 Free Software Foundation, Inc.
4 Adapted from tree-pretty-print.cc by Arnaud Charlet <charlet@adacore.com>
6 This file is part of GCC.
8 GCC is free software; you can redistribute it and/or modify it under
9 the terms of the GNU General Public License as published by the Free
10 Software Foundation; either version 3, or (at your option) any later
13 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
14 WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
18 You should have received a copy of the GNU General Public License
19 along with GCC; see the file COPYING3. If not see
20 <http://www.gnu.org/licenses/>. */
24 #include "coretypes.h"
26 #include "stringpool.h"
28 #include "c-ada-spec.h"
29 #include "fold-const.h"
31 #include "diagnostic.h"
32 #include "stringpool.h"
36 /* Local functions, macros and variables. */
37 static int dump_ada_node (pretty_printer
*, tree
, tree
, int, bool, bool);
38 static int dump_ada_declaration (pretty_printer
*, tree
, tree
, int);
39 static void dump_ada_structure (pretty_printer
*, tree
, tree
, bool, int);
40 static char *to_ada_name (const char *, bool *);
42 #define INDENT(SPACE) \
43 do { int i; for (i = 0; i<SPACE; i++) pp_space (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;
702 static bool bitfield_used
= false;
703 static bool packed_layout
= false;
705 /* Collect a list of declarations from T relevant to SOURCE_FILE to be dumped
706 by a subsequent call to dump_ada_nodes. */
709 collect_ada_nodes (tree t
, const char *source_file
)
712 int i
= to_dump_count
;
714 /* Count the likely relevant nodes: do not dump builtins (they are irrelevant
715 in the context of bindings) and namespaces (we do not handle them properly
717 for (n
= t
; n
; n
= TREE_CHAIN (n
))
718 if (!DECL_IS_UNDECLARED_BUILTIN (n
)
719 && TREE_CODE (n
) != NAMESPACE_DECL
720 && LOCATION_FILE (decl_sloc (n
, false)) == source_file
)
723 /* Allocate sufficient storage for all nodes. */
724 to_dump
= XRESIZEVEC (tree
, to_dump
, to_dump_count
);
726 /* Store the relevant nodes. */
727 for (n
= t
; n
; n
= TREE_CHAIN (n
))
728 if (!DECL_IS_UNDECLARED_BUILTIN (n
)
729 && TREE_CODE (n
) != NAMESPACE_DECL
730 && LOCATION_FILE (decl_sloc (n
, false)) == source_file
)
734 /* Call back for walk_tree to clear the TREE_VISITED flag of TP. */
737 unmark_visited_r (tree
*tp
, int *walk_subtrees ATTRIBUTE_UNUSED
,
738 void *data ATTRIBUTE_UNUSED
)
740 if (TREE_VISITED (*tp
))
741 TREE_VISITED (*tp
) = 0;
748 /* Print a COMMENT to the output stream PP. */
751 print_comment (pretty_printer
*pp
, const char *comment
)
753 int len
= strlen (comment
);
754 char *str
= XALLOCAVEC (char, len
+ 1);
756 bool extra_newline
= false;
758 memcpy (str
, comment
, len
+ 1);
760 /* Trim C/C++ comment indicators. */
761 if (str
[len
- 2] == '*' && str
[len
- 1] == '/')
768 tok
= strtok (str
, "\n");
770 pp_string (pp
, " --");
773 tok
= strtok (NULL
, "\n");
775 /* Leave a blank line after multi-line comments. */
777 extra_newline
= true;
784 /* Dump nodes into PP relevant to SOURCE_FILE, as collected by previous calls
785 to collect_ada_nodes. */
788 dump_ada_nodes (pretty_printer
*pp
, const char *source_file
)
791 cpp_comment_table
*comments
;
793 /* Sort the table of declarations to dump by sloc. */
794 qsort (to_dump
, to_dump_count
, sizeof (tree
), compare_node
);
796 /* Fetch the table of comments. */
797 comments
= cpp_get_comments (parse_in
);
799 /* Sort the comments table by sloc. */
800 if (comments
->count
> 1)
801 qsort (comments
->entries
, comments
->count
, sizeof (cpp_comment
),
804 /* Interleave comments and declarations in line number order. */
808 /* Advance j until comment j is in this file. */
809 while (j
!= comments
->count
810 && LOCATION_FILE (comments
->entries
[j
].sloc
) != source_file
)
813 /* Advance j until comment j is not a duplicate. */
814 while (j
< comments
->count
- 1
815 && !compare_comment (&comments
->entries
[j
],
816 &comments
->entries
[j
+ 1]))
819 /* Write decls until decl i collates after comment j. */
820 while (i
!= to_dump_count
)
822 if (j
== comments
->count
823 || LOCATION_LINE (decl_sloc (to_dump
[i
], false))
824 < LOCATION_LINE (comments
->entries
[j
].sloc
))
826 current_source_file
= source_file
;
828 if (dump_ada_declaration (pp
, to_dump
[i
++], NULL_TREE
,
839 /* Write comment j, if there is one. */
840 if (j
!= comments
->count
)
841 print_comment (pp
, comments
->entries
[j
++].comment
);
843 } while (i
!= to_dump_count
|| j
!= comments
->count
);
845 /* Clear the TREE_VISITED flag over each subtree we've dumped. */
846 for (i
= 0; i
< to_dump_count
; i
++)
847 walk_tree (&to_dump
[i
], unmark_visited_r
, NULL
, NULL
);
849 /* Finalize the to_dump table. */
858 /* Dump a newline and indent BUFFER by SPC chars. */
861 newline_and_indent (pretty_printer
*buffer
, int spc
)
867 struct with
{ char *s
; const char *in_file
; bool limited
; };
868 static struct with
*withs
= NULL
;
869 static int withs_max
= 4096;
870 static int with_len
= 0;
872 /* Record a "with" clause on package S (a limited with if LIMITED_ACCESS is
873 true), if not already done. */
876 append_withs (const char *s
, bool limited_access
)
881 withs
= XNEWVEC (struct with
, withs_max
);
883 if (with_len
== withs_max
)
886 withs
= XRESIZEVEC (struct with
, withs
, withs_max
);
889 for (i
= 0; i
< with_len
; i
++)
890 if (!strcmp (s
, withs
[i
].s
)
891 && current_source_file
== withs
[i
].in_file
)
893 withs
[i
].limited
&= limited_access
;
897 withs
[with_len
].s
= xstrdup (s
);
898 withs
[with_len
].in_file
= current_source_file
;
899 withs
[with_len
].limited
= limited_access
;
903 /* Reset "with" clauses. */
906 reset_ada_withs (void)
913 for (i
= 0; i
< with_len
; i
++)
921 /* Dump "with" clauses in F. */
924 dump_ada_withs (FILE *f
)
928 fprintf (f
, "with Interfaces.C; use Interfaces.C;\n");
930 for (i
= 0; i
< with_len
; i
++)
932 (f
, "%swith %s;\n", withs
[i
].limited
? "limited " : "", withs
[i
].s
);
935 /* Return suitable Ada package name from FILE. */
938 get_ada_package (const char *file
)
946 s
= strstr (file
, "/include/");
950 base
= lbasename (file
);
952 if (ada_specs_parent
== NULL
)
955 plen
= strlen (ada_specs_parent
) + 1;
957 res
= XNEWVEC (char, plen
+ strlen (base
) + 1);
958 if (ada_specs_parent
!= NULL
) {
959 strcpy (res
, ada_specs_parent
);
963 for (i
= plen
; *base
; base
++, i
++)
975 res
[i
] = (i
== 0 || res
[i
- 1] == '.' || res
[i
- 1] == '_') ? 'u' : '_';
987 static const char *ada_reserved
[] = {
988 "abort", "abs", "abstract", "accept", "access", "aliased", "all", "and",
989 "array", "at", "begin", "body", "case", "constant", "declare", "delay",
990 "delta", "digits", "do", "else", "elsif", "end", "entry", "exception",
991 "exit", "for", "function", "generic", "goto", "if", "in", "interface", "is",
992 "limited", "loop", "mod", "new", "not", "null", "others", "out", "of", "or",
993 "overriding", "package", "pragma", "private", "procedure", "protected",
994 "raise", "range", "record", "rem", "renames", "requeue", "return", "reverse",
995 "select", "separate", "subtype", "synchronized", "tagged", "task",
996 "terminate", "then", "type", "until", "use", "when", "while", "with", "xor",
999 /* ??? would be nice to specify this list via a config file, so that users
1000 can create their own dictionary of conflicts. */
1001 static const char *c_duplicates
[] = {
1002 /* system will cause troubles with System.Address. */
1005 /* The following values have other definitions with same name/other
1011 "rl_readline_version",
1017 /* Return a declaration tree corresponding to TYPE. */
1020 get_underlying_decl (tree type
)
1025 /* type is a declaration. */
1031 /* Strip qualifiers but do not look through typedefs. */
1032 if (TYPE_QUALS_NO_ADDR_SPACE (type
))
1033 type
= TYPE_MAIN_VARIANT (type
);
1035 /* type is a typedef. */
1036 if (TYPE_NAME (type
) && DECL_P (TYPE_NAME (type
)))
1037 return TYPE_NAME (type
);
1039 /* TYPE_STUB_DECL has been set for type. */
1040 if (TYPE_STUB_DECL (type
))
1041 return TYPE_STUB_DECL (type
);
1047 /* Return whether TYPE has static fields. */
1050 has_static_fields (const_tree type
)
1052 if (!type
|| !RECORD_OR_UNION_TYPE_P (type
) || !COMPLETE_TYPE_P (type
))
1055 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= TREE_CHAIN (fld
))
1056 if (VAR_P (fld
) && DECL_NAME (fld
))
1062 /* Return whether TYPE corresponds to an Ada tagged type (has a dispatch
1066 is_tagged_type (const_tree type
)
1068 if (!type
|| !RECORD_OR_UNION_TYPE_P (type
) || !COMPLETE_TYPE_P (type
))
1071 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= TREE_CHAIN (fld
))
1072 if (TREE_CODE (fld
) == FUNCTION_DECL
&& DECL_VINDEX (fld
))
1078 /* Return whether TYPE has non-trivial methods, i.e. methods that do something
1079 for the objects of TYPE. In C++, all classes have implicit special methods,
1080 e.g. constructors and destructors, but they can be trivial if the type is
1081 sufficiently simple. */
1084 has_nontrivial_methods (tree type
)
1086 if (!type
|| !RECORD_OR_UNION_TYPE_P (type
) || !COMPLETE_TYPE_P (type
))
1089 /* Only C++ types can have methods. */
1093 /* A non-trivial type has non-trivial special methods. */
1094 if (!cpp_check (type
, IS_TRIVIAL
))
1097 /* If there are user-defined methods, they are deemed non-trivial. */
1098 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= DECL_CHAIN (fld
))
1099 if (TREE_CODE (fld
) == FUNCTION_DECL
&& !DECL_ARTIFICIAL (fld
))
1105 #define INDEX_LENGTH 8
1107 /* Generate a legal Ada name from a C/C++ NAME and return a malloc'ed string.
1108 SPACE_FOUND, if not NULL, is used to indicate whether a space was found in
1112 to_ada_name (const char *name
, bool *space_found
)
1115 const int len
= strlen (name
);
1118 char *s
= XNEWVEC (char, len
* 2 + 5);
1122 *space_found
= false;
1124 /* Add "c_" prefix if name is an Ada reserved word. */
1125 for (names
= ada_reserved
; *names
; names
++)
1126 if (!strcasecmp (name
, *names
))
1135 /* Add "c_" prefix if name is a potential case sensitive duplicate. */
1136 for (names
= c_duplicates
; *names
; names
++)
1137 if (!strcmp (name
, *names
))
1145 for (j
= 0; name
[j
] == '_'; j
++)
1150 else if (*name
== '.' || *name
== '$')
1160 /* Replace unsuitable characters for Ada identifiers. */
1161 for (; j
< len
; j
++)
1166 *space_found
= true;
1170 /* ??? missing some C++ operators. */
1174 if (name
[j
+ 1] == '=')
1189 if (name
[j
+ 1] == '=')
1207 s
[len2
++] = name
[j
] == '&' ? 'a' : name
[j
] == '|' ? 'o' : 'x';
1209 if (name
[j
+ 1] == '=')
1222 if (s
[len2
- 1] != '_')
1225 switch (name
[j
+ 1]) {
1228 switch (name
[j
- 1]) {
1229 case '+': s
[len2
++] = 'p'; break; /* + */
1230 case '-': s
[len2
++] = 'm'; break; /* - */
1231 case '*': s
[len2
++] = 't'; break; /* * */
1232 case '/': s
[len2
++] = 'd'; break; /* / */
1238 switch (name
[j
- 1]) {
1239 case '+': s
[len2
++] = 'p'; break; /* += */
1240 case '-': s
[len2
++] = 'm'; break; /* -= */
1241 case '*': s
[len2
++] = 't'; break; /* *= */
1242 case '/': s
[len2
++] = 'd'; break; /* /= */
1276 c
= name
[j
] == '<' ? 'l' : 'g';
1279 switch (name
[j
+ 1]) {
1305 if (len2
&& s
[len2
- 1] == '_')
1310 s
[len2
++] = name
[j
];
1313 if (s
[len2
- 1] == '_')
1321 /* Return true if DECL refers to a C++ class type for which a
1322 separate enclosing package has been or should be generated. */
1325 separate_class_package (tree decl
)
1327 tree type
= TREE_TYPE (decl
);
1328 return has_nontrivial_methods (type
) || has_static_fields (type
);
1331 static bool package_prefix
= true;
1333 /* Dump in BUFFER the name of an identifier NODE of type TYPE, following Ada
1334 syntax. LIMITED_ACCESS indicates whether NODE can be accessed through a
1335 limited 'with' clause rather than a regular 'with' clause. */
1338 pp_ada_tree_identifier (pretty_printer
*buffer
, tree node
, tree type
,
1339 bool limited_access
)
1341 const char *name
= IDENTIFIER_POINTER (node
);
1342 bool space_found
= false;
1343 char *s
= to_ada_name (name
, &space_found
);
1344 tree decl
= get_underlying_decl (type
);
1348 /* If the entity comes from another file, generate a package prefix. */
1349 const expanded_location xloc
= expand_location (decl_sloc (decl
, false));
1351 if (xloc
.line
&& xloc
.file
&& xloc
.file
!= current_source_file
)
1353 switch (TREE_CODE (type
))
1358 case FIXED_POINT_TYPE
:
1360 case REFERENCE_TYPE
:
1368 char *s1
= get_ada_package (xloc
.file
);
1369 append_withs (s1
, limited_access
);
1370 pp_string (buffer
, s1
);
1379 /* Generate the additional package prefix for C++ classes. */
1380 if (separate_class_package (decl
))
1382 pp_string (buffer
, "Class_");
1383 pp_string (buffer
, s
);
1390 if (!strcmp (s
, "short_int"))
1391 pp_string (buffer
, "short");
1392 else if (!strcmp (s
, "short_unsigned_int"))
1393 pp_string (buffer
, "unsigned_short");
1394 else if (!strcmp (s
, "unsigned_int"))
1395 pp_string (buffer
, "unsigned");
1396 else if (!strcmp (s
, "long_int"))
1397 pp_string (buffer
, "long");
1398 else if (!strcmp (s
, "long_unsigned_int"))
1399 pp_string (buffer
, "unsigned_long");
1400 else if (!strcmp (s
, "long_long_int"))
1401 pp_string (buffer
, "Long_Long_Integer");
1402 else if (!strcmp (s
, "long_long_unsigned_int"))
1406 append_withs ("Interfaces.C.Extensions", false);
1407 pp_string (buffer
, "Extensions.unsigned_long_long");
1410 pp_string (buffer
, "unsigned_long_long");
1413 pp_string(buffer
, s
);
1415 if (!strcmp (s
, "u_Bool") || !strcmp (s
, "bool"))
1419 append_withs ("Interfaces.C.Extensions", false);
1420 pp_string (buffer
, "Extensions.bool");
1423 pp_string (buffer
, "bool");
1426 pp_string(buffer
, s
);
1431 /* Dump in BUFFER the assembly name of T. */
1434 pp_asm_name (pretty_printer
*buffer
, tree t
)
1436 tree name
= DECL_ASSEMBLER_NAME (t
);
1437 char *ada_name
= XALLOCAVEC (char, IDENTIFIER_LENGTH (name
) + 1), *s
;
1438 const char *ident
= IDENTIFIER_POINTER (name
);
1440 for (s
= ada_name
; *ident
; ident
++)
1444 else if (*ident
!= '*')
1449 pp_string (buffer
, ada_name
);
1452 /* Dump in BUFFER the name of a DECL node if set, in Ada syntax.
1453 LIMITED_ACCESS indicates whether NODE can be accessed via a
1454 limited 'with' clause rather than a regular 'with' clause. */
1457 dump_ada_decl_name (pretty_printer
*buffer
, tree decl
, bool limited_access
)
1459 if (DECL_NAME (decl
))
1460 pp_ada_tree_identifier (buffer
, DECL_NAME (decl
), decl
, limited_access
);
1463 tree type_name
= TYPE_NAME (TREE_TYPE (decl
));
1467 pp_string (buffer
, "anon");
1468 if (TREE_CODE (decl
) == FIELD_DECL
)
1469 pp_decimal_int (buffer
, DECL_UID (decl
));
1471 pp_decimal_int (buffer
, TYPE_UID (TREE_TYPE (decl
)));
1473 else if (TREE_CODE (type_name
) == IDENTIFIER_NODE
)
1474 pp_ada_tree_identifier (buffer
, type_name
, decl
, limited_access
);
1478 /* Dump in BUFFER a name for the type T, which is a TYPE without TYPE_NAME. */
1481 dump_anonymous_type_name (pretty_printer
*buffer
, tree t
)
1483 pp_string (buffer
, "anon");
1485 switch (TREE_CODE (t
))
1488 pp_string (buffer
, "_array");
1491 pp_string (buffer
, "_enum");
1494 pp_string (buffer
, "_struct");
1497 pp_string (buffer
, "_union");
1500 pp_string (buffer
, "_unknown");
1504 pp_decimal_int (buffer
, TYPE_UID (t
));
1507 /* Dump in BUFFER aspect Import on a given node T. SPC is the current
1508 indentation level. */
1511 dump_ada_import (pretty_printer
*buffer
, tree t
, int spc
)
1513 const char *name
= IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (t
));
1514 const bool is_stdcall
1515 = TREE_CODE (t
) == FUNCTION_DECL
1516 && lookup_attribute ("stdcall", TYPE_ATTRIBUTES (TREE_TYPE (t
)));
1518 pp_string (buffer
, "with Import => True, ");
1520 newline_and_indent (buffer
, spc
+ 5);
1523 pp_string (buffer
, "Convention => Stdcall, ");
1524 else if (name
[0] == '_' && name
[1] == 'Z')
1525 pp_string (buffer
, "Convention => CPP, ");
1527 pp_string (buffer
, "Convention => C, ");
1529 newline_and_indent (buffer
, spc
+ 5);
1531 tree sec
= lookup_attribute ("section", DECL_ATTRIBUTES (t
));
1534 pp_string (buffer
, "Linker_Section => \"");
1535 pp_string (buffer
, TREE_STRING_POINTER (TREE_VALUE (TREE_VALUE (sec
))));
1536 pp_string (buffer
, "\", ");
1537 newline_and_indent (buffer
, spc
+ 5);
1540 pp_string (buffer
, "External_Name => \"");
1543 pp_string (buffer
, IDENTIFIER_POINTER (DECL_NAME (t
)));
1545 pp_asm_name (buffer
, t
);
1547 pp_string (buffer
, "\";");
1550 /* Check whether T and its type have different names, and append "the_"
1551 otherwise in BUFFER. */
1554 check_type_name_conflict (pretty_printer
*buffer
, tree t
)
1556 tree tmp
= TREE_TYPE (t
);
1558 while (TREE_CODE (tmp
) == POINTER_TYPE
&& !TYPE_NAME (tmp
))
1559 tmp
= TREE_TYPE (tmp
);
1561 if (TREE_CODE (tmp
) != FUNCTION_TYPE
&& tmp
!= error_mark_node
)
1565 if (TREE_CODE (tmp
) == IDENTIFIER_NODE
)
1566 s
= IDENTIFIER_POINTER (tmp
);
1567 else if (!TYPE_NAME (tmp
))
1569 else if (TREE_CODE (TYPE_NAME (tmp
)) == IDENTIFIER_NODE
)
1570 s
= IDENTIFIER_POINTER (TYPE_NAME (tmp
));
1571 else if (!DECL_NAME (TYPE_NAME (tmp
)))
1574 s
= IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp
)));
1576 if (!strcasecmp (IDENTIFIER_POINTER (DECL_NAME (t
)), s
))
1577 pp_string (buffer
, "the_");
1581 /* Dump in BUFFER a function declaration FUNC in Ada syntax.
1582 IS_METHOD indicates whether FUNC is a C++ method.
1583 IS_CONSTRUCTOR whether FUNC is a C++ constructor.
1584 IS_DESTRUCTOR whether FUNC is a C++ destructor.
1585 SPC is the current indentation level. */
1588 dump_ada_function_declaration (pretty_printer
*buffer
, tree func
,
1589 bool is_method
, bool is_constructor
,
1590 bool is_destructor
, int spc
)
1592 tree type
= TREE_TYPE (func
);
1593 tree arg
= TYPE_ARG_TYPES (type
);
1596 int num
, num_args
= 0, have_args
= true, have_ellipsis
= false;
1598 /* Compute number of arguments. */
1601 while (TREE_CHAIN (arg
) && arg
!= error_mark_node
)
1604 arg
= TREE_CHAIN (arg
);
1607 if (TREE_CODE (TREE_VALUE (arg
)) != VOID_TYPE
)
1610 have_ellipsis
= true;
1621 newline_and_indent (buffer
, spc
+ 1);
1626 pp_left_paren (buffer
);
1629 /* For a function, see if we have the corresponding arguments. */
1630 if (TREE_CODE (func
) == FUNCTION_DECL
)
1632 arg
= DECL_ARGUMENTS (func
);
1633 for (t
= arg
, num
= 0; t
; t
= DECL_CHAIN (t
))
1641 /* Otherwise, only print the types. */
1645 arg
= TYPE_ARG_TYPES (type
);
1649 arg
= TREE_CHAIN (arg
);
1651 /* Print the argument names (if available) and types. */
1652 for (num
= 1; num
<= num_args
; num
++)
1656 if (DECL_NAME (arg
))
1658 check_type_name_conflict (buffer
, arg
);
1659 pp_ada_tree_identifier (buffer
, DECL_NAME (arg
), NULL_TREE
,
1661 pp_string (buffer
, " : ");
1665 sprintf (buf
, "arg%d : ", num
);
1666 pp_string (buffer
, buf
);
1669 dump_ada_node (buffer
, TREE_TYPE (arg
), type
, spc
, false, true);
1673 sprintf (buf
, "arg%d : ", num
);
1674 pp_string (buffer
, buf
);
1675 dump_ada_node (buffer
, TREE_VALUE (arg
), type
, spc
, false, true);
1678 /* If the type is a pointer to a tagged type, we need to differentiate
1679 virtual methods from the rest (non-virtual methods, static member
1680 or regular functions) and import only them as primitive operations,
1681 because they make up the virtual table which is mirrored on the Ada
1682 side by the dispatch table. So we add 'Class to the type of every
1683 parameter that is not the first one of a method which either has a
1684 slot in the virtual table or is a constructor. */
1686 && POINTER_TYPE_P (TREE_TYPE (arg
))
1687 && is_tagged_type (TREE_TYPE (TREE_TYPE (arg
)))
1688 && !(num
== 1 && is_method
&& (DECL_VINDEX (func
) || is_constructor
)))
1689 pp_string (buffer
, "'Class");
1691 arg
= TREE_CHAIN (arg
);
1695 pp_semicolon (buffer
);
1698 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
1706 pp_string (buffer
, " -- , ...");
1707 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
1711 pp_right_paren (buffer
);
1713 if (is_constructor
|| !VOID_TYPE_P (TREE_TYPE (type
)))
1715 pp_string (buffer
, " return ");
1716 tree rtype
= is_constructor
? DECL_CONTEXT (func
) : TREE_TYPE (type
);
1717 dump_ada_node (buffer
, rtype
, rtype
, spc
, false, true);
1721 /* Dump in BUFFER all the domains associated with an array NODE,
1722 in Ada syntax. SPC is the current indentation level. */
1725 dump_ada_array_domains (pretty_printer
*buffer
, tree node
, int spc
)
1729 pp_left_paren (buffer
);
1731 for (; TREE_CODE (node
) == ARRAY_TYPE
; node
= TREE_TYPE (node
))
1733 tree domain
= TYPE_DOMAIN (node
);
1737 tree min
= TYPE_MIN_VALUE (domain
);
1738 tree max
= TYPE_MAX_VALUE (domain
);
1741 pp_string (buffer
, ", ");
1745 dump_ada_node (buffer
, min
, NULL_TREE
, spc
, false, true);
1746 pp_string (buffer
, " .. ");
1748 /* If the upper bound is zero, gcc may generate a NULL_TREE
1749 for TYPE_MAX_VALUE rather than an integer_cst. */
1751 dump_ada_node (buffer
, max
, NULL_TREE
, spc
, false, true);
1753 pp_string (buffer
, "0");
1757 pp_string (buffer
, "size_t");
1761 pp_right_paren (buffer
);
1764 /* Dump in BUFFER file:line information related to NODE. */
1767 dump_sloc (pretty_printer
*buffer
, tree node
)
1769 expanded_location xloc
;
1772 xloc
= expand_location (DECL_SOURCE_LOCATION (node
));
1773 else if (EXPR_HAS_LOCATION (node
))
1774 xloc
= expand_location (EXPR_LOCATION (node
));
1780 pp_string (buffer
, xloc
.file
);
1782 pp_decimal_int (buffer
, xloc
.line
);
1786 /* Return true if type T designates a 1-dimension array of "char". */
1789 is_char_array (tree t
)
1791 return TREE_CODE (t
) == ARRAY_TYPE
1792 && TREE_CODE (TREE_TYPE (t
)) == INTEGER_TYPE
1793 && id_equal (DECL_NAME (TYPE_NAME (TREE_TYPE (t
))), "char");
1796 /* Dump in BUFFER an array type NODE in Ada syntax. SPC is the indentation
1800 dump_ada_array_type (pretty_printer
*buffer
, tree node
, int spc
)
1802 const bool char_array
= is_char_array (node
);
1804 /* Special case char arrays. */
1806 pp_string (buffer
, "Interfaces.C.char_array ");
1808 pp_string (buffer
, "array ");
1810 /* Print the dimensions. */
1811 dump_ada_array_domains (buffer
, node
, spc
);
1813 /* Print the component type. */
1816 tree tmp
= strip_array_types (node
);
1818 pp_string (buffer
, " of ");
1820 if (TREE_CODE (tmp
) != POINTER_TYPE
&& !packed_layout
)
1821 pp_string (buffer
, "aliased ");
1824 || (!RECORD_OR_UNION_TYPE_P (tmp
)
1825 && TREE_CODE (tmp
) != ENUMERAL_TYPE
))
1826 dump_ada_node (buffer
, tmp
, node
, spc
, false, true);
1828 dump_anonymous_type_name (buffer
, tmp
);
1832 /* Dump in BUFFER type names associated with a template, each prepended with
1833 '_'. TYPES is the TREE_PURPOSE of a DECL_TEMPLATE_INSTANTIATIONS. SPC is
1834 the indentation level. */
1837 dump_template_types (pretty_printer
*buffer
, tree types
, int spc
)
1839 for (int i
= 0; i
< TREE_VEC_LENGTH (types
); i
++)
1841 tree elem
= TREE_VEC_ELT (types
, i
);
1842 pp_underscore (buffer
);
1844 if (!dump_ada_node (buffer
, elem
, NULL_TREE
, spc
, false, true))
1846 pp_string (buffer
, "unknown");
1847 pp_scalar (buffer
, HOST_SIZE_T_PRINT_UNSIGNED
,
1848 (fmt_size_t
) TREE_HASH (elem
));
1853 /* Dump in BUFFER the contents of all class instantiations associated with
1854 a given template T. SPC is the indentation level. */
1857 dump_ada_template (pretty_printer
*buffer
, tree t
, int spc
)
1859 /* DECL_SIZE_UNIT is DECL_TEMPLATE_INSTANTIATIONS in this context. */
1860 tree inst
= DECL_SIZE_UNIT (t
);
1861 /* This emulates DECL_TEMPLATE_RESULT in this context. */
1862 struct tree_template_decl
{
1863 struct tree_decl_common common
;
1867 tree result
= ((struct tree_template_decl
*) t
)->result
;
1870 /* Don't look at template declarations declaring something coming from
1871 another file. This can occur for template friend declarations. */
1872 if (LOCATION_FILE (decl_sloc (result
, false))
1873 != LOCATION_FILE (decl_sloc (t
, false)))
1876 for (; inst
&& inst
!= error_mark_node
; inst
= TREE_CHAIN (inst
))
1878 tree types
= TREE_PURPOSE (inst
);
1879 tree instance
= TREE_VALUE (inst
);
1881 if (TREE_VEC_LENGTH (types
) == 0)
1884 if (!RECORD_OR_UNION_TYPE_P (instance
))
1887 /* We are interested in concrete template instantiations only: skip
1888 partially specialized nodes. */
1889 if (RECORD_OR_UNION_TYPE_P (instance
)
1891 && cpp_check (instance
, HAS_DEPENDENT_TEMPLATE_ARGS
))
1896 pp_string (buffer
, "package ");
1897 package_prefix
= false;
1898 dump_ada_node (buffer
, instance
, t
, spc
, false, true);
1899 dump_template_types (buffer
, types
, spc
);
1900 pp_string (buffer
, " is");
1902 newline_and_indent (buffer
, spc
);
1904 TREE_VISITED (get_underlying_decl (instance
)) = 1;
1905 pp_string (buffer
, "type ");
1906 dump_ada_node (buffer
, instance
, t
, spc
, false, true);
1907 package_prefix
= true;
1909 if (is_tagged_type (instance
))
1910 pp_string (buffer
, " is tagged limited ");
1912 pp_string (buffer
, " is limited ");
1914 dump_ada_node (buffer
, instance
, t
, spc
, false, false);
1915 pp_newline (buffer
);
1917 newline_and_indent (buffer
, spc
);
1919 pp_string (buffer
, "end;");
1920 newline_and_indent (buffer
, spc
);
1921 pp_string (buffer
, "use ");
1922 package_prefix
= false;
1923 dump_ada_node (buffer
, instance
, t
, spc
, false, true);
1924 dump_template_types (buffer
, types
, spc
);
1925 package_prefix
= true;
1926 pp_semicolon (buffer
);
1927 pp_newline (buffer
);
1928 pp_newline (buffer
);
1931 return num_inst
> 0;
1934 /* Return true if NODE is a simple enumeral type that can be mapped to an
1935 Ada enumeration type directly. */
1938 is_simple_enum (tree node
)
1940 HOST_WIDE_INT count
= 0;
1942 for (tree value
= TYPE_VALUES (node
); value
; value
= TREE_CHAIN (value
))
1944 tree int_val
= TREE_VALUE (value
);
1946 if (TREE_CODE (int_val
) != INTEGER_CST
)
1947 int_val
= DECL_INITIAL (int_val
);
1949 if (!tree_fits_shwi_p (int_val
) || tree_to_shwi (int_val
) != count
)
1958 /* Dump in BUFFER the declaration of enumeral NODE of type TYPE in Ada syntax.
1959 SPC is the indentation level. */
1962 dump_ada_enum_type (pretty_printer
*buffer
, tree node
, tree type
, int spc
)
1964 if (is_simple_enum (node
))
1968 newline_and_indent (buffer
, spc
- 1);
1969 pp_left_paren (buffer
);
1970 for (tree value
= TYPE_VALUES (node
); value
; value
= TREE_CHAIN (value
))
1977 newline_and_indent (buffer
, spc
);
1980 pp_ada_tree_identifier (buffer
, TREE_PURPOSE (value
), node
, false);
1982 pp_string (buffer
, ")");
1984 newline_and_indent (buffer
, spc
);
1985 pp_string (buffer
, "with Convention => C");
1989 if (TYPE_UNSIGNED (node
))
1990 pp_string (buffer
, "unsigned");
1992 pp_string (buffer
, "int");
1994 for (tree value
= TYPE_VALUES (node
); value
; value
= TREE_CHAIN (value
))
1996 tree int_val
= TREE_VALUE (value
);
1998 if (TREE_CODE (int_val
) != INTEGER_CST
)
1999 int_val
= DECL_INITIAL (int_val
);
2001 pp_semicolon (buffer
);
2002 newline_and_indent (buffer
, spc
);
2004 if (TYPE_NAME (node
))
2005 dump_ada_node (buffer
, node
, NULL_TREE
, spc
, false, true);
2007 dump_ada_node (buffer
, type
, NULL_TREE
, spc
, false, true);
2009 dump_anonymous_type_name (buffer
, node
);
2010 pp_underscore (buffer
);
2011 pp_ada_tree_identifier (buffer
, TREE_PURPOSE (value
), node
, false);
2013 pp_string (buffer
, " : constant ");
2015 if (TYPE_NAME (node
))
2016 dump_ada_node (buffer
, node
, NULL_TREE
, spc
, false, true);
2018 dump_ada_node (buffer
, type
, NULL_TREE
, spc
, false, true);
2020 dump_anonymous_type_name (buffer
, node
);
2022 pp_string (buffer
, " := ");
2023 dump_ada_node (buffer
, int_val
, node
, spc
, false, true);
2028 /* Return true if NODE is the _Float32/_Float32x type. */
2031 is_float32 (tree node
)
2033 if (!TYPE_NAME (node
) || TREE_CODE (TYPE_NAME (node
)) != TYPE_DECL
)
2036 tree name
= DECL_NAME (TYPE_NAME (node
));
2038 if (IDENTIFIER_POINTER (name
) [0] != '_')
2041 return id_equal (name
, "_Float32") || id_equal (name
, "_Float32x");
2044 /* Return true if NODE is the _Float64/_Float64x type. */
2047 is_float64 (tree node
)
2049 if (!TYPE_NAME (node
) || TREE_CODE (TYPE_NAME (node
)) != TYPE_DECL
)
2052 tree name
= DECL_NAME (TYPE_NAME (node
));
2054 if (IDENTIFIER_POINTER (name
) [0] != '_')
2057 return id_equal (name
, "_Float64") || id_equal (name
, "_Float64x");
2060 /* Return true if NODE is the __float128/_Float128/_Float128x type. */
2063 is_float128 (tree node
)
2065 if (!TYPE_NAME (node
) || TREE_CODE (TYPE_NAME (node
)) != TYPE_DECL
)
2068 tree name
= DECL_NAME (TYPE_NAME (node
));
2070 if (IDENTIFIER_POINTER (name
) [0] != '_')
2073 return id_equal (name
, "__float128")
2074 || id_equal (name
, "_Float128")
2075 || id_equal (name
, "_Float128x");
2078 /* Recursively dump in BUFFER Ada declarations corresponding to NODE of type
2079 TYPE. SPC is the indentation level. LIMITED_ACCESS indicates whether NODE
2080 can be referenced via a "limited with" clause. NAME_ONLY indicates whether
2081 we should only dump the name of NODE, instead of its full declaration. */
2084 dump_ada_node (pretty_printer
*buffer
, tree node
, tree type
, int spc
,
2085 bool limited_access
, bool name_only
)
2087 if (node
== NULL_TREE
)
2090 switch (TREE_CODE (node
))
2093 pp_string (buffer
, "<<< error >>>");
2096 case IDENTIFIER_NODE
:
2097 pp_ada_tree_identifier (buffer
, node
, type
, limited_access
);
2101 pp_string (buffer
, "--- unexpected node: TREE_LIST");
2105 dump_ada_node (buffer
, BINFO_TYPE (node
), type
, spc
, limited_access
,
2110 pp_string (buffer
, "--- unexpected node: TREE_VEC");
2117 append_withs ("System", false);
2118 pp_string (buffer
, "System.Address");
2121 pp_string (buffer
, "address");
2125 pp_string (buffer
, "<vector>");
2129 if (is_float128 (TREE_TYPE (node
)))
2131 append_withs ("Interfaces.C.Extensions", false);
2132 pp_string (buffer
, "Extensions.CFloat_128");
2134 else if (TREE_TYPE (node
) == float_type_node
)
2136 append_withs ("Ada.Numerics.Complex_Types", false);
2137 pp_string (buffer
, "Ada.Numerics.Complex_Types.Complex");
2139 else if (TREE_TYPE (node
) == double_type_node
)
2141 append_withs ("Ada.Numerics.Long_Complex_Types", false);
2142 pp_string (buffer
, "Ada.Numerics.Long_Complex_Types.Complex");
2144 else if (TREE_TYPE (node
) == long_double_type_node
)
2146 append_withs ("Ada.Numerics.Long_Long_Complex_Types", false);
2147 pp_string (buffer
, "Ada.Numerics.Long_Long_Complex_Types.Complex");
2150 pp_string (buffer
, "<complex>");
2155 dump_ada_node (buffer
, TYPE_NAME (node
), node
, spc
, false, true);
2157 dump_ada_enum_type (buffer
, node
, type
, spc
);
2161 if (is_float32 (node
))
2163 pp_string (buffer
, "Float");
2166 else if (is_float64 (node
))
2168 pp_string (buffer
, "Long_Float");
2171 else if (is_float128 (node
))
2173 append_withs ("Interfaces.C.Extensions", false);
2174 pp_string (buffer
, "Extensions.Float_128");
2181 case FIXED_POINT_TYPE
:
2183 if (TYPE_NAME (node
)
2184 && !(TREE_CODE (TYPE_NAME (node
)) == TYPE_DECL
2185 && !strcmp (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (node
))),
2188 if (TREE_CODE (TYPE_NAME (node
)) == IDENTIFIER_NODE
)
2189 pp_ada_tree_identifier (buffer
, TYPE_NAME (node
), node
,
2191 else if (TREE_CODE (TYPE_NAME (node
)) == TYPE_DECL
2192 && DECL_NAME (TYPE_NAME (node
)))
2193 dump_ada_decl_name (buffer
, TYPE_NAME (node
), limited_access
);
2195 pp_string (buffer
, "<unnamed type>");
2197 else if (TREE_CODE (node
) == INTEGER_TYPE
)
2199 append_withs ("Interfaces.C.Extensions", false);
2200 bitfield_used
= true;
2202 if (TYPE_PRECISION (node
) == 1)
2203 pp_string (buffer
, "Extensions.Unsigned_1");
2206 pp_string (buffer
, TYPE_UNSIGNED (node
)
2207 ? "Extensions.Unsigned_"
2208 : "Extensions.Signed_");
2209 pp_decimal_int (buffer
, TYPE_PRECISION (node
));
2213 pp_string (buffer
, "<unnamed type>");
2217 case REFERENCE_TYPE
:
2218 if (name_only
&& TYPE_NAME (node
))
2219 dump_ada_node (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
,
2222 else if (TREE_CODE (TREE_TYPE (node
)) == FUNCTION_TYPE
)
2224 if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (node
))))
2225 pp_string (buffer
, "access procedure");
2227 pp_string (buffer
, "access function");
2229 dump_ada_function_declaration (buffer
, node
, false, false, false,
2232 /* If we are dumping the full type, it means we are part of a
2233 type definition and need also a Convention C aspect. */
2236 newline_and_indent (buffer
, spc
);
2237 pp_string (buffer
, "with Convention => C");
2242 tree ref_type
= TREE_TYPE (node
);
2243 const unsigned int quals
= TYPE_QUALS (ref_type
);
2246 if (VOID_TYPE_P (ref_type
))
2249 pp_string (buffer
, "new ");
2252 append_withs ("System", false);
2253 pp_string (buffer
, "System.Address");
2256 pp_string (buffer
, "address");
2260 if (TREE_CODE (node
) == POINTER_TYPE
2261 && TREE_CODE (ref_type
) == INTEGER_TYPE
2262 && id_equal (DECL_NAME (TYPE_NAME (ref_type
)), "char"))
2265 pp_string (buffer
, "new ");
2269 pp_string (buffer
, "Interfaces.C.Strings.chars_ptr");
2270 append_withs ("Interfaces.C.Strings", false);
2273 pp_string (buffer
, "chars_ptr");
2277 tree stub
= TYPE_STUB_DECL (ref_type
);
2278 tree type_name
= TYPE_NAME (ref_type
);
2280 /* For now, handle access-to-access as System.Address. */
2281 if (TREE_CODE (ref_type
) == POINTER_TYPE
)
2285 append_withs ("System", false);
2287 pp_string (buffer
, "new ");
2288 pp_string (buffer
, "System.Address");
2291 pp_string (buffer
, "address");
2295 if (!package_prefix
)
2298 pp_string (buffer
, "access");
2300 else if (AGGREGATE_TYPE_P (ref_type
))
2302 if (!type
|| TREE_CODE (type
) != FUNCTION_DECL
)
2305 pp_string (buffer
, "access ");
2307 if (quals
& TYPE_QUAL_CONST
)
2308 pp_string (buffer
, "constant ");
2309 else if (!name_only
)
2310 pp_string (buffer
, "all ");
2312 else if (quals
& TYPE_QUAL_CONST
)
2315 pp_string (buffer
, "in ");
2320 pp_string (buffer
, "access ");
2325 /* We want to use regular with clauses for scalar types,
2326 as they are not involved in circular declarations. */
2328 pp_string (buffer
, "access ");
2331 pp_string (buffer
, "all ");
2334 /* If this is the anonymous original type of a typedef'ed
2335 type, then use the name of the latter. */
2338 && DECL_CHAIN (stub
)
2339 && TREE_CODE (DECL_CHAIN (stub
)) == TYPE_DECL
2340 && DECL_ORIGINAL_TYPE (DECL_CHAIN (stub
)) == ref_type
)
2341 ref_type
= TREE_TYPE (DECL_CHAIN (stub
));
2343 /* If this is a pointer to an anonymous array type, then use
2344 the name of the component type. */
2345 else if (!type_name
&& is_access
)
2346 ref_type
= strip_array_types (ref_type
);
2348 /* Generate "access <type>" instead of "access <subtype>"
2349 if the subtype comes from another file, because subtype
2350 declarations do not contribute to the limited view of a
2351 package and thus subtypes cannot be referenced through
2352 a limited_with clause. */
2355 && TREE_CODE (type_name
) == TYPE_DECL
2356 && DECL_ORIGINAL_TYPE (type_name
)
2357 && TYPE_NAME (DECL_ORIGINAL_TYPE (type_name
)))
2359 const expanded_location xloc
2360 = expand_location (decl_sloc (type_name
, false));
2363 && xloc
.file
!= current_source_file
)
2365 ref_type
= DECL_ORIGINAL_TYPE (type_name
);
2366 type_name
= TYPE_NAME (ref_type
);
2372 dump_ada_node (buffer
, ref_type
, ref_type
, spc
, is_access
,
2381 dump_ada_node (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
,
2384 dump_ada_array_type (buffer
, node
, spc
);
2390 dump_ada_node (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
,
2393 dump_ada_structure (buffer
, node
, type
, false, spc
);
2397 /* We treat the upper half of the sizetype range as negative. This
2398 is consistent with the internal treatment and makes it possible
2399 to generate the (0 .. -1) range for flexible array members. */
2400 if (TREE_TYPE (node
) == sizetype
)
2401 node
= fold_convert (ssizetype
, node
);
2402 if (tree_fits_shwi_p (node
))
2403 pp_wide_integer (buffer
, tree_to_shwi (node
));
2404 else if (tree_fits_uhwi_p (node
))
2405 pp_unsigned_wide_integer (buffer
, tree_to_uhwi (node
));
2408 wide_int val
= wi::to_wide (node
);
2410 if (wi::neg_p (val
))
2415 sprintf (pp_buffer (buffer
)->digit_buffer
,
2416 "16#%" HOST_WIDE_INT_PRINT
"x",
2417 val
.elt (val
.get_len () - 1));
2418 for (i
= val
.get_len () - 2; i
>= 0; i
--)
2419 sprintf (pp_buffer (buffer
)->digit_buffer
,
2420 HOST_WIDE_INT_PRINT_PADDED_HEX
, val
.elt (i
));
2421 pp_string (buffer
, pp_buffer (buffer
)->digit_buffer
);
2433 if (DECL_IS_UNDECLARED_BUILTIN (node
))
2435 /* Don't print the declaration of built-in types. */
2438 /* If we're in the middle of a declaration, defaults to
2442 append_withs ("System", false);
2443 pp_string (buffer
, "System.Address");
2446 pp_string (buffer
, "address");
2450 dump_ada_decl_name (buffer
, node
, limited_access
);
2453 if (is_tagged_type (TREE_TYPE (node
)))
2457 /* Look for ancestors. */
2458 for (tree fld
= TYPE_FIELDS (TREE_TYPE (node
));
2460 fld
= TREE_CHAIN (fld
))
2462 if (!DECL_NAME (fld
) && is_tagged_type (TREE_TYPE (fld
)))
2466 pp_string (buffer
, "limited new ");
2470 pp_string (buffer
, " and ");
2472 dump_ada_decl_name (buffer
, TYPE_NAME (TREE_TYPE (fld
)),
2477 pp_string (buffer
, first
? "tagged limited " : " with ");
2479 else if (has_nontrivial_methods (TREE_TYPE (node
)))
2480 pp_string (buffer
, "limited ");
2482 dump_ada_node (buffer
, TREE_TYPE (node
), type
, spc
, false, false);
2491 case NAMESPACE_DECL
:
2492 dump_ada_decl_name (buffer
, node
, false);
2496 /* Ignore other nodes (e.g. expressions). */
2503 /* Dump in BUFFER NODE's methods. SPC is the indentation level. Return 1 if
2504 methods were printed, 0 otherwise. */
2507 dump_ada_methods (pretty_printer
*buffer
, tree node
, int spc
)
2509 if (!has_nontrivial_methods (node
))
2512 pp_semicolon (buffer
);
2515 for (tree fld
= TYPE_FIELDS (node
); fld
; fld
= DECL_CHAIN (fld
))
2516 if (TREE_CODE (fld
) == FUNCTION_DECL
)
2520 pp_newline (buffer
);
2521 pp_newline (buffer
);
2524 res
= dump_ada_declaration (buffer
, fld
, node
, spc
);
2530 /* Dump in BUFFER a forward declaration for TYPE present inside T.
2531 SPC is the indentation level. */
2534 dump_forward_type (pretty_printer
*buffer
, tree type
, tree t
, int spc
)
2536 tree decl
= get_underlying_decl (type
);
2538 /* Anonymous pointer and function types. */
2541 if (TREE_CODE (type
) == POINTER_TYPE
)
2542 dump_forward_type (buffer
, TREE_TYPE (type
), t
, spc
);
2543 else if (TREE_CODE (type
) == FUNCTION_TYPE
)
2545 function_args_iterator args_iter
;
2547 dump_forward_type (buffer
, TREE_TYPE (type
), t
, spc
);
2548 FOREACH_FUNCTION_ARGS (type
, arg
, args_iter
)
2549 dump_forward_type (buffer
, arg
, t
, spc
);
2554 if (DECL_IS_UNDECLARED_BUILTIN (decl
) || TREE_VISITED (decl
))
2557 /* Forward declarations are only needed within a given file. */
2558 if (DECL_SOURCE_FILE (decl
) != DECL_SOURCE_FILE (t
))
2561 if (TREE_CODE (type
) == FUNCTION_TYPE
)
2564 /* Generate an incomplete type declaration. */
2565 pp_string (buffer
, "type ");
2566 dump_ada_node (buffer
, decl
, NULL_TREE
, spc
, false, true);
2567 pp_semicolon (buffer
);
2568 newline_and_indent (buffer
, spc
);
2570 /* Only one incomplete declaration is legal for a given type. */
2571 TREE_VISITED (decl
) = 1;
2574 /* Bitmap of anonymous types already dumped. Anonymous array types are shared
2575 throughout the compilation so it needs to be global. */
2577 static bitmap dumped_anonymous_types
;
2579 static void dump_nested_type (pretty_printer
*, tree
, tree
, int);
2581 /* Dump in BUFFER anonymous types nested inside T's definition. PARENT is the
2582 parent node of T. DUMPED_TYPES is the bitmap of already dumped types. SPC
2583 is the indentation level.
2585 In C anonymous nested tagged types have no name whereas in C++ they have
2586 one. In C their TYPE_DECL is at top level whereas in C++ it is nested.
2587 In both languages untagged types (pointers and arrays) have no name.
2588 In C++ the nested TYPE_DECLs can come after their associated FIELD_DECL.
2590 Therefore, in order to have a common processing for both languages, we
2591 disregard anonymous TYPE_DECLs at top level and here we make a first
2592 pass on the nested TYPE_DECLs and a second pass on the unnamed types. */
2595 dump_nested_types (pretty_printer
*buffer
, tree t
, int spc
)
2599 /* Find possible anonymous pointers/arrays/structs/unions recursively. */
2600 type
= TREE_TYPE (t
);
2604 for (field
= TYPE_FIELDS (type
); field
; field
= TREE_CHAIN (field
))
2605 if (TREE_CODE (field
) == TYPE_DECL
2606 && DECL_NAME (field
) != DECL_NAME (t
)
2607 && !DECL_ORIGINAL_TYPE (field
)
2608 && TYPE_NAME (TREE_TYPE (field
)) != TYPE_NAME (type
))
2609 dump_nested_type (buffer
, field
, t
, spc
);
2611 for (field
= TYPE_FIELDS (type
); field
; field
= TREE_CHAIN (field
))
2612 if (TREE_CODE (field
) == FIELD_DECL
&& !TYPE_NAME (TREE_TYPE (field
)))
2613 dump_nested_type (buffer
, field
, t
, spc
);
2616 /* Dump in BUFFER the anonymous type of FIELD inside T. SPC is the indentation
2620 dump_nested_type (pretty_printer
*buffer
, tree field
, tree t
, int spc
)
2622 tree field_type
= TREE_TYPE (field
);
2625 switch (TREE_CODE (field_type
))
2628 tmp
= TREE_TYPE (field_type
);
2629 dump_forward_type (buffer
, tmp
, t
, spc
);
2633 /* Anonymous array types are shared. */
2634 if (!bitmap_set_bit (dumped_anonymous_types
, TYPE_UID (field_type
)))
2637 tmp
= strip_array_types (field_type
);
2638 decl
= get_underlying_decl (tmp
);
2640 && !DECL_NAME (decl
)
2641 && DECL_SOURCE_FILE (decl
) == DECL_SOURCE_FILE (t
)
2642 && !TREE_VISITED (decl
))
2644 /* Generate full declaration. */
2645 dump_nested_type (buffer
, decl
, t
, spc
);
2646 TREE_VISITED (decl
) = 1;
2648 else if (!decl
&& TREE_CODE (tmp
) == POINTER_TYPE
)
2649 dump_forward_type (buffer
, TREE_TYPE (tmp
), t
, spc
);
2651 /* Special case char arrays. */
2652 if (is_char_array (field_type
))
2653 pp_string (buffer
, "subtype ");
2655 pp_string (buffer
, "type ");
2657 dump_anonymous_type_name (buffer
, field_type
);
2658 pp_string (buffer
, " is ");
2659 dump_ada_array_type (buffer
, field_type
, spc
);
2660 pp_semicolon (buffer
);
2661 newline_and_indent (buffer
, spc
);
2665 if (is_simple_enum (field_type
))
2666 pp_string (buffer
, "type ");
2668 pp_string (buffer
, "subtype ");
2670 if (TYPE_NAME (field_type
))
2671 dump_ada_node (buffer
, field_type
, NULL_TREE
, spc
, false, true);
2673 dump_anonymous_type_name (buffer
, field_type
);
2674 pp_string (buffer
, " is ");
2675 dump_ada_enum_type (buffer
, field_type
, NULL_TREE
, spc
);
2676 pp_semicolon (buffer
);
2677 newline_and_indent (buffer
, spc
);
2682 dump_nested_types (buffer
, field
, spc
);
2684 pp_string (buffer
, "type ");
2686 if (TYPE_NAME (field_type
))
2687 dump_ada_node (buffer
, field_type
, NULL_TREE
, spc
, false, true);
2689 dump_anonymous_type_name (buffer
, field_type
);
2691 if (TREE_CODE (field_type
) == UNION_TYPE
)
2692 pp_string (buffer
, " (discr : unsigned := 0)");
2694 pp_string (buffer
, " is ");
2695 dump_ada_structure (buffer
, field_type
, t
, true, spc
);
2696 pp_semicolon (buffer
);
2697 newline_and_indent (buffer
, spc
);
2705 /* Hash table of overloaded names that we cannot support. It is needed even
2706 in Ada 2012 because we merge different types, e.g. void * and const void *
2707 in System.Address, so we cannot have overloading for them in Ada. */
2709 struct overloaded_name_hash
{
2715 struct overloaded_name_hasher
: delete_ptr_hash
<overloaded_name_hash
>
2717 static inline hashval_t
hash (overloaded_name_hash
*t
)
2719 static inline bool equal (overloaded_name_hash
*a
, overloaded_name_hash
*b
)
2720 { return a
->name
== b
->name
; }
2723 typedef hash_table
<overloaded_name_hasher
> htable_t
;
2725 static htable_t
*overloaded_names
;
2727 /* Add an overloaded NAME with N occurrences to TABLE. */
2730 add_name (const char *name
, unsigned int n
, htable_t
*table
)
2732 struct overloaded_name_hash in
, *h
, **slot
;
2733 tree id
= get_identifier (name
);
2734 hashval_t hash
= htab_hash_pointer (id
);
2737 slot
= table
->find_slot_with_hash (&in
, hash
, INSERT
);
2738 h
= new overloaded_name_hash
;
2745 /* Initialize the table with the problematic overloaded names. */
2748 init_overloaded_names (void)
2750 static const char *names
[] =
2751 /* The overloaded names from the /usr/include/string.h file. */
2752 { "memchr", "rawmemchr", "memrchr", "strchr", "strrchr", "strchrnul",
2753 "strpbrk", "strstr", "strcasestr", "index", "rindex", "basename" };
2755 htable_t
*table
= new htable_t (64);
2757 for (unsigned int i
= 0; i
< ARRAY_SIZE (names
); i
++)
2758 add_name (names
[i
], 0, table
);
2760 /* Consider that sigaction() is overloaded by struct sigaction for QNX. */
2761 add_name ("sigaction", 1, table
);
2763 /* Consider that stat() is overloaded by struct stat for QNX. */
2764 add_name ("stat", 1, table
);
2769 /* Return the overloading index of NAME or 0 if NAME is not overloaded. */
2772 overloading_index (tree name
)
2774 struct overloaded_name_hash in
, *h
;
2775 hashval_t hash
= htab_hash_pointer (name
);
2778 h
= overloaded_names
->find_with_hash (&in
, hash
);
2779 return h
? ++h
->n
: 0;
2782 /* Dump in BUFFER constructor spec corresponding to T for TYPE. */
2785 print_constructor (pretty_printer
*buffer
, tree t
, tree type
)
2787 tree decl_name
= DECL_NAME (TYPE_NAME (type
));
2789 pp_string (buffer
, "New_");
2790 pp_ada_tree_identifier (buffer
, decl_name
, t
, false);
2793 /* Dump in BUFFER destructor spec corresponding to T. */
2796 print_destructor (pretty_printer
*buffer
, tree t
, tree type
)
2798 tree decl_name
= DECL_NAME (TYPE_NAME (type
));
2800 pp_string (buffer
, "Delete_");
2801 if (startswith (IDENTIFIER_POINTER (DECL_NAME (t
)), "__dt_del"))
2802 pp_string (buffer
, "And_Free_");
2803 pp_ada_tree_identifier (buffer
, decl_name
, t
, false);
2806 /* Dump in BUFFER assignment operator spec corresponding to T. */
2809 print_assignment_operator (pretty_printer
*buffer
, tree t
, tree type
)
2811 tree decl_name
= DECL_NAME (TYPE_NAME (type
));
2813 pp_string (buffer
, "Assign_");
2814 pp_ada_tree_identifier (buffer
, decl_name
, t
, false);
2817 /* Return the name of type T. */
2822 tree n
= TYPE_NAME (t
);
2824 if (TREE_CODE (n
) == IDENTIFIER_NODE
)
2825 return IDENTIFIER_POINTER (n
);
2827 return IDENTIFIER_POINTER (DECL_NAME (n
));
2830 /* Dump in BUFFER the declaration of object T of type TYPE in Ada syntax.
2831 SPC is the indentation level. Return 1 if a declaration was printed,
2835 dump_ada_declaration (pretty_printer
*buffer
, tree t
, tree type
, int spc
)
2837 bool is_var
= false;
2838 bool need_indent
= false;
2839 bool is_class
= false;
2840 tree name
= TYPE_NAME (TREE_TYPE (t
));
2841 tree decl_name
= DECL_NAME (t
);
2842 tree orig
= NULL_TREE
;
2844 if (cpp_check
&& cpp_check (t
, IS_TEMPLATE
))
2845 return dump_ada_template (buffer
, t
, spc
);
2847 /* Skip enumeral values: will be handled as part of the type itself. */
2848 if (TREE_CODE (t
) == CONST_DECL
&& TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
)
2851 if (TREE_CODE (t
) == TYPE_DECL
)
2853 orig
= DECL_ORIGINAL_TYPE (t
);
2855 /* This is a typedef. */
2856 if (orig
&& TYPE_STUB_DECL (orig
))
2858 tree stub
= TYPE_STUB_DECL (orig
);
2860 /* If this is a typedef of a named type, then output it as a subtype
2861 declaration. ??? Use a derived type declaration instead. */
2862 if (TYPE_NAME (orig
))
2864 /* If the types have the same name (ignoring casing), then ignore
2865 the second type, but forward declare the first if need be. */
2866 if (type_name (orig
) == type_name (TREE_TYPE (t
))
2867 || !strcasecmp (type_name (orig
), type_name (TREE_TYPE (t
))))
2869 if (RECORD_OR_UNION_TYPE_P (orig
) && !TREE_VISITED (stub
))
2872 dump_forward_type (buffer
, orig
, t
, 0);
2875 TREE_VISITED (t
) = 1;
2881 if (RECORD_OR_UNION_TYPE_P (orig
) && !TREE_VISITED (stub
))
2882 dump_forward_type (buffer
, orig
, t
, spc
);
2884 pp_string (buffer
, "subtype ");
2885 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2886 pp_string (buffer
, " is ");
2887 dump_ada_node (buffer
, orig
, type
, spc
, false, true);
2888 pp_string (buffer
, "; -- ");
2889 dump_sloc (buffer
, t
);
2891 TREE_VISITED (t
) = 1;
2895 /* This is a typedef of an anonymous type. We'll output the full
2896 type declaration of the anonymous type with the typedef'ed name
2897 below. Prevent forward declarations for the anonymous type to
2898 be emitted from now on. */
2899 TREE_VISITED (stub
) = 1;
2902 /* Skip unnamed or anonymous structs/unions/enum types. */
2904 && (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
))
2905 || TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
)
2910 /* Skip duplicates of structs/unions/enum types built in C++. */
2912 && (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
))
2913 || TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
)
2915 && (*IDENTIFIER_POINTER (decl_name
) == '.'
2916 || *IDENTIFIER_POINTER (decl_name
) == '$'))
2921 switch (TREE_CODE (TREE_TYPE (t
)))
2925 if (!COMPLETE_TYPE_P (TREE_TYPE (t
)))
2927 pp_string (buffer
, "type ");
2928 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2929 pp_string (buffer
, " is null record; -- incomplete struct");
2930 TREE_VISITED (t
) = 1;
2934 /* Packed record layout is not fully supported. */
2935 if (TYPE_PACKED (TREE_TYPE (t
)))
2937 warning_at (DECL_SOURCE_LOCATION (t
), 0, "packed layout");
2938 pp_string (buffer
, "pragma Compile_Time_Warning (True, ");
2939 pp_string (buffer
, "\"packed layout may be incorrect\");");
2940 newline_and_indent (buffer
, spc
);
2941 packed_layout
= true;
2944 if (orig
&& TYPE_NAME (orig
))
2945 pp_string (buffer
, "subtype ");
2948 if (separate_class_package (t
))
2951 pp_string (buffer
, "package Class_");
2952 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2953 pp_string (buffer
, " is");
2955 newline_and_indent (buffer
, spc
);
2958 dump_nested_types (buffer
, t
, spc
);
2960 pp_string (buffer
, "type ");
2965 case REFERENCE_TYPE
:
2966 dump_forward_type (buffer
, TREE_TYPE (TREE_TYPE (t
)), t
, spc
);
2967 if (orig
&& TYPE_NAME (orig
))
2968 pp_string (buffer
, "subtype ");
2970 pp_string (buffer
, "type ");
2974 if ((orig
&& TYPE_NAME (orig
)) || is_char_array (TREE_TYPE (t
)))
2975 pp_string (buffer
, "subtype ");
2977 pp_string (buffer
, "type ");
2981 pp_string (buffer
, "-- skipped function type ");
2982 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2986 if ((orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
2987 || !is_simple_enum (TREE_TYPE (t
)))
2988 pp_string (buffer
, "subtype ");
2990 pp_string (buffer
, "type ");
2994 pp_string (buffer
, "subtype ");
2997 TREE_VISITED (t
) = 1;
3003 && *IDENTIFIER_POINTER (decl_name
) == '_')
3009 /* Print the type and name. */
3010 if (TREE_CODE (TREE_TYPE (t
)) == ARRAY_TYPE
)
3015 /* Print variable's name. */
3016 dump_ada_node (buffer
, t
, type
, spc
, false, true);
3018 if (TREE_CODE (t
) == TYPE_DECL
)
3020 pp_string (buffer
, " is ");
3022 if (orig
&& TYPE_NAME (orig
))
3023 dump_ada_node (buffer
, TYPE_NAME (orig
), type
, spc
, false, true);
3025 dump_ada_array_type (buffer
, TREE_TYPE (t
), spc
);
3029 if (spc
== INDENT_INCR
|| TREE_STATIC (t
))
3032 pp_string (buffer
, " : ");
3034 if (TREE_CODE (TREE_TYPE (TREE_TYPE (t
))) != POINTER_TYPE
3036 pp_string (buffer
, "aliased ");
3038 if (TYPE_NAME (TREE_TYPE (t
)))
3039 dump_ada_node (buffer
, TREE_TYPE (t
), type
, spc
, false, true);
3041 dump_anonymous_type_name (buffer
, TREE_TYPE (t
));
3043 dump_ada_array_type (buffer
, TREE_TYPE (t
), spc
);
3046 else if (TREE_CODE (t
) == FUNCTION_DECL
)
3048 tree decl_name
= DECL_NAME (t
);
3049 bool is_abstract_class
= false;
3050 bool is_method
= TREE_CODE (TREE_TYPE (t
)) == METHOD_TYPE
;
3051 bool is_abstract
= false;
3052 bool is_assignment_operator
= false;
3053 bool is_constructor
= false;
3054 bool is_destructor
= false;
3055 bool is_copy_constructor
= false;
3056 bool is_move_constructor
= false;
3063 is_abstract
= cpp_check (t
, IS_ABSTRACT
);
3064 is_assignment_operator
= cpp_check (t
, IS_ASSIGNMENT_OPERATOR
);
3065 is_constructor
= cpp_check (t
, IS_CONSTRUCTOR
);
3066 is_destructor
= cpp_check (t
, IS_DESTRUCTOR
);
3067 is_copy_constructor
= cpp_check (t
, IS_COPY_CONSTRUCTOR
);
3068 is_move_constructor
= cpp_check (t
, IS_MOVE_CONSTRUCTOR
);
3071 /* Skip copy constructors and C++11 move constructors: some are internal
3072 only and those that are not cannot be called easily from Ada. */
3073 if (is_copy_constructor
|| is_move_constructor
)
3076 if (is_constructor
|| is_destructor
)
3078 /* ??? Skip implicit constructors/destructors for now. */
3079 if (DECL_ARTIFICIAL (t
))
3082 /* Only consider complete constructors and deleting destructors. */
3083 if (!startswith (IDENTIFIER_POINTER (decl_name
), "__ct_comp")
3084 && !startswith (IDENTIFIER_POINTER (decl_name
), "__dt_comp")
3085 && !startswith (IDENTIFIER_POINTER (decl_name
), "__dt_del"))
3089 else if (is_assignment_operator
)
3091 /* ??? Skip implicit or non-method assignment operators for now. */
3092 if (DECL_ARTIFICIAL (t
) || !is_method
)
3096 /* If this function has an entry in the vtable, we cannot omit it. */
3097 else if (!DECL_VINDEX (t
) && *IDENTIFIER_POINTER (decl_name
) == '_')
3100 pp_string (buffer
, "-- skipped func ");
3101 pp_string (buffer
, IDENTIFIER_POINTER (decl_name
));
3107 dump_forward_type (buffer
, TREE_TYPE (t
), t
, spc
);
3109 if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t
))) && !is_constructor
)
3110 pp_string (buffer
, "procedure ");
3112 pp_string (buffer
, "function ");
3115 print_constructor (buffer
, t
, type
);
3116 else if (is_destructor
)
3117 print_destructor (buffer
, t
, type
);
3118 else if (is_assignment_operator
)
3119 print_assignment_operator (buffer
, t
, type
);
3122 const unsigned int suffix
= overloading_index (decl_name
);
3123 pp_ada_tree_identifier (buffer
, decl_name
, t
, false);
3125 pp_decimal_int (buffer
, suffix
);
3128 dump_ada_function_declaration
3129 (buffer
, t
, is_method
, is_constructor
, is_destructor
, spc
);
3131 if (is_constructor
&& RECORD_OR_UNION_TYPE_P (type
))
3132 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= DECL_CHAIN (fld
))
3133 if (TREE_CODE (fld
) == FUNCTION_DECL
&& cpp_check (fld
, IS_ABSTRACT
))
3135 is_abstract_class
= true;
3139 if (is_abstract
|| is_abstract_class
)
3140 pp_string (buffer
, " is abstract");
3142 if (is_abstract
|| !DECL_ASSEMBLER_NAME (t
))
3144 pp_semicolon (buffer
);
3145 pp_string (buffer
, " -- ");
3146 dump_sloc (buffer
, t
);
3148 else if (is_constructor
)
3150 pp_semicolon (buffer
);
3151 pp_string (buffer
, " -- ");
3152 dump_sloc (buffer
, t
);
3154 newline_and_indent (buffer
, spc
);
3155 pp_string (buffer
, "pragma CPP_Constructor (");
3156 print_constructor (buffer
, t
, type
);
3157 pp_string (buffer
, ", \"");
3158 pp_asm_name (buffer
, t
);
3159 pp_string (buffer
, "\");");
3163 pp_string (buffer
, " -- ");
3164 dump_sloc (buffer
, t
);
3166 newline_and_indent (buffer
, spc
);
3167 dump_ada_import (buffer
, t
, spc
);
3172 else if (TREE_CODE (t
) == TYPE_DECL
&& !orig
)
3174 bool is_interface
= false;
3175 bool is_abstract_record
= false;
3177 /* Anonymous structs/unions. */
3178 dump_ada_node (buffer
, TREE_TYPE (t
), t
, spc
, false, true);
3180 if (TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
)
3181 pp_string (buffer
, " (discr : unsigned := 0)");
3183 pp_string (buffer
, " is ");
3185 /* Check whether we have an Ada interface compatible class.
3186 That is only have a vtable non-static data member and no
3187 non-abstract methods. */
3189 && RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
)))
3191 bool has_fields
= false;
3193 /* Check that there are no fields other than the virtual table. */
3194 for (tree fld
= TYPE_FIELDS (TREE_TYPE (t
));
3196 fld
= TREE_CHAIN (fld
))
3198 if (TREE_CODE (fld
) == FIELD_DECL
)
3200 if (!has_fields
&& DECL_VIRTUAL_P (fld
))
3201 is_interface
= true;
3203 is_interface
= false;
3206 else if (TREE_CODE (fld
) == FUNCTION_DECL
3207 && !DECL_ARTIFICIAL (fld
))
3209 if (cpp_check (fld
, IS_ABSTRACT
))
3210 is_abstract_record
= true;
3212 is_interface
= false;
3217 TREE_VISITED (t
) = 1;
3220 pp_string (buffer
, "limited interface -- ");
3221 dump_sloc (buffer
, t
);
3222 newline_and_indent (buffer
, spc
);
3223 pp_string (buffer
, "with Import => True,");
3224 newline_and_indent (buffer
, spc
+ 5);
3225 pp_string (buffer
, "Convention => CPP");
3227 dump_ada_methods (buffer
, TREE_TYPE (t
), spc
);
3231 if (is_abstract_record
)
3232 pp_string (buffer
, "abstract ");
3233 dump_ada_node (buffer
, t
, t
, spc
, false, false);
3241 if ((TREE_CODE (t
) == FIELD_DECL
|| VAR_P (t
))
3243 check_type_name_conflict (buffer
, t
);
3245 /* Print variable/type's name. */
3246 dump_ada_node (buffer
, t
, t
, spc
, false, true);
3248 if (TREE_CODE (t
) == TYPE_DECL
)
3250 const bool is_subtype
= TYPE_NAME (orig
);
3252 if (!is_subtype
&& TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
)
3253 pp_string (buffer
, " (discr : unsigned := 0)");
3255 pp_string (buffer
, " is ");
3257 dump_ada_node (buffer
, orig
, t
, spc
, false, is_subtype
);
3261 if (spc
== INDENT_INCR
|| TREE_STATIC (t
))
3264 pp_string (buffer
, " : ");
3266 if (TREE_CODE (TREE_TYPE (t
)) != POINTER_TYPE
3267 && (TYPE_NAME (TREE_TYPE (t
))
3268 || (TREE_CODE (TREE_TYPE (t
)) != INTEGER_TYPE
3269 && TREE_CODE (TREE_TYPE (t
)) != ENUMERAL_TYPE
))
3271 pp_string (buffer
, "aliased ");
3273 if (TREE_READONLY (t
) && TREE_CODE (t
) != FIELD_DECL
)
3274 pp_string (buffer
, "constant ");
3276 if (TYPE_NAME (TREE_TYPE (t
))
3277 || (!RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
))
3278 && TREE_CODE (TREE_TYPE (t
)) != ENUMERAL_TYPE
))
3279 dump_ada_node (buffer
, TREE_TYPE (t
), t
, spc
, false, true);
3281 dump_anonymous_type_name (buffer
, TREE_TYPE (t
));
3288 newline_and_indent (buffer
, spc
);
3289 pp_string (buffer
, "end;");
3290 newline_and_indent (buffer
, spc
);
3291 pp_string (buffer
, "use Class_");
3292 dump_ada_node (buffer
, t
, type
, spc
, false, true);
3293 pp_semicolon (buffer
);
3294 pp_newline (buffer
);
3296 /* All needed indentation/newline performed already, so return 0. */
3301 pp_string (buffer
, " -- ");
3302 dump_sloc (buffer
, t
);
3303 newline_and_indent (buffer
, spc
);
3304 dump_ada_import (buffer
, t
, spc
);
3309 pp_string (buffer
, "; -- ");
3310 dump_sloc (buffer
, t
);
3316 /* Dump in BUFFER a structure NODE of type TYPE in Ada syntax. If NESTED is
3317 true, it's an anonymous nested type. SPC is the indentation level. */
3320 dump_ada_structure (pretty_printer
*buffer
, tree node
, tree type
, bool nested
,
3323 const bool is_union
= (TREE_CODE (node
) == UNION_TYPE
);
3326 int field_spc
= spc
+ INDENT_INCR
;
3329 bitfield_used
= false;
3331 /* Print the contents of the structure. */
3332 pp_string (buffer
, "record");
3336 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
3337 pp_string (buffer
, "case discr is");
3338 field_spc
= spc
+ INDENT_INCR
* 3;
3341 pp_newline (buffer
);
3343 /* Print the non-static fields of the structure. */
3344 for (tree tmp
= TYPE_FIELDS (node
); tmp
; tmp
= TREE_CHAIN (tmp
))
3346 /* Add parent field if needed. */
3347 if (!DECL_NAME (tmp
))
3349 if (!is_tagged_type (TREE_TYPE (tmp
)))
3351 if (!TYPE_NAME (TREE_TYPE (tmp
)))
3352 dump_ada_declaration (buffer
, tmp
, type
, field_spc
);
3358 pp_string (buffer
, "parent : aliased ");
3361 sprintf (buf
, "field_%d : aliased ", field_num
+ 1);
3362 pp_string (buffer
, buf
);
3364 dump_ada_decl_name (buffer
, TYPE_NAME (TREE_TYPE (tmp
)),
3366 pp_semicolon (buffer
);
3369 pp_newline (buffer
);
3373 else if (TREE_CODE (tmp
) == FIELD_DECL
)
3375 /* Skip internal virtual table field. */
3376 if (!DECL_VIRTUAL_P (tmp
))
3380 if (TREE_CHAIN (tmp
)
3381 && TREE_TYPE (TREE_CHAIN (tmp
)) != node
3382 && TREE_CODE (TREE_CHAIN (tmp
)) != TYPE_DECL
)
3383 sprintf (buf
, "when %d =>", field_num
);
3385 sprintf (buf
, "when others =>");
3387 INDENT (spc
+ INDENT_INCR
* 2);
3388 pp_string (buffer
, buf
);
3389 pp_newline (buffer
);
3392 if (dump_ada_declaration (buffer
, tmp
, type
, field_spc
))
3394 pp_newline (buffer
);
3403 INDENT (spc
+ INDENT_INCR
);
3404 pp_string (buffer
, "end case;");
3405 pp_newline (buffer
);
3410 INDENT (spc
+ INDENT_INCR
);
3411 pp_string (buffer
, "null;");
3412 pp_newline (buffer
);
3416 pp_string (buffer
, "end record");
3418 newline_and_indent (buffer
, spc
);
3420 /* We disregard the methods for anonymous nested types. */
3421 if (has_nontrivial_methods (node
) && !nested
)
3423 pp_string (buffer
, "with Import => True,");
3424 newline_and_indent (buffer
, spc
+ 5);
3425 pp_string (buffer
, "Convention => CPP");
3428 pp_string (buffer
, "with Convention => C_Pass_By_Copy");
3433 newline_and_indent (buffer
, spc
+ 5);
3434 pp_string (buffer
, "Unchecked_Union => True");
3437 if (bitfield_used
|| packed_layout
)
3441 newline_and_indent (buffer
, spc
+ 5);
3442 pp_string (buffer
, "Pack => True");
3444 newline_and_indent (buffer
, spc
+ 5);
3445 sprintf (buf
, "Alignment => %d", TYPE_ALIGN (node
) / BITS_PER_UNIT
);
3446 pp_string (buffer
, buf
);
3447 bitfield_used
= false;
3448 packed_layout
= false;
3454 need_semicolon
= !dump_ada_methods (buffer
, node
, spc
);
3456 /* Print the static fields of the structure, if any. */
3457 for (tree tmp
= TYPE_FIELDS (node
); tmp
; tmp
= TREE_CHAIN (tmp
))
3459 if (VAR_P (tmp
) && DECL_NAME (tmp
))
3463 need_semicolon
= false;
3464 pp_semicolon (buffer
);
3466 pp_newline (buffer
);
3467 pp_newline (buffer
);
3468 dump_ada_declaration (buffer
, tmp
, type
, spc
);
3473 /* Dump all the declarations in SOURCE_FILE to an Ada spec.
3474 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3475 nodes for SOURCE_FILE. CHECK is used to perform C++ queries on nodes. */
3478 dump_ads (const char *source_file
,
3479 void (*collect_all_refs
)(const char *),
3480 int (*check
)(tree
, cpp_operation
))
3487 pkg_name
= get_ada_package (source_file
);
3489 /* Construct the .ads filename and package name. */
3490 ads_name
= xstrdup (pkg_name
);
3492 for (s
= ads_name
; *s
; s
++)
3498 ads_name
= reconcat (ads_name
, ads_name
, ".ads", NULL
);
3500 /* Write out the .ads file. */
3501 f
= fopen (ads_name
, "w");
3506 pp_needs_newline (&pp
) = true;
3507 pp
.buffer
->stream
= f
;
3509 /* Dump all relevant macros. */
3510 dump_ada_macros (&pp
, source_file
);
3512 /* Reset the table of withs for this file. */
3515 (*collect_all_refs
) (source_file
);
3517 /* Dump all references. */
3519 dump_ada_nodes (&pp
, source_file
);
3521 /* We require Ada 2012 syntax, so generate corresponding pragma. */
3522 fputs ("pragma Ada_2012;\n\n", f
);
3524 /* Disable style checks and warnings on unused entities since this file
3525 is auto-generated and always has a with clause for Interfaces.C. */
3526 fputs ("pragma Style_Checks (Off);\n", f
);
3527 fputs ("pragma Warnings (Off, \"-gnatwu\");\n\n", f
);
3532 fprintf (f
, "\npackage %s is\n\n", pkg_name
);
3533 pp_write_text_to_stream (&pp
);
3534 /* ??? need to free pp */
3535 fprintf (f
, "end %s;\n\n", pkg_name
);
3537 fputs ("pragma Style_Checks (On);\n", f
);
3538 fputs ("pragma Warnings (On, \"-gnatwu\");\n", f
);
3546 static const char **source_refs
= NULL
;
3547 static int source_refs_used
= 0;
3548 static int source_refs_allocd
= 0;
3550 /* Add an entry for FILENAME to the table SOURCE_REFS. */
3553 collect_source_ref (const char *filename
)
3560 if (source_refs_allocd
== 0)
3562 source_refs_allocd
= 1024;
3563 source_refs
= XNEWVEC (const char *, source_refs_allocd
);
3566 for (i
= 0; i
< source_refs_used
; i
++)
3567 if (filename
== source_refs
[i
])
3570 if (source_refs_used
== source_refs_allocd
)
3572 source_refs_allocd
*= 2;
3573 source_refs
= XRESIZEVEC (const char *, source_refs
, source_refs_allocd
);
3576 source_refs
[source_refs_used
++] = filename
;
3579 /* Main entry point: dump all Ada specs corresponding to SOURCE_REFS
3580 using callbacks COLLECT_ALL_REFS and CHECK.
3581 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3582 nodes for a given source file.
3583 CHECK is used to perform C++ queries on nodes, or NULL for the C
3587 dump_ada_specs (void (*collect_all_refs
)(const char *),
3588 int (*check
)(tree
, cpp_operation
))
3590 bitmap_obstack_initialize (NULL
);
3592 overloaded_names
= init_overloaded_names ();
3594 /* Iterate over the list of files to dump specs for. */
3595 for (int i
= 0; i
< source_refs_used
; i
++)
3597 dumped_anonymous_types
= BITMAP_ALLOC (NULL
);
3598 dump_ads (source_refs
[i
], collect_all_refs
, check
);
3599 BITMAP_FREE (dumped_anonymous_types
);
3602 /* Free various tables. */
3604 delete overloaded_names
;
3606 bitmap_obstack_release (NULL
);