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-2018 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"
27 #include "c-ada-spec.h"
28 #include "fold-const.h"
30 #include "diagnostic.h"
31 #include "stringpool.h"
34 /* Local functions, macros and variables. */
35 static int dump_ada_node (pretty_printer
*, tree
, tree
, int, bool, bool);
36 static int dump_ada_declaration (pretty_printer
*, tree
, tree
, int);
37 static void dump_ada_structure (pretty_printer
*, tree
, tree
, bool, int);
38 static char *to_ada_name (const char *, bool *);
40 #define INDENT(SPACE) \
41 do { int i; for (i = 0; i<SPACE; i++) pp_space (buffer); } while (0)
45 /* Global hook used to perform C++ queries on nodes. */
46 static int (*cpp_check
) (tree
, cpp_operation
) = NULL
;
48 /* Global variables used in macro-related callbacks. */
49 static int max_ada_macros
;
50 static int store_ada_macro_index
;
51 static const char *macro_source_file
;
53 /* Given a cpp MACRO, compute the max length BUFFER_LEN of the macro, as well
54 as max length PARAM_LEN of arguments for fun_like macros, and also set
55 SUPPORTED to 0 if the macro cannot be mapped to an Ada construct. */
58 macro_length (const cpp_macro
*macro
, int *supported
, int *buffer_len
,
71 for (i
= 0; i
< macro
->paramc
; i
++)
73 cpp_hashnode
*param
= macro
->parm
.params
[i
];
75 *param_len
+= NODE_LEN (param
);
77 if (i
+ 1 < macro
->paramc
)
79 *param_len
+= 2; /* ", " */
81 else if (macro
->variadic
)
87 *param_len
+= 2; /* ")\0" */
90 for (j
= 0; j
< macro
->count
; j
++)
92 const cpp_token
*token
= ¯o
->exp
.tokens
[j
];
94 if (token
->flags
& PREV_WHITE
)
97 if (token
->flags
& STRINGIFY_ARG
|| token
->flags
& PASTE_LEFT
)
103 if (token
->type
== CPP_MACRO_ARG
)
105 NODE_LEN (macro
->parm
.params
[token
->val
.macro_arg
.arg_no
- 1]);
107 /* Include enough extra space to handle e.g. special characters. */
108 *buffer_len
+= (cpp_token_len (token
) + 1) * 8;
114 /* Dump all digits/hex chars from NUMBER to BUFFER and return a pointer
115 to the character after the last character written. If FLOAT_P is true,
116 this is a floating-point number. */
118 static unsigned char *
119 dump_number (unsigned char *number
, unsigned char *buffer
, bool float_p
)
121 while (*number
!= '\0'
122 && *number
!= (float_p
? 'F' : 'U')
123 && *number
!= (float_p
? 'f' : 'u')
126 *buffer
++ = *number
++;
131 /* Handle escape character C and convert to an Ada character into BUFFER.
132 Return a pointer to the character after the last character written, or
133 NULL if the escape character is not supported. */
135 static unsigned char *
136 handle_escape_character (unsigned char *buffer
, char c
)
146 strcpy ((char *) buffer
, "\" & ASCII.LF & \"");
151 strcpy ((char *) buffer
, "\" & ASCII.CR & \"");
156 strcpy ((char *) buffer
, "\" & ASCII.HT & \"");
167 /* Callback used to count the number of macros from cpp_forall_identifiers.
168 PFILE and V are not used. NODE is the current macro to consider. */
171 count_ada_macro (cpp_reader
*pfile ATTRIBUTE_UNUSED
, cpp_hashnode
*node
,
172 void *v ATTRIBUTE_UNUSED
)
174 if (cpp_user_macro_p (node
) && *NODE_NAME (node
) != '_')
176 const cpp_macro
*macro
= node
->value
.macro
;
177 if (macro
->count
&& LOCATION_FILE (macro
->line
) == macro_source_file
)
184 /* Callback used to store relevant macros from cpp_forall_identifiers.
185 PFILE is not used. NODE is the current macro to store if relevant.
186 MACROS is an array of cpp_hashnode* used to store NODE. */
189 store_ada_macro (cpp_reader
*pfile ATTRIBUTE_UNUSED
,
190 cpp_hashnode
*node
, void *macros
)
192 if (cpp_user_macro_p (node
) && *NODE_NAME (node
) != '_')
194 const cpp_macro
*macro
= node
->value
.macro
;
196 && LOCATION_FILE (macro
->line
) == macro_source_file
)
197 ((cpp_hashnode
**) macros
)[store_ada_macro_index
++] = node
;
202 /* Callback used to compare (during qsort) macros. NODE1 and NODE2 are the
203 two macro nodes to compare. */
206 compare_macro (const void *node1
, const void *node2
)
208 typedef const cpp_hashnode
*const_hnode
;
210 const_hnode n1
= *(const const_hnode
*) node1
;
211 const_hnode n2
= *(const const_hnode
*) node2
;
213 return n1
->value
.macro
->line
- n2
->value
.macro
->line
;
216 /* Dump in PP all relevant macros appearing in FILE. */
219 dump_ada_macros (pretty_printer
*pp
, const char* file
)
221 int num_macros
= 0, prev_line
= -1;
222 cpp_hashnode
**macros
;
224 /* Initialize file-scope variables. */
226 store_ada_macro_index
= 0;
227 macro_source_file
= file
;
229 /* Count all potentially relevant macros, and then sort them by sloc. */
230 cpp_forall_identifiers (parse_in
, count_ada_macro
, NULL
);
231 macros
= XALLOCAVEC (cpp_hashnode
*, max_ada_macros
);
232 cpp_forall_identifiers (parse_in
, store_ada_macro
, macros
);
233 qsort (macros
, max_ada_macros
, sizeof (cpp_hashnode
*), compare_macro
);
235 for (int j
= 0; j
< max_ada_macros
; j
++)
237 cpp_hashnode
*node
= macros
[j
];
238 const cpp_macro
*macro
= node
->value
.macro
;
240 int supported
= 1, prev_is_one
= 0, buffer_len
, param_len
;
241 int is_string
= 0, is_char
= 0;
243 unsigned char *s
, *params
, *buffer
, *buf_param
, *char_one
= NULL
, *tmp
;
245 macro_length (macro
, &supported
, &buffer_len
, ¶m_len
);
246 s
= buffer
= XALLOCAVEC (unsigned char, buffer_len
);
247 params
= buf_param
= XALLOCAVEC (unsigned char, param_len
);
254 for (i
= 0; i
< macro
->paramc
; i
++)
256 cpp_hashnode
*param
= macro
->parm
.params
[i
];
258 memcpy (buf_param
, NODE_NAME (param
), NODE_LEN (param
));
259 buf_param
+= NODE_LEN (param
);
261 if (i
+ 1 < macro
->paramc
)
266 else if (macro
->variadic
)
276 for (i
= 0; supported
&& i
< macro
->count
; i
++)
278 const cpp_token
*token
= ¯o
->exp
.tokens
[i
];
281 if (token
->flags
& PREV_WHITE
)
284 if (token
->flags
& STRINGIFY_ARG
|| token
->flags
& PASTE_LEFT
)
294 cpp_hashnode
*param
=
295 macro
->parm
.params
[token
->val
.macro_arg
.arg_no
- 1];
296 memcpy (buffer
, NODE_NAME (param
), NODE_LEN (param
));
297 buffer
+= NODE_LEN (param
);
301 case CPP_EQ_EQ
: *buffer
++ = '='; break;
302 case CPP_GREATER
: *buffer
++ = '>'; break;
303 case CPP_LESS
: *buffer
++ = '<'; break;
304 case CPP_PLUS
: *buffer
++ = '+'; break;
305 case CPP_MINUS
: *buffer
++ = '-'; break;
306 case CPP_MULT
: *buffer
++ = '*'; break;
307 case CPP_DIV
: *buffer
++ = '/'; break;
308 case CPP_COMMA
: *buffer
++ = ','; break;
309 case CPP_OPEN_SQUARE
:
310 case CPP_OPEN_PAREN
: *buffer
++ = '('; break;
311 case CPP_CLOSE_SQUARE
: /* fallthrough */
312 case CPP_CLOSE_PAREN
: *buffer
++ = ')'; break;
313 case CPP_DEREF
: /* fallthrough */
314 case CPP_SCOPE
: /* fallthrough */
315 case CPP_DOT
: *buffer
++ = '.'; break;
317 case CPP_EQ
: *buffer
++ = ':'; *buffer
++ = '='; break;
318 case CPP_NOT_EQ
: *buffer
++ = '/'; *buffer
++ = '='; break;
319 case CPP_GREATER_EQ
: *buffer
++ = '>'; *buffer
++ = '='; break;
320 case CPP_LESS_EQ
: *buffer
++ = '<'; *buffer
++ = '='; break;
323 *buffer
++ = 'n'; *buffer
++ = 'o'; *buffer
++ = 't'; break;
325 *buffer
++ = 'm'; *buffer
++ = 'o'; *buffer
++ = 'd'; break;
327 *buffer
++ = 'a'; *buffer
++ = 'n'; *buffer
++ = 'd'; break;
329 *buffer
++ = 'o'; *buffer
++ = 'r'; break;
331 *buffer
++ = 'x'; *buffer
++ = 'o'; *buffer
++ = 'r'; break;
333 strcpy ((char *) buffer
, " and then ");
337 strcpy ((char *) buffer
, " or else ");
343 is_one
= prev_is_one
;
358 if (!macro
->fun_like
)
362 = cpp_spell_token (parse_in
, token
, buffer
, false);
374 const unsigned char *s
= token
->val
.str
.text
;
380 buffer
= handle_escape_character (buffer
, *s
);
399 c
= cpp_interpret_charconst (parse_in
, token
,
400 &chars_seen
, &ignored
);
401 if (c
>= 32 && c
<= 126)
404 *buffer
++ = (char) c
;
410 ((char *) buffer
, "Character'Val (%d)", (int) c
);
411 buffer
+= chars_seen
;
417 tmp
= cpp_token_as_text (parse_in
, token
);
437 buffer
= dump_number (tmp
+ 2, buffer
, false);
445 buffer
= dump_number (tmp
+ 2, buffer
, false);
450 /* Dump floating-point constant unmodified. */
451 if (strchr ((const char *)tmp
, '.'))
452 buffer
= dump_number (tmp
, buffer
, true);
458 = dump_number (tmp
+ 1, buffer
, false);
481 = dump_number (tmp
, buffer
,
482 strchr ((const char *)tmp
, '.'));
490 /* Replace "1 << N" by "2 ** N" */
517 case CPP_CLOSE_BRACE
:
521 case CPP_MINUS_MINUS
:
525 case CPP_HEADER_NAME
:
528 case CPP_OBJC_STRING
:
530 if (!macro
->fun_like
)
533 buffer
= cpp_spell_token (parse_in
, token
, buffer
, false);
537 prev_is_one
= is_one
;
544 if (macro
->fun_like
&& supported
)
546 char *start
= (char *) s
;
549 pp_string (pp
, " -- arg-macro: ");
551 if (*start
== '(' && buffer
[-1] == ')')
556 pp_string (pp
, "function ");
560 pp_string (pp
, "procedure ");
563 pp_string (pp
, (const char *) NODE_NAME (node
));
565 pp_string (pp
, (char *) params
);
567 pp_string (pp
, " -- ");
571 pp_string (pp
, "return ");
572 pp_string (pp
, start
);
576 pp_string (pp
, start
);
582 expanded_location sloc
= expand_location (macro
->line
);
584 if (sloc
.line
!= prev_line
+ 1 && prev_line
> 0)
588 prev_line
= sloc
.line
;
591 ada_name
= to_ada_name ((const char *) NODE_NAME (node
), NULL
);
592 pp_string (pp
, ada_name
);
594 pp_string (pp
, " : ");
597 pp_string (pp
, "aliased constant String");
599 pp_string (pp
, "aliased constant Character");
601 pp_string (pp
, "constant");
603 pp_string (pp
, " := ");
604 pp_string (pp
, (char *) s
);
607 pp_string (pp
, " & ASCII.NUL");
609 pp_string (pp
, "; -- ");
610 pp_string (pp
, sloc
.file
);
612 pp_scalar (pp
, "%d", sloc
.line
);
617 pp_string (pp
, " -- unsupported macro: ");
618 pp_string (pp
, (const char *) cpp_macro_definition (parse_in
, node
));
627 /* Current source file being handled. */
628 static const char *current_source_file
;
630 /* Return sloc of DECL, using sloc of last field if LAST is true. */
633 decl_sloc (const_tree decl
, bool last
)
637 /* Compare the declaration of struct-like types based on the sloc of their
638 last field (if LAST is true), so that more nested types collate before
640 if (TREE_CODE (decl
) == TYPE_DECL
641 && !DECL_ORIGINAL_TYPE (decl
)
642 && RECORD_OR_UNION_TYPE_P (TREE_TYPE (decl
))
643 && (field
= TYPE_FIELDS (TREE_TYPE (decl
))))
646 while (DECL_CHAIN (field
))
647 field
= DECL_CHAIN (field
);
648 return DECL_SOURCE_LOCATION (field
);
651 return DECL_SOURCE_LOCATION (decl
);
654 /* Compare two locations LHS and RHS. */
657 compare_location (location_t lhs
, location_t rhs
)
659 expanded_location xlhs
= expand_location (lhs
);
660 expanded_location xrhs
= expand_location (rhs
);
662 if (xlhs
.file
!= xrhs
.file
)
663 return filename_cmp (xlhs
.file
, xrhs
.file
);
665 if (xlhs
.line
!= xrhs
.line
)
666 return xlhs
.line
- xrhs
.line
;
668 if (xlhs
.column
!= xrhs
.column
)
669 return xlhs
.column
- xrhs
.column
;
674 /* Compare two declarations (LP and RP) by their source location. */
677 compare_node (const void *lp
, const void *rp
)
679 const_tree lhs
= *((const tree
*) lp
);
680 const_tree rhs
= *((const tree
*) rp
);
682 return compare_location (decl_sloc (lhs
, true), decl_sloc (rhs
, true));
685 /* Compare two comments (LP and RP) by their source location. */
688 compare_comment (const void *lp
, const void *rp
)
690 const cpp_comment
*lhs
= (const cpp_comment
*) lp
;
691 const cpp_comment
*rhs
= (const cpp_comment
*) rp
;
693 return compare_location (lhs
->sloc
, rhs
->sloc
);
696 static tree
*to_dump
= NULL
;
697 static int to_dump_count
= 0;
699 /* Collect a list of declarations from T relevant to SOURCE_FILE to be dumped
700 by a subsequent call to dump_ada_nodes. */
703 collect_ada_nodes (tree t
, const char *source_file
)
706 int i
= to_dump_count
;
708 /* Count the likely relevant nodes: do not dump builtins (they are irrelevant
709 in the context of bindings) and namespaces (we do not handle them properly
711 for (n
= t
; n
; n
= TREE_CHAIN (n
))
712 if (!DECL_IS_BUILTIN (n
)
713 && TREE_CODE (n
) != NAMESPACE_DECL
714 && LOCATION_FILE (decl_sloc (n
, false)) == source_file
)
717 /* Allocate sufficient storage for all nodes. */
718 to_dump
= XRESIZEVEC (tree
, to_dump
, to_dump_count
);
720 /* Store the relevant nodes. */
721 for (n
= t
; n
; n
= TREE_CHAIN (n
))
722 if (!DECL_IS_BUILTIN (n
)
723 && TREE_CODE (n
) != NAMESPACE_DECL
724 && LOCATION_FILE (decl_sloc (n
, false)) == source_file
)
728 /* Call back for walk_tree to clear the TREE_VISITED flag of TP. */
731 unmark_visited_r (tree
*tp
, int *walk_subtrees ATTRIBUTE_UNUSED
,
732 void *data ATTRIBUTE_UNUSED
)
734 if (TREE_VISITED (*tp
))
735 TREE_VISITED (*tp
) = 0;
742 /* Print a COMMENT to the output stream PP. */
745 print_comment (pretty_printer
*pp
, const char *comment
)
747 int len
= strlen (comment
);
748 char *str
= XALLOCAVEC (char, len
+ 1);
750 bool extra_newline
= false;
752 memcpy (str
, comment
, len
+ 1);
754 /* Trim C/C++ comment indicators. */
755 if (str
[len
- 2] == '*' && str
[len
- 1] == '/')
762 tok
= strtok (str
, "\n");
764 pp_string (pp
, " --");
767 tok
= strtok (NULL
, "\n");
769 /* Leave a blank line after multi-line comments. */
771 extra_newline
= true;
778 /* Dump nodes into PP relevant to SOURCE_FILE, as collected by previous calls
779 to collect_ada_nodes. */
782 dump_ada_nodes (pretty_printer
*pp
, const char *source_file
)
785 cpp_comment_table
*comments
;
787 /* Sort the table of declarations to dump by sloc. */
788 qsort (to_dump
, to_dump_count
, sizeof (tree
), compare_node
);
790 /* Fetch the table of comments. */
791 comments
= cpp_get_comments (parse_in
);
793 /* Sort the comments table by sloc. */
794 if (comments
->count
> 1)
795 qsort (comments
->entries
, comments
->count
, sizeof (cpp_comment
),
798 /* Interleave comments and declarations in line number order. */
802 /* Advance j until comment j is in this file. */
803 while (j
!= comments
->count
804 && LOCATION_FILE (comments
->entries
[j
].sloc
) != source_file
)
807 /* Advance j until comment j is not a duplicate. */
808 while (j
< comments
->count
- 1
809 && !compare_comment (&comments
->entries
[j
],
810 &comments
->entries
[j
+ 1]))
813 /* Write decls until decl i collates after comment j. */
814 while (i
!= to_dump_count
)
816 if (j
== comments
->count
817 || LOCATION_LINE (decl_sloc (to_dump
[i
], false))
818 < LOCATION_LINE (comments
->entries
[j
].sloc
))
820 current_source_file
= source_file
;
822 if (dump_ada_declaration (pp
, to_dump
[i
++], NULL_TREE
,
833 /* Write comment j, if there is one. */
834 if (j
!= comments
->count
)
835 print_comment (pp
, comments
->entries
[j
++].comment
);
837 } while (i
!= to_dump_count
|| j
!= comments
->count
);
839 /* Clear the TREE_VISITED flag over each subtree we've dumped. */
840 for (i
= 0; i
< to_dump_count
; i
++)
841 walk_tree (&to_dump
[i
], unmark_visited_r
, NULL
, NULL
);
843 /* Finalize the to_dump table. */
852 /* Dump a newline and indent BUFFER by SPC chars. */
855 newline_and_indent (pretty_printer
*buffer
, int spc
)
861 struct with
{ char *s
; const char *in_file
; bool limited
; };
862 static struct with
*withs
= NULL
;
863 static int withs_max
= 4096;
864 static int with_len
= 0;
866 /* Record a "with" clause on package S (a limited with if LIMITED_ACCESS is
867 true), if not already done. */
870 append_withs (const char *s
, bool limited_access
)
875 withs
= XNEWVEC (struct with
, withs_max
);
877 if (with_len
== withs_max
)
880 withs
= XRESIZEVEC (struct with
, withs
, withs_max
);
883 for (i
= 0; i
< with_len
; i
++)
884 if (!strcmp (s
, withs
[i
].s
)
885 && current_source_file
== withs
[i
].in_file
)
887 withs
[i
].limited
&= limited_access
;
891 withs
[with_len
].s
= xstrdup (s
);
892 withs
[with_len
].in_file
= current_source_file
;
893 withs
[with_len
].limited
= limited_access
;
897 /* Reset "with" clauses. */
900 reset_ada_withs (void)
907 for (i
= 0; i
< with_len
; i
++)
915 /* Dump "with" clauses in F. */
918 dump_ada_withs (FILE *f
)
922 fprintf (f
, "with Interfaces.C; use Interfaces.C;\n");
924 for (i
= 0; i
< with_len
; i
++)
926 (f
, "%swith %s;\n", withs
[i
].limited
? "limited " : "", withs
[i
].s
);
929 /* Return suitable Ada package name from FILE. */
932 get_ada_package (const char *file
)
940 s
= strstr (file
, "/include/");
944 base
= lbasename (file
);
946 if (ada_specs_parent
== NULL
)
949 plen
= strlen (ada_specs_parent
) + 1;
951 res
= XNEWVEC (char, plen
+ strlen (base
) + 1);
952 if (ada_specs_parent
!= NULL
) {
953 strcpy (res
, ada_specs_parent
);
957 for (i
= plen
; *base
; base
++, i
++)
969 res
[i
] = (i
== 0 || res
[i
- 1] == '.' || res
[i
- 1] == '_') ? 'u' : '_';
981 static const char *ada_reserved
[] = {
982 "abort", "abs", "abstract", "accept", "access", "aliased", "all", "and",
983 "array", "at", "begin", "body", "case", "constant", "declare", "delay",
984 "delta", "digits", "do", "else", "elsif", "end", "entry", "exception",
985 "exit", "for", "function", "generic", "goto", "if", "in", "interface", "is",
986 "limited", "loop", "mod", "new", "not", "null", "others", "out", "of", "or",
987 "overriding", "package", "pragma", "private", "procedure", "protected",
988 "raise", "range", "record", "rem", "renames", "requeue", "return", "reverse",
989 "select", "separate", "subtype", "synchronized", "tagged", "task",
990 "terminate", "then", "type", "until", "use", "when", "while", "with", "xor",
993 /* ??? would be nice to specify this list via a config file, so that users
994 can create their own dictionary of conflicts. */
995 static const char *c_duplicates
[] = {
996 /* system will cause troubles with System.Address. */
999 /* The following values have other definitions with same name/other
1005 "rl_readline_version",
1011 /* Return a declaration tree corresponding to TYPE. */
1014 get_underlying_decl (tree type
)
1019 /* type is a declaration. */
1025 type
= TYPE_MAIN_VARIANT (type
);
1027 /* type is a typedef. */
1028 if (TYPE_NAME (type
) && DECL_P (TYPE_NAME (type
)))
1029 return TYPE_NAME (type
);
1031 /* TYPE_STUB_DECL has been set for type. */
1032 if (TYPE_STUB_DECL (type
))
1033 return TYPE_STUB_DECL (type
);
1039 /* Return whether TYPE has static fields. */
1042 has_static_fields (const_tree type
)
1044 if (!type
|| !RECORD_OR_UNION_TYPE_P (type
))
1047 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= TREE_CHAIN (fld
))
1048 if (TREE_CODE (fld
) == VAR_DECL
&& DECL_NAME (fld
))
1054 /* Return whether TYPE corresponds to an Ada tagged type (has a dispatch
1058 is_tagged_type (const_tree type
)
1060 if (!type
|| !RECORD_OR_UNION_TYPE_P (type
))
1063 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= TREE_CHAIN (fld
))
1064 if (TREE_CODE (fld
) == FUNCTION_DECL
&& DECL_VINDEX (fld
))
1070 /* Return whether TYPE has non-trivial methods, i.e. methods that do something
1071 for the objects of TYPE. In C++, all classes have implicit special methods,
1072 e.g. constructors and destructors, but they can be trivial if the type is
1073 sufficiently simple. */
1076 has_nontrivial_methods (tree type
)
1078 if (!type
|| !RECORD_OR_UNION_TYPE_P (type
))
1081 /* Only C++ types can have methods. */
1085 /* A non-trivial type has non-trivial special methods. */
1086 if (!cpp_check (type
, IS_TRIVIAL
))
1089 /* If there are user-defined methods, they are deemed non-trivial. */
1090 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= DECL_CHAIN (fld
))
1091 if (TREE_CODE (fld
) == FUNCTION_DECL
&& !DECL_ARTIFICIAL (fld
))
1097 #define INDEX_LENGTH 8
1099 /* Generate a legal Ada name from a C/C++ NAME and return a malloc'ed string.
1100 SPACE_FOUND, if not NULL, is used to indicate whether a space was found in
1104 to_ada_name (const char *name
, bool *space_found
)
1107 const int len
= strlen (name
);
1110 char *s
= XNEWVEC (char, len
* 2 + 5);
1114 *space_found
= false;
1116 /* Add "c_" prefix if name is an Ada reserved word. */
1117 for (names
= ada_reserved
; *names
; names
++)
1118 if (!strcasecmp (name
, *names
))
1127 /* Add "c_" prefix if name is a potential case sensitive duplicate. */
1128 for (names
= c_duplicates
; *names
; names
++)
1129 if (!strcmp (name
, *names
))
1137 for (j
= 0; name
[j
] == '_'; j
++)
1142 else if (*name
== '.' || *name
== '$')
1152 /* Replace unsuitable characters for Ada identifiers. */
1153 for (; j
< len
; j
++)
1158 *space_found
= true;
1162 /* ??? missing some C++ operators. */
1166 if (name
[j
+ 1] == '=')
1181 if (name
[j
+ 1] == '=')
1199 s
[len2
++] = name
[j
] == '&' ? 'a' : name
[j
] == '|' ? 'o' : 'x';
1201 if (name
[j
+ 1] == '=')
1214 if (s
[len2
- 1] != '_')
1217 switch (name
[j
+ 1]) {
1220 switch (name
[j
- 1]) {
1221 case '+': s
[len2
++] = 'p'; break; /* + */
1222 case '-': s
[len2
++] = 'm'; break; /* - */
1223 case '*': s
[len2
++] = 't'; break; /* * */
1224 case '/': s
[len2
++] = 'd'; break; /* / */
1230 switch (name
[j
- 1]) {
1231 case '+': s
[len2
++] = 'p'; break; /* += */
1232 case '-': s
[len2
++] = 'm'; break; /* -= */
1233 case '*': s
[len2
++] = 't'; break; /* *= */
1234 case '/': s
[len2
++] = 'd'; break; /* /= */
1268 c
= name
[j
] == '<' ? 'l' : 'g';
1271 switch (name
[j
+ 1]) {
1297 if (len2
&& s
[len2
- 1] == '_')
1302 s
[len2
++] = name
[j
];
1305 if (s
[len2
- 1] == '_')
1313 /* Return true if DECL refers to a C++ class type for which a
1314 separate enclosing package has been or should be generated. */
1317 separate_class_package (tree decl
)
1319 tree type
= TREE_TYPE (decl
);
1320 return has_nontrivial_methods (type
) || has_static_fields (type
);
1323 static bool package_prefix
= true;
1325 /* Dump in BUFFER the name of an identifier NODE of type TYPE, following Ada
1326 syntax. LIMITED_ACCESS indicates whether NODE can be accessed through a
1327 limited 'with' clause rather than a regular 'with' clause. */
1330 pp_ada_tree_identifier (pretty_printer
*buffer
, tree node
, tree type
,
1331 bool limited_access
)
1333 const char *name
= IDENTIFIER_POINTER (node
);
1334 bool space_found
= false;
1335 char *s
= to_ada_name (name
, &space_found
);
1336 tree decl
= get_underlying_decl (type
);
1338 /* If the entity comes from another file, generate a package prefix. */
1341 expanded_location xloc
= expand_location (decl_sloc (decl
, false));
1343 if (xloc
.file
&& xloc
.line
)
1345 if (xloc
.file
!= current_source_file
)
1347 switch (TREE_CODE (type
))
1352 case FIXED_POINT_TYPE
:
1354 case REFERENCE_TYPE
:
1362 char *s1
= get_ada_package (xloc
.file
);
1363 append_withs (s1
, limited_access
);
1364 pp_string (buffer
, s1
);
1373 /* Generate the additional package prefix for C++ classes. */
1374 if (separate_class_package (decl
))
1376 pp_string (buffer
, "Class_");
1377 pp_string (buffer
, s
);
1385 if (!strcmp (s
, "short_int"))
1386 pp_string (buffer
, "short");
1387 else if (!strcmp (s
, "short_unsigned_int"))
1388 pp_string (buffer
, "unsigned_short");
1389 else if (!strcmp (s
, "unsigned_int"))
1390 pp_string (buffer
, "unsigned");
1391 else if (!strcmp (s
, "long_int"))
1392 pp_string (buffer
, "long");
1393 else if (!strcmp (s
, "long_unsigned_int"))
1394 pp_string (buffer
, "unsigned_long");
1395 else if (!strcmp (s
, "long_long_int"))
1396 pp_string (buffer
, "Long_Long_Integer");
1397 else if (!strcmp (s
, "long_long_unsigned_int"))
1401 append_withs ("Interfaces.C.Extensions", false);
1402 pp_string (buffer
, "Extensions.unsigned_long_long");
1405 pp_string (buffer
, "unsigned_long_long");
1408 pp_string(buffer
, s
);
1410 if (!strcmp (s
, "u_Bool") || !strcmp (s
, "bool"))
1414 append_withs ("Interfaces.C.Extensions", false);
1415 pp_string (buffer
, "Extensions.bool");
1418 pp_string (buffer
, "bool");
1421 pp_string(buffer
, s
);
1426 /* Dump in BUFFER the assembly name of T. */
1429 pp_asm_name (pretty_printer
*buffer
, tree t
)
1431 tree name
= DECL_ASSEMBLER_NAME (t
);
1432 char *ada_name
= XALLOCAVEC (char, IDENTIFIER_LENGTH (name
) + 1), *s
;
1433 const char *ident
= IDENTIFIER_POINTER (name
);
1435 for (s
= ada_name
; *ident
; ident
++)
1439 else if (*ident
!= '*')
1444 pp_string (buffer
, ada_name
);
1447 /* Dump in BUFFER the name of a DECL node if set, in Ada syntax.
1448 LIMITED_ACCESS indicates whether NODE can be accessed via a
1449 limited 'with' clause rather than a regular 'with' clause. */
1452 dump_ada_decl_name (pretty_printer
*buffer
, tree decl
, bool limited_access
)
1454 if (DECL_NAME (decl
))
1455 pp_ada_tree_identifier (buffer
, DECL_NAME (decl
), decl
, limited_access
);
1458 tree type_name
= TYPE_NAME (TREE_TYPE (decl
));
1462 pp_string (buffer
, "anon");
1463 if (TREE_CODE (decl
) == FIELD_DECL
)
1464 pp_scalar (buffer
, "%d", DECL_UID (decl
));
1466 pp_scalar (buffer
, "%d", TYPE_UID (TREE_TYPE (decl
)));
1468 else if (TREE_CODE (type_name
) == IDENTIFIER_NODE
)
1469 pp_ada_tree_identifier (buffer
, type_name
, decl
, limited_access
);
1473 /* Dump in BUFFER a name based on both T1 and T2 followed by a suffix. */
1476 dump_ada_double_name (pretty_printer
*buffer
, tree t1
, tree t2
)
1479 pp_ada_tree_identifier (buffer
, DECL_NAME (t1
), t1
, false);
1482 pp_string (buffer
, "anon");
1483 pp_scalar (buffer
, "%d", TYPE_UID (TREE_TYPE (t1
)));
1486 pp_underscore (buffer
);
1489 pp_ada_tree_identifier (buffer
, DECL_NAME (t2
), t2
, false);
1492 pp_string (buffer
, "anon");
1493 pp_scalar (buffer
, "%d", TYPE_UID (TREE_TYPE (t2
)));
1496 switch (TREE_CODE (TREE_TYPE (t2
)))
1499 pp_string (buffer
, "_array");
1502 pp_string (buffer
, "_enum");
1505 pp_string (buffer
, "_struct");
1508 pp_string (buffer
, "_union");
1511 pp_string (buffer
, "_unknown");
1516 /* Dump in BUFFER aspect Import on a given node T. SPC is the current
1517 indentation level. */
1520 dump_ada_import (pretty_printer
*buffer
, tree t
, int spc
)
1522 const char *name
= IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (t
));
1523 const bool is_stdcall
1524 = TREE_CODE (t
) == FUNCTION_DECL
1525 && lookup_attribute ("stdcall", TYPE_ATTRIBUTES (TREE_TYPE (t
)));
1527 pp_string (buffer
, "with Import => True, ");
1529 newline_and_indent (buffer
, spc
+ 5);
1532 pp_string (buffer
, "Convention => Stdcall, ");
1533 else if (name
[0] == '_' && name
[1] == 'Z')
1534 pp_string (buffer
, "Convention => CPP, ");
1536 pp_string (buffer
, "Convention => C, ");
1538 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_name (pretty_printer
*buffer
, tree t
)
1557 tree tmp
= TREE_TYPE (t
);
1559 while (TREE_CODE (tmp
) == POINTER_TYPE
&& !TYPE_NAME (tmp
))
1560 tmp
= TREE_TYPE (tmp
);
1562 if (TREE_CODE (tmp
) != FUNCTION_TYPE
)
1564 if (TREE_CODE (tmp
) == IDENTIFIER_NODE
)
1565 s
= IDENTIFIER_POINTER (tmp
);
1566 else if (!TYPE_NAME (tmp
))
1568 else if (TREE_CODE (TYPE_NAME (tmp
)) == IDENTIFIER_NODE
)
1569 s
= IDENTIFIER_POINTER (TYPE_NAME (tmp
));
1571 s
= IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp
)));
1573 if (!strcasecmp (IDENTIFIER_POINTER (DECL_NAME (t
)), s
))
1574 pp_string (buffer
, "the_");
1578 /* Dump in BUFFER a function declaration FUNC in Ada syntax.
1579 IS_METHOD indicates whether FUNC is a C++ method.
1580 IS_CONSTRUCTOR whether FUNC is a C++ constructor.
1581 IS_DESTRUCTOR whether FUNC is a C++ destructor.
1582 SPC is the current indentation level. */
1585 dump_ada_function_declaration (pretty_printer
*buffer
, tree func
,
1586 bool is_method
, bool is_constructor
,
1587 bool is_destructor
, int spc
)
1590 const tree node
= TREE_TYPE (func
);
1592 int num
= 0, num_args
= 0, have_args
= true, have_ellipsis
= false;
1594 /* Compute number of arguments. */
1595 arg
= TYPE_ARG_TYPES (node
);
1599 while (TREE_CHAIN (arg
) && arg
!= error_mark_node
)
1602 arg
= TREE_CHAIN (arg
);
1605 if (TREE_CODE (TREE_VALUE (arg
)) != VOID_TYPE
)
1608 have_ellipsis
= true;
1619 newline_and_indent (buffer
, spc
+ 1);
1624 pp_left_paren (buffer
);
1627 if (TREE_CODE (func
) == FUNCTION_DECL
)
1628 arg
= DECL_ARGUMENTS (func
);
1632 if (arg
== NULL_TREE
)
1635 arg
= TYPE_ARG_TYPES (node
);
1637 if (arg
&& TREE_CODE (TREE_VALUE (arg
)) == VOID_TYPE
)
1642 arg
= TREE_CHAIN (arg
);
1644 /* Print the argument names (if available) & types. */
1646 for (num
= 1; num
<= num_args
; num
++)
1650 if (DECL_NAME (arg
))
1652 check_name (buffer
, arg
);
1653 pp_ada_tree_identifier (buffer
, DECL_NAME (arg
), NULL_TREE
,
1655 pp_string (buffer
, " : ");
1659 sprintf (buf
, "arg%d : ", num
);
1660 pp_string (buffer
, buf
);
1663 dump_ada_node (buffer
, TREE_TYPE (arg
), node
, spc
, false, true);
1667 sprintf (buf
, "arg%d : ", num
);
1668 pp_string (buffer
, buf
);
1669 dump_ada_node (buffer
, TREE_VALUE (arg
), node
, spc
, false, true);
1672 /* If the type is a pointer to a tagged type, we need to differentiate
1673 virtual methods from the rest (non-virtual methods, static member
1674 or regular functions) and import only them as primitive operations,
1675 because they make up the virtual table which is mirrored on the Ada
1676 side by the dispatch table. So we add 'Class to the type of every
1677 parameter that is not the first one of a method which either has a
1678 slot in the virtual table or is a constructor. */
1680 && POINTER_TYPE_P (TREE_TYPE (arg
))
1681 && is_tagged_type (TREE_TYPE (TREE_TYPE (arg
)))
1682 && !(num
== 1 && is_method
&& (DECL_VINDEX (func
) || is_constructor
)))
1683 pp_string (buffer
, "'Class");
1685 arg
= TREE_CHAIN (arg
);
1689 pp_semicolon (buffer
);
1692 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
1700 pp_string (buffer
, " -- , ...");
1701 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
1705 pp_right_paren (buffer
);
1707 if (is_constructor
|| !VOID_TYPE_P (TREE_TYPE (node
)))
1709 pp_string (buffer
, " return ");
1710 tree type
= is_constructor
? DECL_CONTEXT (func
) : TREE_TYPE (node
);
1711 dump_ada_node (buffer
, type
, type
, spc
, false, true);
1715 /* Dump in BUFFER all the domains associated with an array NODE,
1716 in Ada syntax. SPC is the current indentation level. */
1719 dump_ada_array_domains (pretty_printer
*buffer
, tree node
, int spc
)
1722 pp_left_paren (buffer
);
1724 for (; TREE_CODE (node
) == ARRAY_TYPE
; node
= TREE_TYPE (node
))
1726 tree domain
= TYPE_DOMAIN (node
);
1730 tree min
= TYPE_MIN_VALUE (domain
);
1731 tree max
= TYPE_MAX_VALUE (domain
);
1734 pp_string (buffer
, ", ");
1738 dump_ada_node (buffer
, min
, NULL_TREE
, spc
, false, true);
1739 pp_string (buffer
, " .. ");
1741 /* If the upper bound is zero, gcc may generate a NULL_TREE
1742 for TYPE_MAX_VALUE rather than an integer_cst. */
1744 dump_ada_node (buffer
, max
, NULL_TREE
, spc
, false, true);
1746 pp_string (buffer
, "0");
1749 pp_string (buffer
, "size_t");
1751 pp_right_paren (buffer
);
1754 /* Dump in BUFFER file:line information related to NODE. */
1757 dump_sloc (pretty_printer
*buffer
, tree node
)
1759 expanded_location xloc
;
1764 xloc
= expand_location (DECL_SOURCE_LOCATION (node
));
1765 else if (EXPR_HAS_LOCATION (node
))
1766 xloc
= expand_location (EXPR_LOCATION (node
));
1770 pp_string (buffer
, xloc
.file
);
1772 pp_decimal_int (buffer
, xloc
.line
);
1776 /* Return true if type T designates a 1-dimension array of "char". */
1779 is_char_array (tree t
)
1783 while (TREE_CODE (t
) == ARRAY_TYPE
)
1790 && TREE_CODE (t
) == INTEGER_TYPE
1791 && id_equal (DECL_NAME (TYPE_NAME (t
)), "char");
1794 /* Dump in BUFFER an array type NODE of type TYPE in Ada syntax. SPC is the
1795 indentation level. */
1798 dump_ada_array_type (pretty_printer
*buffer
, tree node
, tree type
, int spc
)
1800 const bool char_array
= is_char_array (node
);
1802 /* Special case char arrays. */
1804 pp_string (buffer
, "Interfaces.C.char_array ");
1806 pp_string (buffer
, "array ");
1808 /* Print the dimensions. */
1809 dump_ada_array_domains (buffer
, node
, spc
);
1811 /* Print array's type. */
1814 /* Retrieve the element type. */
1816 while (TREE_CODE (tmp
) == ARRAY_TYPE
)
1817 tmp
= TREE_TYPE (tmp
);
1819 pp_string (buffer
, " of ");
1821 if (TREE_CODE (tmp
) != POINTER_TYPE
)
1822 pp_string (buffer
, "aliased ");
1824 if (TYPE_NAME (tmp
) || !RECORD_OR_UNION_TYPE_P (tmp
))
1825 dump_ada_node (buffer
, tmp
, node
, spc
, false, true);
1827 dump_ada_double_name (buffer
, type
, get_underlying_decl (tmp
));
1831 /* Dump in BUFFER type names associated with a template, each prepended with
1832 '_'. TYPES is the TREE_PURPOSE of a DECL_TEMPLATE_INSTANTIATIONS. SPC is
1833 the indentation level. */
1836 dump_template_types (pretty_printer
*buffer
, tree types
, int spc
)
1838 for (int i
= 0; i
< TREE_VEC_LENGTH (types
); i
++)
1840 tree elem
= TREE_VEC_ELT (types
, i
);
1841 pp_underscore (buffer
);
1843 if (!dump_ada_node (buffer
, elem
, NULL_TREE
, spc
, false, true))
1845 pp_string (buffer
, "unknown");
1846 pp_scalar (buffer
, "%lu", (unsigned long) TREE_HASH (elem
));
1851 /* Dump in BUFFER the contents of all class instantiations associated with
1852 a given template T. SPC is the indentation level. */
1855 dump_ada_template (pretty_printer
*buffer
, tree t
, int spc
)
1857 /* DECL_SIZE_UNIT is DECL_TEMPLATE_INSTANTIATIONS in this context. */
1858 tree inst
= DECL_SIZE_UNIT (t
);
1859 /* This emulates DECL_TEMPLATE_RESULT in this context. */
1860 struct tree_template_decl
{
1861 struct tree_decl_common common
;
1865 tree result
= ((struct tree_template_decl
*) t
)->result
;
1868 /* Don't look at template declarations declaring something coming from
1869 another file. This can occur for template friend declarations. */
1870 if (LOCATION_FILE (decl_sloc (result
, false))
1871 != LOCATION_FILE (decl_sloc (t
, false)))
1874 for (; inst
&& inst
!= error_mark_node
; inst
= TREE_CHAIN (inst
))
1876 tree types
= TREE_PURPOSE (inst
);
1877 tree instance
= TREE_VALUE (inst
);
1879 if (TREE_VEC_LENGTH (types
) == 0)
1882 if (!RECORD_OR_UNION_TYPE_P (instance
))
1885 /* We are interested in concrete template instantiations only: skip
1886 partially specialized nodes. */
1887 if (RECORD_OR_UNION_TYPE_P (instance
)
1889 && cpp_check (instance
, HAS_DEPENDENT_TEMPLATE_ARGS
))
1894 pp_string (buffer
, "package ");
1895 package_prefix
= false;
1896 dump_ada_node (buffer
, instance
, t
, spc
, false, true);
1897 dump_template_types (buffer
, types
, spc
);
1898 pp_string (buffer
, " is");
1900 newline_and_indent (buffer
, spc
);
1902 TREE_VISITED (get_underlying_decl (instance
)) = 1;
1903 pp_string (buffer
, "type ");
1904 dump_ada_node (buffer
, instance
, t
, spc
, false, true);
1905 package_prefix
= true;
1907 if (is_tagged_type (instance
))
1908 pp_string (buffer
, " is tagged limited ");
1910 pp_string (buffer
, " is limited ");
1912 dump_ada_node (buffer
, instance
, t
, spc
, false, false);
1913 pp_newline (buffer
);
1915 newline_and_indent (buffer
, spc
);
1917 pp_string (buffer
, "end;");
1918 newline_and_indent (buffer
, spc
);
1919 pp_string (buffer
, "use ");
1920 package_prefix
= false;
1921 dump_ada_node (buffer
, instance
, t
, spc
, false, true);
1922 dump_template_types (buffer
, types
, spc
);
1923 package_prefix
= true;
1924 pp_semicolon (buffer
);
1925 pp_newline (buffer
);
1926 pp_newline (buffer
);
1929 return num_inst
> 0;
1932 /* Return true if NODE is a simple enum types, that can be mapped to an
1933 Ada enum type directly. */
1936 is_simple_enum (tree node
)
1938 HOST_WIDE_INT count
= 0;
1940 for (tree value
= TYPE_VALUES (node
); value
; value
= TREE_CHAIN (value
))
1942 tree int_val
= TREE_VALUE (value
);
1944 if (TREE_CODE (int_val
) != INTEGER_CST
)
1945 int_val
= DECL_INITIAL (int_val
);
1947 if (!tree_fits_shwi_p (int_val
))
1949 else if (tree_to_shwi (int_val
) != count
)
1958 /* Dump in BUFFER an enumeral type NODE in Ada syntax. SPC is the indentation
1962 dump_ada_enum_type (pretty_printer
*buffer
, tree node
, 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");
1993 for (tree value
= TYPE_VALUES (node
); value
; value
= TREE_CHAIN (value
))
1995 pp_semicolon (buffer
);
1996 newline_and_indent (buffer
, spc
);
1998 pp_ada_tree_identifier (buffer
, TREE_PURPOSE (value
), node
, false);
1999 pp_string (buffer
, " : constant ");
2001 if (TYPE_UNSIGNED (node
))
2002 pp_string (buffer
, "unsigned");
2004 pp_string (buffer
, "int");
2006 pp_string (buffer
, " := ");
2007 dump_ada_node (buffer
,
2008 TREE_CODE (TREE_VALUE (value
)) == INTEGER_CST
2009 ? TREE_VALUE (value
)
2010 : DECL_INITIAL (TREE_VALUE (value
)),
2011 node
, spc
, false, true);
2016 static bool bitfield_used
= false;
2018 /* Recursively dump in BUFFER Ada declarations corresponding to NODE of type
2019 TYPE. SPC is the indentation level. LIMITED_ACCESS indicates whether NODE
2020 can be referenced via a "limited with" clause. NAME_ONLY indicates whether
2021 we should only dump the name of NODE, instead of its full declaration. */
2024 dump_ada_node (pretty_printer
*buffer
, tree node
, tree type
, int spc
,
2025 bool limited_access
, bool name_only
)
2027 if (node
== NULL_TREE
)
2030 switch (TREE_CODE (node
))
2033 pp_string (buffer
, "<<< error >>>");
2036 case IDENTIFIER_NODE
:
2037 pp_ada_tree_identifier (buffer
, node
, type
, limited_access
);
2041 pp_string (buffer
, "--- unexpected node: TREE_LIST");
2045 dump_ada_node (buffer
, BINFO_TYPE (node
), type
, spc
, limited_access
,
2050 pp_string (buffer
, "--- unexpected node: TREE_VEC");
2057 append_withs ("System", false);
2058 pp_string (buffer
, "System.Address");
2061 pp_string (buffer
, "address");
2065 pp_string (buffer
, "<vector>");
2069 pp_string (buffer
, "<complex>");
2074 dump_ada_node (buffer
, TYPE_NAME (node
), node
, spc
, false, true);
2076 dump_ada_enum_type (buffer
, node
, spc
);
2080 if (TYPE_NAME (node
)
2081 && TREE_CODE (TYPE_NAME (node
)) == TYPE_DECL
2082 && IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (node
))) [0] == '_'
2083 && (id_equal (DECL_NAME (TYPE_NAME (node
)), "_Float128")
2084 || id_equal (DECL_NAME (TYPE_NAME (node
)), "__float128")))
2086 append_withs ("Interfaces.C.Extensions", false);
2087 pp_string (buffer
, "Extensions.Float_128");
2093 case FIXED_POINT_TYPE
:
2095 if (TYPE_NAME (node
))
2097 if (TREE_CODE (TYPE_NAME (node
)) == IDENTIFIER_NODE
)
2098 pp_ada_tree_identifier (buffer
, TYPE_NAME (node
), node
,
2100 else if (TREE_CODE (TYPE_NAME (node
)) == TYPE_DECL
2101 && DECL_NAME (TYPE_NAME (node
)))
2102 dump_ada_decl_name (buffer
, TYPE_NAME (node
), limited_access
);
2104 pp_string (buffer
, "<unnamed type>");
2106 else if (TREE_CODE (node
) == INTEGER_TYPE
)
2108 append_withs ("Interfaces.C.Extensions", false);
2109 bitfield_used
= true;
2111 if (TYPE_PRECISION (node
) == 1)
2112 pp_string (buffer
, "Extensions.Unsigned_1");
2115 pp_string (buffer
, TYPE_UNSIGNED (node
)
2116 ? "Extensions.Unsigned_"
2117 : "Extensions.Signed_");
2118 pp_decimal_int (buffer
, TYPE_PRECISION (node
));
2122 pp_string (buffer
, "<unnamed type>");
2126 case REFERENCE_TYPE
:
2127 if (name_only
&& TYPE_NAME (node
))
2128 dump_ada_node (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
,
2131 else if (TREE_CODE (TREE_TYPE (node
)) == FUNCTION_TYPE
)
2133 if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (node
))))
2134 pp_string (buffer
, "access procedure");
2136 pp_string (buffer
, "access function");
2138 dump_ada_function_declaration (buffer
, node
, false, false, false,
2141 /* If we are dumping the full type, it means we are part of a
2142 type definition and need also a Convention C aspect. */
2145 newline_and_indent (buffer
, spc
);
2146 pp_string (buffer
, "with Convention => C");
2151 const unsigned int quals
= TYPE_QUALS (TREE_TYPE (node
));
2152 bool is_access
= false;
2154 if (VOID_TYPE_P (TREE_TYPE (node
)))
2157 pp_string (buffer
, "new ");
2160 append_withs ("System", false);
2161 pp_string (buffer
, "System.Address");
2164 pp_string (buffer
, "address");
2168 if (TREE_CODE (node
) == POINTER_TYPE
2169 && TREE_CODE (TREE_TYPE (node
)) == INTEGER_TYPE
2170 && id_equal (DECL_NAME (TYPE_NAME (TREE_TYPE (node
))),
2174 pp_string (buffer
, "new ");
2178 pp_string (buffer
, "Interfaces.C.Strings.chars_ptr");
2179 append_withs ("Interfaces.C.Strings", false);
2182 pp_string (buffer
, "chars_ptr");
2186 tree type_name
= TYPE_NAME (TREE_TYPE (node
));
2188 /* For now, handle access-to-access as System.Address. */
2189 if (TREE_CODE (TREE_TYPE (node
)) == POINTER_TYPE
)
2193 append_withs ("System", false);
2195 pp_string (buffer
, "new ");
2196 pp_string (buffer
, "System.Address");
2199 pp_string (buffer
, "address");
2203 if (!package_prefix
)
2204 pp_string (buffer
, "access");
2205 else if (AGGREGATE_TYPE_P (TREE_TYPE (node
)))
2207 if (!type
|| TREE_CODE (type
) != FUNCTION_DECL
)
2209 pp_string (buffer
, "access ");
2212 if (quals
& TYPE_QUAL_CONST
)
2213 pp_string (buffer
, "constant ");
2214 else if (!name_only
)
2215 pp_string (buffer
, "all ");
2217 else if (quals
& TYPE_QUAL_CONST
)
2218 pp_string (buffer
, "in ");
2222 pp_string (buffer
, "access ");
2223 /* ??? should be configurable: access or in out. */
2229 pp_string (buffer
, "access ");
2232 pp_string (buffer
, "all ");
2235 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node
)) && type_name
)
2236 dump_ada_node (buffer
, type_name
, TREE_TYPE (node
), spc
,
2239 dump_ada_node (buffer
, TREE_TYPE (node
), TREE_TYPE (node
),
2248 dump_ada_node (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
,
2251 dump_ada_array_type (buffer
, node
, type
, spc
);
2257 dump_ada_node (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
,
2260 dump_ada_structure (buffer
, node
, type
, false, spc
);
2264 /* We treat the upper half of the sizetype range as negative. This
2265 is consistent with the internal treatment and makes it possible
2266 to generate the (0 .. -1) range for flexible array members. */
2267 if (TREE_TYPE (node
) == sizetype
)
2268 node
= fold_convert (ssizetype
, node
);
2269 if (tree_fits_shwi_p (node
))
2270 pp_wide_integer (buffer
, tree_to_shwi (node
));
2271 else if (tree_fits_uhwi_p (node
))
2272 pp_unsigned_wide_integer (buffer
, tree_to_uhwi (node
));
2275 wide_int val
= wi::to_wide (node
);
2277 if (wi::neg_p (val
))
2282 sprintf (pp_buffer (buffer
)->digit_buffer
,
2283 "16#%" HOST_WIDE_INT_PRINT
"x",
2284 val
.elt (val
.get_len () - 1));
2285 for (i
= val
.get_len () - 2; i
>= 0; i
--)
2286 sprintf (pp_buffer (buffer
)->digit_buffer
,
2287 HOST_WIDE_INT_PRINT_PADDED_HEX
, val
.elt (i
));
2288 pp_string (buffer
, pp_buffer (buffer
)->digit_buffer
);
2300 if (DECL_IS_BUILTIN (node
))
2302 /* Don't print the declaration of built-in types. */
2305 /* If we're in the middle of a declaration, defaults to
2309 append_withs ("System", false);
2310 pp_string (buffer
, "System.Address");
2313 pp_string (buffer
, "address");
2319 dump_ada_decl_name (buffer
, node
, limited_access
);
2322 if (is_tagged_type (TREE_TYPE (node
)))
2326 /* Look for ancestors. */
2327 for (tree fld
= TYPE_FIELDS (TREE_TYPE (node
));
2329 fld
= TREE_CHAIN (fld
))
2331 if (!DECL_NAME (fld
) && is_tagged_type (TREE_TYPE (fld
)))
2335 pp_string (buffer
, "limited new ");
2339 pp_string (buffer
, " and ");
2341 dump_ada_decl_name (buffer
, TYPE_NAME (TREE_TYPE (fld
)),
2346 pp_string (buffer
, first
? "tagged limited " : " with ");
2348 else if (has_nontrivial_methods (TREE_TYPE (node
)))
2349 pp_string (buffer
, "limited ");
2351 dump_ada_node (buffer
, TREE_TYPE (node
), type
, spc
, false, false);
2360 case NAMESPACE_DECL
:
2361 dump_ada_decl_name (buffer
, node
, false);
2365 /* Ignore other nodes (e.g. expressions). */
2372 /* Dump in BUFFER NODE's methods. SPC is the indentation level. Return 1 if
2373 methods were printed, 0 otherwise. */
2376 dump_ada_methods (pretty_printer
*buffer
, tree node
, int spc
)
2378 if (!has_nontrivial_methods (node
))
2381 pp_semicolon (buffer
);
2384 for (tree fld
= TYPE_FIELDS (node
); fld
; fld
= DECL_CHAIN (fld
))
2385 if (TREE_CODE (fld
) == FUNCTION_DECL
)
2389 pp_newline (buffer
);
2390 pp_newline (buffer
);
2393 res
= dump_ada_declaration (buffer
, fld
, node
, spc
);
2399 /* Dump in BUFFER a forward declaration for TYPE present inside T.
2400 SPC is the indentation level. */
2403 dump_forward_type (pretty_printer
*buffer
, tree type
, tree t
, int spc
)
2405 tree decl
= get_underlying_decl (type
);
2407 /* Anonymous pointer and function types. */
2410 if (TREE_CODE (type
) == POINTER_TYPE
)
2411 dump_forward_type (buffer
, TREE_TYPE (type
), t
, spc
);
2412 else if (TREE_CODE (type
) == FUNCTION_TYPE
)
2414 function_args_iterator args_iter
;
2416 dump_forward_type (buffer
, TREE_TYPE (type
), t
, spc
);
2417 FOREACH_FUNCTION_ARGS (type
, arg
, args_iter
)
2418 dump_forward_type (buffer
, arg
, t
, spc
);
2423 if (DECL_IS_BUILTIN (decl
) || TREE_VISITED (decl
))
2426 /* Forward declarations are only needed within a given file. */
2427 if (DECL_SOURCE_FILE (decl
) != DECL_SOURCE_FILE (t
))
2430 /* Generate an incomplete type declaration. */
2431 pp_string (buffer
, "type ");
2432 dump_ada_node (buffer
, decl
, NULL_TREE
, spc
, false, true);
2433 pp_semicolon (buffer
);
2434 newline_and_indent (buffer
, spc
);
2436 /* Only one incomplete declaration is legal for a given type. */
2437 TREE_VISITED (decl
) = 1;
2440 static void dump_nested_type (pretty_printer
*, tree
, tree
, tree
, int);
2442 /* Dump in BUFFER anonymous types nested inside T's definition.
2443 PARENT is the parent node of T. SPC is the indentation level.
2445 In C anonymous nested tagged types have no name whereas in C++ they have
2446 one. In C their TYPE_DECL is at top level whereas in C++ it is nested.
2447 In both languages untagged types (pointers and arrays) have no name.
2448 In C++ the nested TYPE_DECLs can come after their associated FIELD_DECL.
2450 Therefore, in order to have a common processing for both languages, we
2451 disregard anonymous TYPE_DECLs at top level and here we make a first
2452 pass on the nested TYPE_DECLs and a second pass on the unnamed types. */
2455 dump_nested_types (pretty_printer
*buffer
, tree t
, tree parent
, int spc
)
2459 /* Find possible anonymous pointers/arrays/structs/unions recursively. */
2460 type
= TREE_TYPE (t
);
2461 if (type
== NULL_TREE
)
2464 for (field
= TYPE_FIELDS (type
); field
; field
= TREE_CHAIN (field
))
2465 if (TREE_CODE (field
) == TYPE_DECL
2466 && DECL_NAME (field
) != DECL_NAME (t
)
2467 && !DECL_ORIGINAL_TYPE (field
)
2468 && TYPE_NAME (TREE_TYPE (field
)) != TYPE_NAME (type
))
2469 dump_nested_type (buffer
, field
, t
, parent
, spc
);
2471 for (field
= TYPE_FIELDS (type
); field
; field
= TREE_CHAIN (field
))
2472 if (TREE_CODE (field
) == FIELD_DECL
&& !TYPE_NAME (TREE_TYPE (field
)))
2473 dump_nested_type (buffer
, field
, t
, parent
, spc
);
2476 /* Dump in BUFFER the anonymous type of FIELD inside T.
2477 PARENT is the parent node of T. SPC is the indentation level. */
2480 dump_nested_type (pretty_printer
*buffer
, tree field
, tree t
, tree parent
,
2483 tree field_type
= TREE_TYPE (field
);
2486 switch (TREE_CODE (field_type
))
2489 tmp
= TREE_TYPE (field_type
);
2490 dump_forward_type (buffer
, tmp
, t
, spc
);
2494 tmp
= TREE_TYPE (field_type
);
2495 while (TREE_CODE (tmp
) == ARRAY_TYPE
)
2496 tmp
= TREE_TYPE (tmp
);
2497 decl
= get_underlying_decl (tmp
);
2498 if (decl
&& !DECL_NAME (decl
) && !TREE_VISITED (decl
))
2500 /* Generate full declaration. */
2501 dump_nested_type (buffer
, decl
, t
, parent
, spc
);
2502 TREE_VISITED (decl
) = 1;
2504 else if (!decl
&& TREE_CODE (tmp
) == POINTER_TYPE
)
2505 dump_forward_type (buffer
, TREE_TYPE (tmp
), t
, spc
);
2507 /* Special case char arrays. */
2508 if (is_char_array (field_type
))
2509 pp_string (buffer
, "subtype ");
2511 pp_string (buffer
, "type ");
2513 dump_ada_double_name (buffer
, parent
, field
);
2514 pp_string (buffer
, " is ");
2515 dump_ada_array_type (buffer
, field_type
, parent
, spc
);
2516 pp_semicolon (buffer
);
2517 newline_and_indent (buffer
, spc
);
2521 if (is_simple_enum (field_type
))
2522 pp_string (buffer
, "type ");
2524 pp_string (buffer
, "subtype ");
2526 if (TYPE_NAME (field_type
))
2527 dump_ada_node (buffer
, field_type
, NULL_TREE
, spc
, false, true);
2529 dump_ada_double_name (buffer
, parent
, field
);
2530 pp_string (buffer
, " is ");
2531 dump_ada_enum_type (buffer
, field_type
, spc
);
2532 pp_semicolon (buffer
);
2533 newline_and_indent (buffer
, spc
);
2538 dump_nested_types (buffer
, field
, t
, spc
);
2540 pp_string (buffer
, "type ");
2542 if (TYPE_NAME (field_type
))
2543 dump_ada_node (buffer
, field_type
, NULL_TREE
, spc
, false, true);
2545 dump_ada_double_name (buffer
, parent
, field
);
2547 if (TREE_CODE (field_type
) == UNION_TYPE
)
2548 pp_string (buffer
, " (discr : unsigned := 0)");
2550 pp_string (buffer
, " is ");
2551 dump_ada_structure (buffer
, field_type
, t
, true, spc
);
2553 pp_string (buffer
, "with Convention => C_Pass_By_Copy");
2555 if (TREE_CODE (field_type
) == UNION_TYPE
)
2558 newline_and_indent (buffer
, spc
+ 5);
2559 pp_string (buffer
, "Unchecked_Union => True");
2562 pp_semicolon (buffer
);
2563 newline_and_indent (buffer
, spc
);
2571 /* Dump in BUFFER constructor spec corresponding to T for TYPE. */
2574 print_constructor (pretty_printer
*buffer
, tree t
, tree type
)
2576 tree decl_name
= DECL_NAME (TYPE_NAME (type
));
2578 pp_string (buffer
, "New_");
2579 pp_ada_tree_identifier (buffer
, decl_name
, t
, false);
2582 /* Dump in BUFFER destructor spec corresponding to T. */
2585 print_destructor (pretty_printer
*buffer
, tree t
, tree type
)
2587 tree decl_name
= DECL_NAME (TYPE_NAME (type
));
2589 pp_string (buffer
, "Delete_");
2590 pp_ada_tree_identifier (buffer
, decl_name
, t
, false);
2593 /* Return the name of type T. */
2598 tree n
= TYPE_NAME (t
);
2600 if (TREE_CODE (n
) == IDENTIFIER_NODE
)
2601 return IDENTIFIER_POINTER (n
);
2603 return IDENTIFIER_POINTER (DECL_NAME (n
));
2606 /* Dump in BUFFER the declaration of a variable T of type TYPE in Ada syntax.
2607 SPC is the indentation level. Return 1 if a declaration was printed,
2611 dump_ada_declaration (pretty_printer
*buffer
, tree t
, tree type
, int spc
)
2613 bool is_var
= false;
2614 bool need_indent
= false;
2615 bool is_class
= false;
2616 tree name
= TYPE_NAME (TREE_TYPE (t
));
2617 tree decl_name
= DECL_NAME (t
);
2618 tree orig
= NULL_TREE
;
2620 if (cpp_check
&& cpp_check (t
, IS_TEMPLATE
))
2621 return dump_ada_template (buffer
, t
, spc
);
2623 /* Skip enumeral values: will be handled as part of the type itself. */
2624 if (TREE_CODE (t
) == CONST_DECL
&& TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
)
2627 if (TREE_CODE (t
) == TYPE_DECL
)
2629 orig
= DECL_ORIGINAL_TYPE (t
);
2631 if (orig
&& TYPE_STUB_DECL (orig
))
2633 tree stub
= TYPE_STUB_DECL (orig
);
2634 tree typ
= TREE_TYPE (stub
);
2636 if (TYPE_NAME (typ
))
2638 /* If the types have the same name (ignoring casing), then ignore
2639 the second type, but forward declare the first if need be. */
2640 if (type_name (typ
) == type_name (TREE_TYPE (t
))
2641 || !strcasecmp (type_name (typ
), type_name (TREE_TYPE (t
))))
2643 if (RECORD_OR_UNION_TYPE_P (typ
) && !TREE_VISITED (stub
))
2646 dump_forward_type (buffer
, typ
, t
, 0);
2649 TREE_VISITED (t
) = 1;
2655 if (RECORD_OR_UNION_TYPE_P (typ
) && !TREE_VISITED (stub
))
2656 dump_forward_type (buffer
, typ
, t
, spc
);
2658 pp_string (buffer
, "subtype ");
2659 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2660 pp_string (buffer
, " is ");
2661 dump_ada_node (buffer
, typ
, type
, spc
, false, true);
2662 pp_string (buffer
, "; -- ");
2663 dump_sloc (buffer
, t
);
2665 TREE_VISITED (t
) = 1;
2670 /* Skip unnamed or anonymous structs/unions/enum types. */
2671 if (!orig
&& !decl_name
&& !name
2672 && (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
))
2673 || TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
))
2676 /* Skip anonymous enum types (duplicates of real types). */
2678 && TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
2680 && (*IDENTIFIER_POINTER (decl_name
) == '.'
2681 || *IDENTIFIER_POINTER (decl_name
) == '$'))
2686 switch (TREE_CODE (TREE_TYPE (t
)))
2690 if (!COMPLETE_TYPE_P (TREE_TYPE (t
)))
2692 pp_string (buffer
, "type ");
2693 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2694 pp_string (buffer
, " is null record; -- incomplete struct");
2695 TREE_VISITED (t
) = 1;
2700 && (*IDENTIFIER_POINTER (decl_name
) == '.'
2701 || *IDENTIFIER_POINTER (decl_name
) == '$'))
2703 pp_string (buffer
, "-- skipped anonymous struct ");
2704 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2705 TREE_VISITED (t
) = 1;
2709 /* ??? Packed record layout is not supported. */
2710 if (TYPE_PACKED (TREE_TYPE (t
)))
2712 warning_at (DECL_SOURCE_LOCATION (t
), 0,
2713 "unsupported record layout");
2714 pp_string (buffer
, "pragma Compile_Time_Warning (True, ");
2715 pp_string (buffer
, "\"probably incorrect record layout\");");
2716 newline_and_indent (buffer
, spc
);
2719 if (orig
&& TYPE_NAME (orig
))
2720 pp_string (buffer
, "subtype ");
2723 dump_nested_types (buffer
, t
, t
, spc
);
2725 if (separate_class_package (t
))
2728 pp_string (buffer
, "package Class_");
2729 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2730 pp_string (buffer
, " is");
2732 newline_and_indent (buffer
, spc
);
2735 pp_string (buffer
, "type ");
2740 case REFERENCE_TYPE
:
2741 dump_forward_type (buffer
, TREE_TYPE (TREE_TYPE (t
)), t
, spc
);
2745 if ((orig
&& TYPE_NAME (orig
)) || is_char_array (TREE_TYPE (t
)))
2746 pp_string (buffer
, "subtype ");
2748 pp_string (buffer
, "type ");
2752 pp_string (buffer
, "-- skipped function type ");
2753 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2757 if ((orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
2758 || !is_simple_enum (TREE_TYPE (t
)))
2759 pp_string (buffer
, "subtype ");
2761 pp_string (buffer
, "type ");
2765 pp_string (buffer
, "subtype ");
2767 TREE_VISITED (t
) = 1;
2773 && *IDENTIFIER_POINTER (decl_name
) == '_')
2779 /* Print the type and name. */
2780 if (TREE_CODE (TREE_TYPE (t
)) == ARRAY_TYPE
)
2785 /* Print variable's name. */
2786 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2788 if (TREE_CODE (t
) == TYPE_DECL
)
2790 pp_string (buffer
, " is ");
2792 if (orig
&& TYPE_NAME (orig
))
2793 dump_ada_node (buffer
, TYPE_NAME (orig
), type
, spc
, false, true);
2795 dump_ada_array_type (buffer
, TREE_TYPE (t
), type
, spc
);
2799 tree tmp
= TYPE_NAME (TREE_TYPE (t
));
2801 if (spc
== INDENT_INCR
|| TREE_STATIC (t
))
2804 pp_string (buffer
, " : ");
2806 if (TREE_CODE (TREE_TYPE (TREE_TYPE (t
))) != POINTER_TYPE
)
2807 pp_string (buffer
, "aliased ");
2810 dump_ada_node (buffer
, tmp
, type
, spc
, false, true);
2812 dump_ada_double_name (buffer
, type
, t
);
2814 dump_ada_array_type (buffer
, TREE_TYPE (t
), type
, spc
);
2817 else if (TREE_CODE (t
) == FUNCTION_DECL
)
2819 bool is_abstract_class
= false;
2820 bool is_method
= TREE_CODE (TREE_TYPE (t
)) == METHOD_TYPE
;
2821 tree decl_name
= DECL_NAME (t
);
2822 bool is_abstract
= false;
2823 bool is_constructor
= false;
2824 bool is_destructor
= false;
2825 bool is_copy_constructor
= false;
2826 bool is_move_constructor
= false;
2833 is_abstract
= cpp_check (t
, IS_ABSTRACT
);
2834 is_constructor
= cpp_check (t
, IS_CONSTRUCTOR
);
2835 is_destructor
= cpp_check (t
, IS_DESTRUCTOR
);
2836 is_copy_constructor
= cpp_check (t
, IS_COPY_CONSTRUCTOR
);
2837 is_move_constructor
= cpp_check (t
, IS_MOVE_CONSTRUCTOR
);
2840 /* Skip copy constructors and C++11 move constructors: some are internal
2841 only and those that are not cannot be called easily from Ada. */
2842 if (is_copy_constructor
|| is_move_constructor
)
2845 if (is_constructor
|| is_destructor
)
2847 /* ??? Skip implicit constructors/destructors for now. */
2848 if (DECL_ARTIFICIAL (t
))
2851 /* Only consider constructors/destructors for complete objects. */
2852 if (strncmp (IDENTIFIER_POINTER (decl_name
), "__ct_comp", 9) != 0
2853 && strncmp (IDENTIFIER_POINTER (decl_name
), "__dt_comp", 9) != 0)
2857 /* If this function has an entry in the vtable, we cannot omit it. */
2858 else if (!DECL_VINDEX (t
) && *IDENTIFIER_POINTER (decl_name
) == '_')
2861 pp_string (buffer
, "-- skipped func ");
2862 pp_string (buffer
, IDENTIFIER_POINTER (decl_name
));
2869 if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t
))) && !is_constructor
)
2870 pp_string (buffer
, "procedure ");
2872 pp_string (buffer
, "function ");
2875 print_constructor (buffer
, t
, type
);
2876 else if (is_destructor
)
2877 print_destructor (buffer
, t
, type
);
2879 dump_ada_decl_name (buffer
, t
, false);
2881 dump_ada_function_declaration
2882 (buffer
, t
, is_method
, is_constructor
, is_destructor
, spc
);
2884 if (is_constructor
&& RECORD_OR_UNION_TYPE_P (type
))
2885 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= DECL_CHAIN (fld
))
2886 if (TREE_CODE (fld
) == FUNCTION_DECL
&& cpp_check (fld
, IS_ABSTRACT
))
2888 is_abstract_class
= true;
2892 if (is_abstract
|| is_abstract_class
)
2893 pp_string (buffer
, " is abstract");
2895 if (is_abstract
|| !DECL_ASSEMBLER_NAME (t
))
2897 pp_semicolon (buffer
);
2898 pp_string (buffer
, " -- ");
2899 dump_sloc (buffer
, t
);
2901 else if (is_constructor
)
2903 pp_semicolon (buffer
);
2904 pp_string (buffer
, " -- ");
2905 dump_sloc (buffer
, t
);
2907 newline_and_indent (buffer
, spc
);
2908 pp_string (buffer
, "pragma CPP_Constructor (");
2909 print_constructor (buffer
, t
, type
);
2910 pp_string (buffer
, ", \"");
2911 pp_asm_name (buffer
, t
);
2912 pp_string (buffer
, "\");");
2916 pp_string (buffer
, " -- ");
2917 dump_sloc (buffer
, t
);
2919 newline_and_indent (buffer
, spc
);
2920 dump_ada_import (buffer
, t
, spc
);
2925 else if (TREE_CODE (t
) == TYPE_DECL
&& !orig
)
2927 bool is_interface
= false;
2928 bool is_abstract_record
= false;
2933 /* Anonymous structs/unions. */
2934 dump_ada_node (buffer
, TREE_TYPE (t
), t
, spc
, false, true);
2936 if (TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
)
2937 pp_string (buffer
, " (discr : unsigned := 0)");
2939 pp_string (buffer
, " is ");
2941 /* Check whether we have an Ada interface compatible class.
2942 That is only have a vtable non-static data member and no
2943 non-abstract methods. */
2945 && RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
)))
2947 bool has_fields
= false;
2949 /* Check that there are no fields other than the virtual table. */
2950 for (tree fld
= TYPE_FIELDS (TREE_TYPE (t
));
2952 fld
= TREE_CHAIN (fld
))
2954 if (TREE_CODE (fld
) == FIELD_DECL
)
2956 if (!has_fields
&& DECL_VIRTUAL_P (fld
))
2957 is_interface
= true;
2959 is_interface
= false;
2962 else if (TREE_CODE (fld
) == FUNCTION_DECL
2963 && !DECL_ARTIFICIAL (fld
))
2965 if (cpp_check (fld
, IS_ABSTRACT
))
2966 is_abstract_record
= true;
2968 is_interface
= false;
2973 TREE_VISITED (t
) = 1;
2976 pp_string (buffer
, "limited interface -- ");
2977 dump_sloc (buffer
, t
);
2978 newline_and_indent (buffer
, spc
);
2979 pp_string (buffer
, "with Import => True,");
2980 newline_and_indent (buffer
, spc
+ 5);
2981 pp_string (buffer
, "Convention => CPP");
2983 dump_ada_methods (buffer
, TREE_TYPE (t
), spc
);
2987 if (is_abstract_record
)
2988 pp_string (buffer
, "abstract ");
2989 dump_ada_node (buffer
, t
, t
, spc
, false, false);
2997 if (TREE_CODE (t
) == FIELD_DECL
&& DECL_NAME (t
))
2998 check_name (buffer
, t
);
3000 /* Print variable/type's name. */
3001 dump_ada_node (buffer
, t
, t
, spc
, false, true);
3003 if (TREE_CODE (t
) == TYPE_DECL
)
3005 const bool is_subtype
= TYPE_NAME (orig
);
3007 if (!is_subtype
&& TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
)
3008 pp_string (buffer
, " (discr : unsigned := 0)");
3010 pp_string (buffer
, " is ");
3012 dump_ada_node (buffer
, orig
, t
, spc
, false, is_subtype
);
3016 if (spc
== INDENT_INCR
|| TREE_STATIC (t
))
3019 pp_string (buffer
, " : ");
3021 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
))
3022 || TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
)
3024 if (TYPE_NAME (TREE_TYPE (t
))
3025 || TREE_CODE (TREE_TYPE (t
)) != ENUMERAL_TYPE
)
3026 pp_string (buffer
, "aliased ");
3028 if (TREE_READONLY (t
) && TREE_CODE (t
) != FIELD_DECL
)
3029 pp_string (buffer
, "constant ");
3031 if (TYPE_NAME (TREE_TYPE (t
)))
3032 dump_ada_node (buffer
, TREE_TYPE (t
), t
, spc
, false, true);
3034 dump_ada_double_name (buffer
, type
, t
);
3038 if (TREE_CODE (TREE_TYPE (t
)) != POINTER_TYPE
3039 && (TYPE_NAME (TREE_TYPE (t
))
3040 || TREE_CODE (TREE_TYPE (t
)) != INTEGER_TYPE
))
3041 pp_string (buffer
, "aliased ");
3043 if (TREE_READONLY (t
) && TREE_CODE (t
) != FIELD_DECL
)
3044 pp_string (buffer
, "constant ");
3046 dump_ada_node (buffer
, TREE_TYPE (t
), t
, spc
, false, true);
3054 newline_and_indent (buffer
, spc
);
3055 pp_string (buffer
, "end;");
3056 newline_and_indent (buffer
, spc
);
3057 pp_string (buffer
, "use Class_");
3058 dump_ada_node (buffer
, t
, type
, spc
, false, true);
3059 pp_semicolon (buffer
);
3060 pp_newline (buffer
);
3062 /* All needed indentation/newline performed already, so return 0. */
3067 pp_string (buffer
, " -- ");
3068 dump_sloc (buffer
, t
);
3069 newline_and_indent (buffer
, spc
);
3070 dump_ada_import (buffer
, t
, spc
);
3075 pp_string (buffer
, "; -- ");
3076 dump_sloc (buffer
, t
);
3082 /* Dump in BUFFER a structure NODE of type TYPE in Ada syntax. If NESTED is
3083 true, it's an anonymous nested type. SPC is the indentation level. */
3086 dump_ada_structure (pretty_printer
*buffer
, tree node
, tree type
, bool nested
,
3089 const bool is_union
= (TREE_CODE (node
) == UNION_TYPE
);
3092 int field_spc
= spc
+ INDENT_INCR
;
3095 bitfield_used
= false;
3097 /* Print the contents of the structure. */
3098 pp_string (buffer
, "record");
3102 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
3103 pp_string (buffer
, "case discr is");
3104 field_spc
= spc
+ INDENT_INCR
* 3;
3107 pp_newline (buffer
);
3109 /* Print the non-static fields of the structure. */
3110 for (tree tmp
= TYPE_FIELDS (node
); tmp
; tmp
= TREE_CHAIN (tmp
))
3112 /* Add parent field if needed. */
3113 if (!DECL_NAME (tmp
))
3115 if (!is_tagged_type (TREE_TYPE (tmp
)))
3117 if (!TYPE_NAME (TREE_TYPE (tmp
)))
3118 dump_ada_declaration (buffer
, tmp
, type
, field_spc
);
3124 pp_string (buffer
, "parent : aliased ");
3127 sprintf (buf
, "field_%d : aliased ", field_num
+ 1);
3128 pp_string (buffer
, buf
);
3130 dump_ada_decl_name (buffer
, TYPE_NAME (TREE_TYPE (tmp
)),
3132 pp_semicolon (buffer
);
3135 pp_newline (buffer
);
3139 else if (TREE_CODE (tmp
) == FIELD_DECL
)
3141 /* Skip internal virtual table field. */
3142 if (!DECL_VIRTUAL_P (tmp
))
3146 if (TREE_CHAIN (tmp
)
3147 && TREE_TYPE (TREE_CHAIN (tmp
)) != node
3148 && TREE_CODE (TREE_CHAIN (tmp
)) != TYPE_DECL
)
3149 sprintf (buf
, "when %d =>", field_num
);
3151 sprintf (buf
, "when others =>");
3153 INDENT (spc
+ INDENT_INCR
* 2);
3154 pp_string (buffer
, buf
);
3155 pp_newline (buffer
);
3158 if (dump_ada_declaration (buffer
, tmp
, type
, field_spc
))
3160 pp_newline (buffer
);
3169 INDENT (spc
+ INDENT_INCR
);
3170 pp_string (buffer
, "end case;");
3171 pp_newline (buffer
);
3176 INDENT (spc
+ INDENT_INCR
);
3177 pp_string (buffer
, "null;");
3178 pp_newline (buffer
);
3182 pp_string (buffer
, "end record");
3184 newline_and_indent (buffer
, spc
);
3186 /* We disregard the methods for anonymous nested types. */
3190 if (has_nontrivial_methods (node
))
3192 pp_string (buffer
, "with Import => True,");
3193 newline_and_indent (buffer
, spc
+ 5);
3194 pp_string (buffer
, "Convention => CPP");
3197 pp_string (buffer
, "with Convention => C_Pass_By_Copy");
3202 newline_and_indent (buffer
, spc
+ 5);
3203 pp_string (buffer
, "Unchecked_Union => True");
3209 newline_and_indent (buffer
, spc
+ 5);
3210 pp_string (buffer
, "Pack => True");
3211 bitfield_used
= false;
3214 need_semicolon
= !dump_ada_methods (buffer
, node
, spc
);
3216 /* Print the static fields of the structure, if any. */
3217 for (tree tmp
= TYPE_FIELDS (node
); tmp
; tmp
= TREE_CHAIN (tmp
))
3219 if (TREE_CODE (tmp
) == VAR_DECL
&& DECL_NAME (tmp
))
3223 need_semicolon
= false;
3224 pp_semicolon (buffer
);
3226 pp_newline (buffer
);
3227 pp_newline (buffer
);
3228 dump_ada_declaration (buffer
, tmp
, type
, spc
);
3233 /* Dump all the declarations in SOURCE_FILE to an Ada spec.
3234 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3235 nodes for SOURCE_FILE. CHECK is used to perform C++ queries on nodes. */
3238 dump_ads (const char *source_file
,
3239 void (*collect_all_refs
)(const char *),
3240 int (*check
)(tree
, cpp_operation
))
3247 pkg_name
= get_ada_package (source_file
);
3249 /* Construct the .ads filename and package name. */
3250 ads_name
= xstrdup (pkg_name
);
3252 for (s
= ads_name
; *s
; s
++)
3258 ads_name
= reconcat (ads_name
, ads_name
, ".ads", NULL
);
3260 /* Write out the .ads file. */
3261 f
= fopen (ads_name
, "w");
3266 pp_needs_newline (&pp
) = true;
3267 pp
.buffer
->stream
= f
;
3269 /* Dump all relevant macros. */
3270 dump_ada_macros (&pp
, source_file
);
3272 /* Reset the table of withs for this file. */
3275 (*collect_all_refs
) (source_file
);
3277 /* Dump all references. */
3279 dump_ada_nodes (&pp
, source_file
);
3281 /* We require Ada 2012 syntax, so generate corresponding pragma.
3282 Also, disable style checks since this file is auto-generated. */
3283 fprintf (f
, "pragma Ada_2012;\npragma Style_Checks (Off);\n\n");
3288 fprintf (f
, "\npackage %s is\n\n", pkg_name
);
3289 pp_write_text_to_stream (&pp
);
3290 /* ??? need to free pp */
3291 fprintf (f
, "end %s;\n", pkg_name
);
3299 static const char **source_refs
= NULL
;
3300 static int source_refs_used
= 0;
3301 static int source_refs_allocd
= 0;
3303 /* Add an entry for FILENAME to the table SOURCE_REFS. */
3306 collect_source_ref (const char *filename
)
3313 if (source_refs_allocd
== 0)
3315 source_refs_allocd
= 1024;
3316 source_refs
= XNEWVEC (const char *, source_refs_allocd
);
3319 for (i
= 0; i
< source_refs_used
; i
++)
3320 if (filename
== source_refs
[i
])
3323 if (source_refs_used
== source_refs_allocd
)
3325 source_refs_allocd
*= 2;
3326 source_refs
= XRESIZEVEC (const char *, source_refs
, source_refs_allocd
);
3329 source_refs
[source_refs_used
++] = filename
;
3332 /* Main entry point: dump all Ada specs corresponding to SOURCE_REFS
3333 using callbacks COLLECT_ALL_REFS and CHECK.
3334 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3335 nodes for a given source file.
3336 CHECK is used to perform C++ queries on nodes, or NULL for the C
3340 dump_ada_specs (void (*collect_all_refs
)(const char *),
3341 int (*check
)(tree
, cpp_operation
))
3343 /* Iterate over the list of files to dump specs for. */
3344 for (int i
= 0; i
< source_refs_used
; i
++)
3345 dump_ads (source_refs
[i
], collect_all_refs
, check
);
3347 /* Free various tables. */