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 "cpp-id-data.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
, int, bool);
38 static char *to_ada_name (const char *, unsigned int, 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
->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 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
->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 const cpp_macro
*macro
= node
->value
.macro
;
176 if (node
->type
== NT_MACRO
&& !(node
->flags
& NODE_BUILTIN
)
178 && *NODE_NAME (node
) != '_'
179 && LOCATION_FILE (macro
->line
) == macro_source_file
)
185 /* Callback used to store relevant macros from cpp_forall_identifiers.
186 PFILE is not used. NODE is the current macro to store if relevant.
187 MACROS is an array of cpp_hashnode* used to store NODE. */
190 store_ada_macro (cpp_reader
*pfile ATTRIBUTE_UNUSED
,
191 cpp_hashnode
*node
, void *macros
)
193 const cpp_macro
*macro
= node
->value
.macro
;
195 if (node
->type
== NT_MACRO
196 && !(node
->flags
& NODE_BUILTIN
)
198 && *NODE_NAME (node
) != '_'
199 && LOCATION_FILE (macro
->line
) == macro_source_file
)
200 ((cpp_hashnode
**) macros
)[store_ada_macro_index
++] = node
;
205 /* Callback used to compare (during qsort) macros. NODE1 and NODE2 are the
206 two macro nodes to compare. */
209 compare_macro (const void *node1
, const void *node2
)
211 typedef const cpp_hashnode
*const_hnode
;
213 const_hnode n1
= *(const const_hnode
*) node1
;
214 const_hnode n2
= *(const const_hnode
*) node2
;
216 return n1
->value
.macro
->line
- n2
->value
.macro
->line
;
219 /* Dump in PP all relevant macros appearing in FILE. */
222 dump_ada_macros (pretty_printer
*pp
, const char* file
)
224 int num_macros
= 0, prev_line
= -1;
225 cpp_hashnode
**macros
;
227 /* Initialize file-scope variables. */
229 store_ada_macro_index
= 0;
230 macro_source_file
= file
;
232 /* Count all potentially relevant macros, and then sort them by sloc. */
233 cpp_forall_identifiers (parse_in
, count_ada_macro
, NULL
);
234 macros
= XALLOCAVEC (cpp_hashnode
*, max_ada_macros
);
235 cpp_forall_identifiers (parse_in
, store_ada_macro
, macros
);
236 qsort (macros
, max_ada_macros
, sizeof (cpp_hashnode
*), compare_macro
);
238 for (int j
= 0; j
< max_ada_macros
; j
++)
240 cpp_hashnode
*node
= macros
[j
];
241 const cpp_macro
*macro
= node
->value
.macro
;
243 int supported
= 1, prev_is_one
= 0, buffer_len
, param_len
;
244 int is_string
= 0, is_char
= 0;
246 unsigned char *s
, *params
, *buffer
, *buf_param
, *char_one
= NULL
, *tmp
;
248 macro_length (macro
, &supported
, &buffer_len
, ¶m_len
);
249 s
= buffer
= XALLOCAVEC (unsigned char, buffer_len
);
250 params
= buf_param
= XALLOCAVEC (unsigned char, param_len
);
257 for (i
= 0; i
< macro
->paramc
; i
++)
259 cpp_hashnode
*param
= macro
->params
[i
];
261 memcpy (buf_param
, NODE_NAME (param
), NODE_LEN (param
));
262 buf_param
+= NODE_LEN (param
);
264 if (i
+ 1 < macro
->paramc
)
269 else if (macro
->variadic
)
279 for (i
= 0; supported
&& i
< macro
->count
; i
++)
281 cpp_token
*token
= ¯o
->exp
.tokens
[i
];
284 if (token
->flags
& PREV_WHITE
)
287 if (token
->flags
& STRINGIFY_ARG
|| token
->flags
& PASTE_LEFT
)
297 cpp_hashnode
*param
=
298 macro
->params
[token
->val
.macro_arg
.arg_no
- 1];
299 memcpy (buffer
, NODE_NAME (param
), NODE_LEN (param
));
300 buffer
+= NODE_LEN (param
);
304 case CPP_EQ_EQ
: *buffer
++ = '='; break;
305 case CPP_GREATER
: *buffer
++ = '>'; break;
306 case CPP_LESS
: *buffer
++ = '<'; break;
307 case CPP_PLUS
: *buffer
++ = '+'; break;
308 case CPP_MINUS
: *buffer
++ = '-'; break;
309 case CPP_MULT
: *buffer
++ = '*'; break;
310 case CPP_DIV
: *buffer
++ = '/'; break;
311 case CPP_COMMA
: *buffer
++ = ','; break;
312 case CPP_OPEN_SQUARE
:
313 case CPP_OPEN_PAREN
: *buffer
++ = '('; break;
314 case CPP_CLOSE_SQUARE
: /* fallthrough */
315 case CPP_CLOSE_PAREN
: *buffer
++ = ')'; break;
316 case CPP_DEREF
: /* fallthrough */
317 case CPP_SCOPE
: /* fallthrough */
318 case CPP_DOT
: *buffer
++ = '.'; break;
320 case CPP_EQ
: *buffer
++ = ':'; *buffer
++ = '='; break;
321 case CPP_NOT_EQ
: *buffer
++ = '/'; *buffer
++ = '='; break;
322 case CPP_GREATER_EQ
: *buffer
++ = '>'; *buffer
++ = '='; break;
323 case CPP_LESS_EQ
: *buffer
++ = '<'; *buffer
++ = '='; break;
326 *buffer
++ = 'n'; *buffer
++ = 'o'; *buffer
++ = 't'; break;
328 *buffer
++ = 'm'; *buffer
++ = 'o'; *buffer
++ = 'd'; break;
330 *buffer
++ = 'a'; *buffer
++ = 'n'; *buffer
++ = 'd'; break;
332 *buffer
++ = 'o'; *buffer
++ = 'r'; break;
334 *buffer
++ = 'x'; *buffer
++ = 'o'; *buffer
++ = 'r'; break;
336 strcpy ((char *) buffer
, " and then ");
340 strcpy ((char *) buffer
, " or else ");
346 is_one
= prev_is_one
;
361 if (!macro
->fun_like
)
365 = cpp_spell_token (parse_in
, token
, buffer
, false);
377 const unsigned char *s
= token
->val
.str
.text
;
383 buffer
= handle_escape_character (buffer
, *s
);
402 c
= cpp_interpret_charconst (parse_in
, token
,
403 &chars_seen
, &ignored
);
404 if (c
>= 32 && c
<= 126)
407 *buffer
++ = (char) c
;
413 ((char *) buffer
, "Character'Val (%d)", (int) c
);
414 buffer
+= chars_seen
;
420 tmp
= cpp_token_as_text (parse_in
, token
);
440 buffer
= dump_number (tmp
+ 2, buffer
, false);
448 buffer
= dump_number (tmp
+ 2, buffer
, false);
453 /* Dump floating-point constant unmodified. */
454 if (strchr ((const char *)tmp
, '.'))
455 buffer
= dump_number (tmp
, buffer
, true);
461 = dump_number (tmp
+ 1, buffer
, false);
484 = dump_number (tmp
, buffer
,
485 strchr ((const char *)tmp
, '.'));
493 /* Replace "1 << N" by "2 ** N" */
520 case CPP_CLOSE_BRACE
:
524 case CPP_MINUS_MINUS
:
528 case CPP_HEADER_NAME
:
531 case CPP_OBJC_STRING
:
533 if (!macro
->fun_like
)
536 buffer
= cpp_spell_token (parse_in
, token
, buffer
, false);
540 prev_is_one
= is_one
;
547 if (macro
->fun_like
&& supported
)
549 char *start
= (char *) s
;
552 pp_string (pp
, " -- arg-macro: ");
554 if (*start
== '(' && buffer
[-1] == ')')
559 pp_string (pp
, "function ");
563 pp_string (pp
, "procedure ");
566 pp_string (pp
, (const char *) NODE_NAME (node
));
568 pp_string (pp
, (char *) params
);
570 pp_string (pp
, " -- ");
574 pp_string (pp
, "return ");
575 pp_string (pp
, start
);
579 pp_string (pp
, start
);
585 expanded_location sloc
= expand_location (macro
->line
);
587 if (sloc
.line
!= prev_line
+ 1 && prev_line
> 0)
591 prev_line
= sloc
.line
;
594 ada_name
= to_ada_name ((const char *) NODE_NAME (node
), 0, NULL
);
595 pp_string (pp
, ada_name
);
597 pp_string (pp
, " : ");
600 pp_string (pp
, "aliased constant String");
602 pp_string (pp
, "aliased constant Character");
604 pp_string (pp
, "constant");
606 pp_string (pp
, " := ");
607 pp_string (pp
, (char *) s
);
610 pp_string (pp
, " & ASCII.NUL");
612 pp_string (pp
, "; -- ");
613 pp_string (pp
, sloc
.file
);
615 pp_scalar (pp
, "%d", sloc
.line
);
620 pp_string (pp
, " -- unsupported macro: ");
621 pp_string (pp
, (const char *) cpp_macro_definition (parse_in
, node
));
630 /* Current source file being handled. */
631 static const char *current_source_file
;
633 /* Return sloc of DECL, using sloc of last field if LAST is true. */
636 decl_sloc (const_tree decl
, bool last
)
640 /* Compare the declaration of struct-like types based on the sloc of their
641 last field (if LAST is true), so that more nested types collate before
643 if (TREE_CODE (decl
) == TYPE_DECL
644 && !DECL_ORIGINAL_TYPE (decl
)
645 && RECORD_OR_UNION_TYPE_P (TREE_TYPE (decl
))
646 && (field
= TYPE_FIELDS (TREE_TYPE (decl
))))
649 while (DECL_CHAIN (field
))
650 field
= DECL_CHAIN (field
);
651 return DECL_SOURCE_LOCATION (field
);
654 return DECL_SOURCE_LOCATION (decl
);
657 /* Compare two locations LHS and RHS. */
660 compare_location (location_t lhs
, location_t rhs
)
662 expanded_location xlhs
= expand_location (lhs
);
663 expanded_location xrhs
= expand_location (rhs
);
665 if (xlhs
.file
!= xrhs
.file
)
666 return filename_cmp (xlhs
.file
, xrhs
.file
);
668 if (xlhs
.line
!= xrhs
.line
)
669 return xlhs
.line
- xrhs
.line
;
671 if (xlhs
.column
!= xrhs
.column
)
672 return xlhs
.column
- xrhs
.column
;
677 /* Compare two declarations (LP and RP) by their source location. */
680 compare_node (const void *lp
, const void *rp
)
682 const_tree lhs
= *((const tree
*) lp
);
683 const_tree rhs
= *((const tree
*) rp
);
685 return compare_location (decl_sloc (lhs
, true), decl_sloc (rhs
, true));
688 /* Compare two comments (LP and RP) by their source location. */
691 compare_comment (const void *lp
, const void *rp
)
693 const cpp_comment
*lhs
= (const cpp_comment
*) lp
;
694 const cpp_comment
*rhs
= (const cpp_comment
*) rp
;
696 return compare_location (lhs
->sloc
, rhs
->sloc
);
699 static tree
*to_dump
= NULL
;
700 static int to_dump_count
= 0;
702 /* Collect a list of declarations from T relevant to SOURCE_FILE to be dumped
703 by a subsequent call to dump_ada_nodes. */
706 collect_ada_nodes (tree t
, const char *source_file
)
709 int i
= to_dump_count
;
711 /* Count the likely relevant nodes: do not dump builtins (they are irrelevant
712 in the context of bindings) and namespaces (we do not handle them properly
714 for (n
= t
; n
; n
= TREE_CHAIN (n
))
715 if (!DECL_IS_BUILTIN (n
)
716 && TREE_CODE (n
) != NAMESPACE_DECL
717 && LOCATION_FILE (decl_sloc (n
, false)) == source_file
)
720 /* Allocate sufficient storage for all nodes. */
721 to_dump
= XRESIZEVEC (tree
, to_dump
, to_dump_count
);
723 /* Store the relevant nodes. */
724 for (n
= t
; n
; n
= TREE_CHAIN (n
))
725 if (!DECL_IS_BUILTIN (n
)
726 && TREE_CODE (n
) != NAMESPACE_DECL
727 && LOCATION_FILE (decl_sloc (n
, false)) == source_file
)
731 /* Call back for walk_tree to clear the TREE_VISITED flag of TP. */
734 unmark_visited_r (tree
*tp
, int *walk_subtrees ATTRIBUTE_UNUSED
,
735 void *data ATTRIBUTE_UNUSED
)
737 if (TREE_VISITED (*tp
))
738 TREE_VISITED (*tp
) = 0;
745 /* Print a COMMENT to the output stream PP. */
748 print_comment (pretty_printer
*pp
, const char *comment
)
750 int len
= strlen (comment
);
751 char *str
= XALLOCAVEC (char, len
+ 1);
753 bool extra_newline
= false;
755 memcpy (str
, comment
, len
+ 1);
757 /* Trim C/C++ comment indicators. */
758 if (str
[len
- 2] == '*' && str
[len
- 1] == '/')
765 tok
= strtok (str
, "\n");
767 pp_string (pp
, " --");
770 tok
= strtok (NULL
, "\n");
772 /* Leave a blank line after multi-line comments. */
774 extra_newline
= true;
781 /* Dump nodes into PP relevant to SOURCE_FILE, as collected by previous calls
782 to collect_ada_nodes. */
785 dump_ada_nodes (pretty_printer
*pp
, const char *source_file
)
788 cpp_comment_table
*comments
;
790 /* Sort the table of declarations to dump by sloc. */
791 qsort (to_dump
, to_dump_count
, sizeof (tree
), compare_node
);
793 /* Fetch the table of comments. */
794 comments
= cpp_get_comments (parse_in
);
796 /* Sort the comments table by sloc. */
797 if (comments
->count
> 1)
798 qsort (comments
->entries
, comments
->count
, sizeof (cpp_comment
),
801 /* Interleave comments and declarations in line number order. */
805 /* Advance j until comment j is in this file. */
806 while (j
!= comments
->count
807 && LOCATION_FILE (comments
->entries
[j
].sloc
) != source_file
)
810 /* Advance j until comment j is not a duplicate. */
811 while (j
< comments
->count
- 1
812 && !compare_comment (&comments
->entries
[j
],
813 &comments
->entries
[j
+ 1]))
816 /* Write decls until decl i collates after comment j. */
817 while (i
!= to_dump_count
)
819 if (j
== comments
->count
820 || LOCATION_LINE (decl_sloc (to_dump
[i
], false))
821 < LOCATION_LINE (comments
->entries
[j
].sloc
))
823 current_source_file
= source_file
;
825 if (dump_ada_declaration (pp
, to_dump
[i
++], NULL_TREE
,
836 /* Write comment j, if there is one. */
837 if (j
!= comments
->count
)
838 print_comment (pp
, comments
->entries
[j
++].comment
);
840 } while (i
!= to_dump_count
|| j
!= comments
->count
);
842 /* Clear the TREE_VISITED flag over each subtree we've dumped. */
843 for (i
= 0; i
< to_dump_count
; i
++)
844 walk_tree (&to_dump
[i
], unmark_visited_r
, NULL
, NULL
);
846 /* Finalize the to_dump table. */
855 /* Dump a newline and indent BUFFER by SPC chars. */
858 newline_and_indent (pretty_printer
*buffer
, int spc
)
864 struct with
{ char *s
; const char *in_file
; bool limited
; };
865 static struct with
*withs
= NULL
;
866 static int withs_max
= 4096;
867 static int with_len
= 0;
869 /* Record a "with" clause on package S (a limited with if LIMITED_ACCESS is
870 true), if not already done. */
873 append_withs (const char *s
, bool limited_access
)
878 withs
= XNEWVEC (struct with
, withs_max
);
880 if (with_len
== withs_max
)
883 withs
= XRESIZEVEC (struct with
, withs
, withs_max
);
886 for (i
= 0; i
< with_len
; i
++)
887 if (!strcmp (s
, withs
[i
].s
)
888 && current_source_file
== withs
[i
].in_file
)
890 withs
[i
].limited
&= limited_access
;
894 withs
[with_len
].s
= xstrdup (s
);
895 withs
[with_len
].in_file
= current_source_file
;
896 withs
[with_len
].limited
= limited_access
;
900 /* Reset "with" clauses. */
903 reset_ada_withs (void)
910 for (i
= 0; i
< with_len
; i
++)
918 /* Dump "with" clauses in F. */
921 dump_ada_withs (FILE *f
)
925 fprintf (f
, "with Interfaces.C; use Interfaces.C;\n");
927 for (i
= 0; i
< with_len
; i
++)
929 (f
, "%swith %s;\n", withs
[i
].limited
? "limited " : "", withs
[i
].s
);
932 /* Return suitable Ada package name from FILE. */
935 get_ada_package (const char *file
)
943 s
= strstr (file
, "/include/");
947 base
= lbasename (file
);
949 if (ada_specs_parent
== NULL
)
952 plen
= strlen (ada_specs_parent
) + 1;
954 res
= XNEWVEC (char, plen
+ strlen (base
) + 1);
955 if (ada_specs_parent
!= NULL
) {
956 strcpy (res
, ada_specs_parent
);
960 for (i
= plen
; *base
; base
++, i
++)
972 res
[i
] = (i
== 0 || res
[i
- 1] == '.' || res
[i
- 1] == '_') ? 'u' : '_';
984 static const char *ada_reserved
[] = {
985 "abort", "abs", "abstract", "accept", "access", "aliased", "all", "and",
986 "array", "at", "begin", "body", "case", "constant", "declare", "delay",
987 "delta", "digits", "do", "else", "elsif", "end", "entry", "exception",
988 "exit", "for", "function", "generic", "goto", "if", "in", "interface", "is",
989 "limited", "loop", "mod", "new", "not", "null", "others", "out", "of", "or",
990 "overriding", "package", "pragma", "private", "procedure", "protected",
991 "raise", "range", "record", "rem", "renames", "requeue", "return", "reverse",
992 "select", "separate", "subtype", "synchronized", "tagged", "task",
993 "terminate", "then", "type", "until", "use", "when", "while", "with", "xor",
996 /* ??? would be nice to specify this list via a config file, so that users
997 can create their own dictionary of conflicts. */
998 static const char *c_duplicates
[] = {
999 /* system will cause troubles with System.Address. */
1002 /* The following values have other definitions with same name/other
1008 "rl_readline_version",
1014 /* Return a declaration tree corresponding to TYPE. */
1017 get_underlying_decl (tree type
)
1022 /* type is a declaration. */
1026 /* type is a typedef. */
1027 if (TYPE_P (type
) && TYPE_NAME (type
) && DECL_P (TYPE_NAME (type
)))
1028 return TYPE_NAME (type
);
1030 /* TYPE_STUB_DECL has been set for type. */
1031 if (TYPE_P (type
) && TYPE_STUB_DECL (type
))
1032 return TYPE_STUB_DECL (type
);
1037 /* Return whether TYPE has static fields. */
1040 has_static_fields (const_tree type
)
1042 if (!type
|| !RECORD_OR_UNION_TYPE_P (type
))
1045 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= TREE_CHAIN (fld
))
1046 if (TREE_CODE (fld
) == VAR_DECL
&& DECL_NAME (fld
))
1052 /* Return whether TYPE corresponds to an Ada tagged type (has a dispatch
1056 is_tagged_type (const_tree type
)
1058 if (!type
|| !RECORD_OR_UNION_TYPE_P (type
))
1061 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= TREE_CHAIN (fld
))
1062 if (TREE_CODE (fld
) == FUNCTION_DECL
&& DECL_VINDEX (fld
))
1068 /* Return whether TYPE has non-trivial methods, i.e. methods that do something
1069 for the objects of TYPE. In C++, all classes have implicit special methods,
1070 e.g. constructors and destructors, but they can be trivial if the type is
1071 sufficiently simple. */
1074 has_nontrivial_methods (tree type
)
1076 if (!type
|| !RECORD_OR_UNION_TYPE_P (type
))
1079 /* Only C++ types can have methods. */
1083 /* A non-trivial type has non-trivial special methods. */
1084 if (!cpp_check (type
, IS_TRIVIAL
))
1087 /* If there are user-defined methods, they are deemed non-trivial. */
1088 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= DECL_CHAIN (fld
))
1089 if (TREE_CODE (fld
) == FUNCTION_DECL
&& !DECL_ARTIFICIAL (fld
))
1095 #define INDEX_LENGTH 8
1097 /* Generate a legal Ada name from a C/C++ NAME and return a malloc'ed string.
1098 INDEX, if non-zero, is used to disambiguate overloaded names. SPACE_FOUND,
1099 if not NULL, is used to indicate whether a space was found in NAME. */
1102 to_ada_name (const char *name
, unsigned int index
, bool *space_found
)
1105 const int len
= strlen (name
);
1108 char *s
= XNEWVEC (char, len
* 2 + 5 + (index
? INDEX_LENGTH
: 0));
1112 *space_found
= false;
1114 /* Add "c_" prefix if name is an Ada reserved word. */
1115 for (names
= ada_reserved
; *names
; names
++)
1116 if (!strcasecmp (name
, *names
))
1125 /* Add "c_" prefix if name is a potential case sensitive duplicate. */
1126 for (names
= c_duplicates
; *names
; names
++)
1127 if (!strcmp (name
, *names
))
1135 for (j
= 0; name
[j
] == '_'; j
++)
1140 else if (*name
== '.' || *name
== '$')
1150 /* Replace unsuitable characters for Ada identifiers. */
1151 for (; j
< len
; j
++)
1156 *space_found
= true;
1160 /* ??? missing some C++ operators. */
1164 if (name
[j
+ 1] == '=')
1179 if (name
[j
+ 1] == '=')
1197 s
[len2
++] = name
[j
] == '&' ? 'a' : name
[j
] == '|' ? 'o' : 'x';
1199 if (name
[j
+ 1] == '=')
1212 if (s
[len2
- 1] != '_')
1215 switch (name
[j
+ 1]) {
1218 switch (name
[j
- 1]) {
1219 case '+': s
[len2
++] = 'p'; break; /* + */
1220 case '-': s
[len2
++] = 'm'; break; /* - */
1221 case '*': s
[len2
++] = 't'; break; /* * */
1222 case '/': s
[len2
++] = 'd'; break; /* / */
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; /* /= */
1266 c
= name
[j
] == '<' ? 'l' : 'g';
1269 switch (name
[j
+ 1]) {
1295 if (len2
&& s
[len2
- 1] == '_')
1300 s
[len2
++] = name
[j
];
1303 if (s
[len2
- 1] == '_')
1307 snprintf (&s
[len2
], INDEX_LENGTH
, "_u_%d", index
+ 1);
1314 /* Return true if DECL refers to a C++ class type for which a
1315 separate enclosing package has been or should be generated. */
1318 separate_class_package (tree decl
)
1320 tree type
= TREE_TYPE (decl
);
1321 return has_nontrivial_methods (type
) || has_static_fields (type
);
1324 static bool package_prefix
= true;
1326 /* Dump in BUFFER the name of an identifier NODE of type TYPE, following Ada
1327 syntax. INDEX, if non-zero, is used to disambiguate overloaded names.
1328 LIMITED_ACCESS indicates whether NODE can be accessed via a limited
1329 'with' clause rather than a regular 'with' clause. */
1332 pp_ada_tree_identifier (pretty_printer
*buffer
, tree node
, tree type
,
1333 unsigned int index
, bool limited_access
)
1335 const char *name
= IDENTIFIER_POINTER (node
);
1336 bool space_found
= false;
1337 char *s
= to_ada_name (name
, index
, &space_found
);
1338 tree decl
= get_underlying_decl (type
);
1340 /* If the entity comes from another file, generate a package prefix. */
1343 expanded_location xloc
= expand_location (decl_sloc (decl
, false));
1345 if (xloc
.file
&& xloc
.line
)
1347 if (xloc
.file
!= current_source_file
)
1349 switch (TREE_CODE (type
))
1354 case FIXED_POINT_TYPE
:
1356 case REFERENCE_TYPE
:
1364 char *s1
= get_ada_package (xloc
.file
);
1365 append_withs (s1
, limited_access
);
1366 pp_string (buffer
, s1
);
1375 /* Generate the additional package prefix for C++ classes. */
1376 if (separate_class_package (decl
))
1378 pp_string (buffer
, "Class_");
1379 pp_string (buffer
, s
);
1387 if (!strcmp (s
, "short_int"))
1388 pp_string (buffer
, "short");
1389 else if (!strcmp (s
, "short_unsigned_int"))
1390 pp_string (buffer
, "unsigned_short");
1391 else if (!strcmp (s
, "unsigned_int"))
1392 pp_string (buffer
, "unsigned");
1393 else if (!strcmp (s
, "long_int"))
1394 pp_string (buffer
, "long");
1395 else if (!strcmp (s
, "long_unsigned_int"))
1396 pp_string (buffer
, "unsigned_long");
1397 else if (!strcmp (s
, "long_long_int"))
1398 pp_string (buffer
, "Long_Long_Integer");
1399 else if (!strcmp (s
, "long_long_unsigned_int"))
1403 append_withs ("Interfaces.C.Extensions", false);
1404 pp_string (buffer
, "Extensions.unsigned_long_long");
1407 pp_string (buffer
, "unsigned_long_long");
1410 pp_string(buffer
, s
);
1412 if (!strcmp (s
, "u_Bool") || !strcmp (s
, "bool"))
1416 append_withs ("Interfaces.C.Extensions", false);
1417 pp_string (buffer
, "Extensions.bool");
1420 pp_string (buffer
, "bool");
1423 pp_string(buffer
, s
);
1428 /* Dump in BUFFER the assembly name of T. */
1431 pp_asm_name (pretty_printer
*buffer
, tree t
)
1433 tree name
= DECL_ASSEMBLER_NAME (t
);
1434 char *ada_name
= XALLOCAVEC (char, IDENTIFIER_LENGTH (name
) + 1), *s
;
1435 const char *ident
= IDENTIFIER_POINTER (name
);
1437 for (s
= ada_name
; *ident
; ident
++)
1441 else if (*ident
!= '*')
1446 pp_string (buffer
, ada_name
);
1449 /* Hash table of overloaded names associating identifier nodes with DECL_UIDs.
1450 It is needed in Ada 2005 because we can have at most one import directive
1451 per subprogram name in a given scope, so we have to mangle the subprogram
1452 names on the Ada side to import overloaded subprograms from C++. */
1454 struct overloaded_name_hash
{
1458 vec
<unsigned int> homonyms
;
1461 struct overloaded_name_hasher
: delete_ptr_hash
<overloaded_name_hash
>
1463 static inline hashval_t
hash (overloaded_name_hash
*t
)
1465 static inline bool equal (overloaded_name_hash
*a
, overloaded_name_hash
*b
)
1466 { return a
->name
== b
->name
&& a
->context
== b
->context
; }
1469 static hash_table
<overloaded_name_hasher
> *overloaded_names
;
1471 /* Compute the overloading index of function DECL in its context. */
1474 compute_overloading_index (tree decl
)
1476 const hashval_t hashcode
1477 = iterative_hash_hashval_t (htab_hash_pointer (DECL_NAME (decl
)),
1478 htab_hash_pointer (DECL_CONTEXT (decl
)));
1479 struct overloaded_name_hash in
, *h
, **slot
;
1480 unsigned int index
, *iter
;
1482 if (!overloaded_names
)
1483 overloaded_names
= new hash_table
<overloaded_name_hasher
> (512);
1485 /* Look up the list of homonyms in the table. */
1487 in
.name
= DECL_NAME (decl
);
1488 in
.context
= DECL_CONTEXT (decl
);
1489 slot
= overloaded_names
->find_slot_with_hash (&in
, hashcode
, INSERT
);
1494 h
= new overloaded_name_hash
;
1496 h
->name
= DECL_NAME (decl
);
1497 h
->context
= DECL_CONTEXT (decl
);
1498 h
->homonyms
.create (0);
1502 /* Look up the function in the list of homonyms. */
1503 FOR_EACH_VEC_ELT (h
->homonyms
, index
, iter
)
1504 if (*iter
== DECL_UID (decl
))
1507 /* If it is not present, push it onto the list. */
1509 h
->homonyms
.safe_push (DECL_UID (decl
));
1514 /* Dump in BUFFER the name of a DECL node if set, in Ada syntax.
1515 LIMITED_ACCESS indicates whether NODE can be accessed via a
1516 limited 'with' clause rather than a regular 'with' clause. */
1519 dump_ada_decl_name (pretty_printer
*buffer
, tree decl
, bool limited_access
)
1521 if (DECL_NAME (decl
))
1523 const unsigned int index
1524 = (TREE_CODE (decl
) == FUNCTION_DECL
&& cpp_check
)
1525 ? compute_overloading_index (decl
) : 0;
1526 pp_ada_tree_identifier (buffer
, DECL_NAME (decl
), decl
, index
,
1531 tree type_name
= TYPE_NAME (TREE_TYPE (decl
));
1535 pp_string (buffer
, "anon");
1536 if (TREE_CODE (decl
) == FIELD_DECL
)
1537 pp_scalar (buffer
, "%d", DECL_UID (decl
));
1539 pp_scalar (buffer
, "%d", TYPE_UID (TREE_TYPE (decl
)));
1541 else if (TREE_CODE (type_name
) == IDENTIFIER_NODE
)
1542 pp_ada_tree_identifier (buffer
, type_name
, decl
, 0, limited_access
);
1546 /* Dump in BUFFER a name based on both T1 and T2 followed by a suffix. */
1549 dump_ada_double_name (pretty_printer
*buffer
, tree t1
, tree t2
)
1552 pp_ada_tree_identifier (buffer
, DECL_NAME (t1
), t1
, 0, false);
1555 pp_string (buffer
, "anon");
1556 pp_scalar (buffer
, "%d", TYPE_UID (TREE_TYPE (t1
)));
1559 pp_underscore (buffer
);
1562 pp_ada_tree_identifier (buffer
, DECL_NAME (t2
), t2
, 0, false);
1565 pp_string (buffer
, "anon");
1566 pp_scalar (buffer
, "%d", TYPE_UID (TREE_TYPE (t2
)));
1569 switch (TREE_CODE (TREE_TYPE (t2
)))
1572 pp_string (buffer
, "_array");
1575 pp_string (buffer
, "_enum");
1578 pp_string (buffer
, "_struct");
1581 pp_string (buffer
, "_union");
1584 pp_string (buffer
, "_unknown");
1589 /* Dump in BUFFER pragma Import C/CPP on a given node T. */
1592 dump_ada_import (pretty_printer
*buffer
, tree t
)
1594 const char *name
= IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (t
));
1595 const bool is_stdcall
1596 = TREE_CODE (t
) == FUNCTION_DECL
1597 && lookup_attribute ("stdcall", TYPE_ATTRIBUTES (TREE_TYPE (t
)));
1600 pp_string (buffer
, "pragma Import (Stdcall, ");
1601 else if (name
[0] == '_' && name
[1] == 'Z')
1602 pp_string (buffer
, "pragma Import (CPP, ");
1604 pp_string (buffer
, "pragma Import (C, ");
1606 dump_ada_decl_name (buffer
, t
, false);
1607 pp_string (buffer
, ", \"");
1610 pp_string (buffer
, IDENTIFIER_POINTER (DECL_NAME (t
)));
1612 pp_asm_name (buffer
, t
);
1614 pp_string (buffer
, "\");");
1617 /* Check whether T and its type have different names, and append "the_"
1618 otherwise in BUFFER. */
1621 check_name (pretty_printer
*buffer
, tree t
)
1624 tree tmp
= TREE_TYPE (t
);
1626 while (TREE_CODE (tmp
) == POINTER_TYPE
&& !TYPE_NAME (tmp
))
1627 tmp
= TREE_TYPE (tmp
);
1629 if (TREE_CODE (tmp
) != FUNCTION_TYPE
)
1631 if (TREE_CODE (tmp
) == IDENTIFIER_NODE
)
1632 s
= IDENTIFIER_POINTER (tmp
);
1633 else if (!TYPE_NAME (tmp
))
1635 else if (TREE_CODE (TYPE_NAME (tmp
)) == IDENTIFIER_NODE
)
1636 s
= IDENTIFIER_POINTER (TYPE_NAME (tmp
));
1638 s
= IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp
)));
1640 if (!strcasecmp (IDENTIFIER_POINTER (DECL_NAME (t
)), s
))
1641 pp_string (buffer
, "the_");
1645 /* Dump in BUFFER a function declaration FUNC in Ada syntax.
1646 IS_METHOD indicates whether FUNC is a C++ method.
1647 IS_CONSTRUCTOR whether FUNC is a C++ constructor.
1648 IS_DESTRUCTOR whether FUNC is a C++ destructor.
1649 SPC is the current indentation level. */
1652 dump_ada_function_declaration (pretty_printer
*buffer
, tree func
,
1653 bool is_method
, bool is_constructor
,
1654 bool is_destructor
, int spc
)
1657 const tree node
= TREE_TYPE (func
);
1659 int num
= 0, num_args
= 0, have_args
= true, have_ellipsis
= false;
1661 /* Compute number of arguments. */
1662 arg
= TYPE_ARG_TYPES (node
);
1666 while (TREE_CHAIN (arg
) && arg
!= error_mark_node
)
1669 arg
= TREE_CHAIN (arg
);
1672 if (TREE_CODE (TREE_VALUE (arg
)) != VOID_TYPE
)
1675 have_ellipsis
= true;
1686 newline_and_indent (buffer
, spc
+ 1);
1691 pp_left_paren (buffer
);
1694 if (TREE_CODE (func
) == FUNCTION_DECL
)
1695 arg
= DECL_ARGUMENTS (func
);
1699 if (arg
== NULL_TREE
)
1702 arg
= TYPE_ARG_TYPES (node
);
1704 if (arg
&& TREE_CODE (TREE_VALUE (arg
)) == VOID_TYPE
)
1709 arg
= TREE_CHAIN (arg
);
1711 /* Print the argument names (if available) & types. */
1713 for (num
= 1; num
<= num_args
; num
++)
1717 if (DECL_NAME (arg
))
1719 check_name (buffer
, arg
);
1720 pp_ada_tree_identifier (buffer
, DECL_NAME (arg
), NULL_TREE
, 0,
1722 pp_string (buffer
, " : ");
1726 sprintf (buf
, "arg%d : ", num
);
1727 pp_string (buffer
, buf
);
1730 dump_ada_node (buffer
, TREE_TYPE (arg
), node
, spc
, false, true);
1734 sprintf (buf
, "arg%d : ", num
);
1735 pp_string (buffer
, buf
);
1736 dump_ada_node (buffer
, TREE_VALUE (arg
), node
, spc
, false, true);
1739 /* If the type is a pointer to a tagged type, we need to differentiate
1740 virtual methods from the rest (non-virtual methods, static member
1741 or regular functions) and import only them as primitive operations,
1742 because they make up the virtual table which is mirrored on the Ada
1743 side by the dispatch table. So we add 'Class to the type of every
1744 parameter that is not the first one of a method which either has a
1745 slot in the virtual table or is a constructor. */
1747 && POINTER_TYPE_P (TREE_TYPE (arg
))
1748 && is_tagged_type (TREE_TYPE (TREE_TYPE (arg
)))
1749 && !(num
== 1 && is_method
&& (DECL_VINDEX (func
) || is_constructor
)))
1750 pp_string (buffer
, "'Class");
1752 arg
= TREE_CHAIN (arg
);
1756 pp_semicolon (buffer
);
1759 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
1767 pp_string (buffer
, " -- , ...");
1768 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
1772 pp_right_paren (buffer
);
1774 if (is_constructor
|| !VOID_TYPE_P (TREE_TYPE (node
)))
1776 pp_string (buffer
, " return ");
1777 tree type
= is_constructor
? DECL_CONTEXT (func
) : TREE_TYPE (node
);
1778 dump_ada_node (buffer
, type
, type
, spc
, false, true);
1782 /* Dump in BUFFER all the domains associated with an array NODE,
1783 in Ada syntax. SPC is the current indentation level. */
1786 dump_ada_array_domains (pretty_printer
*buffer
, tree node
, int spc
)
1789 pp_left_paren (buffer
);
1791 for (; TREE_CODE (node
) == ARRAY_TYPE
; node
= TREE_TYPE (node
))
1793 tree domain
= TYPE_DOMAIN (node
);
1797 tree min
= TYPE_MIN_VALUE (domain
);
1798 tree max
= TYPE_MAX_VALUE (domain
);
1801 pp_string (buffer
, ", ");
1805 dump_ada_node (buffer
, min
, NULL_TREE
, spc
, false, true);
1806 pp_string (buffer
, " .. ");
1808 /* If the upper bound is zero, gcc may generate a NULL_TREE
1809 for TYPE_MAX_VALUE rather than an integer_cst. */
1811 dump_ada_node (buffer
, max
, NULL_TREE
, spc
, false, true);
1813 pp_string (buffer
, "0");
1816 pp_string (buffer
, "size_t");
1818 pp_right_paren (buffer
);
1821 /* Dump in BUFFER file:line information related to NODE. */
1824 dump_sloc (pretty_printer
*buffer
, tree node
)
1826 expanded_location xloc
;
1831 xloc
= expand_location (DECL_SOURCE_LOCATION (node
));
1832 else if (EXPR_HAS_LOCATION (node
))
1833 xloc
= expand_location (EXPR_LOCATION (node
));
1837 pp_string (buffer
, xloc
.file
);
1839 pp_decimal_int (buffer
, xloc
.line
);
1843 /* Return true if type T designates a 1-dimension array of "char". */
1846 is_char_array (tree t
)
1850 while (TREE_CODE (t
) == ARRAY_TYPE
)
1857 && TREE_CODE (t
) == INTEGER_TYPE
1858 && id_equal (DECL_NAME (TYPE_NAME (t
)), "char");
1861 /* Dump in BUFFER an array type NODE of type TYPE in Ada syntax. SPC is the
1862 indentation level. */
1865 dump_ada_array_type (pretty_printer
*buffer
, tree node
, tree type
, int spc
)
1867 const bool char_array
= is_char_array (node
);
1869 /* Special case char arrays. */
1871 pp_string (buffer
, "Interfaces.C.char_array ");
1873 pp_string (buffer
, "array ");
1875 /* Print the dimensions. */
1876 dump_ada_array_domains (buffer
, node
, spc
);
1878 /* Print array's type. */
1881 /* Retrieve the element type. */
1883 while (TREE_CODE (tmp
) == ARRAY_TYPE
)
1884 tmp
= TREE_TYPE (tmp
);
1886 pp_string (buffer
, " of ");
1888 if (TREE_CODE (tmp
) != POINTER_TYPE
)
1889 pp_string (buffer
, "aliased ");
1891 if (TYPE_NAME (tmp
) || !RECORD_OR_UNION_TYPE_P (tmp
))
1892 dump_ada_node (buffer
, tmp
, node
, spc
, false, true);
1894 dump_ada_double_name (buffer
, type
, get_underlying_decl (tmp
));
1898 /* Dump in BUFFER type names associated with a template, each prepended with
1899 '_'. TYPES is the TREE_PURPOSE of a DECL_TEMPLATE_INSTANTIATIONS. SPC is
1900 the indentation level. */
1903 dump_template_types (pretty_printer
*buffer
, tree types
, int spc
)
1905 for (int i
= 0; i
< TREE_VEC_LENGTH (types
); i
++)
1907 tree elem
= TREE_VEC_ELT (types
, i
);
1908 pp_underscore (buffer
);
1910 if (!dump_ada_node (buffer
, elem
, NULL_TREE
, spc
, false, true))
1912 pp_string (buffer
, "unknown");
1913 pp_scalar (buffer
, "%lu", (unsigned long) TREE_HASH (elem
));
1918 /* Dump in BUFFER the contents of all class instantiations associated with
1919 a given template T. SPC is the indentation level. */
1922 dump_ada_template (pretty_printer
*buffer
, tree t
, int spc
)
1924 /* DECL_SIZE_UNIT is DECL_TEMPLATE_INSTANTIATIONS in this context. */
1925 tree inst
= DECL_SIZE_UNIT (t
);
1926 /* This emulates DECL_TEMPLATE_RESULT in this context. */
1927 struct tree_template_decl
{
1928 struct tree_decl_common common
;
1932 tree result
= ((struct tree_template_decl
*) t
)->result
;
1935 /* Don't look at template declarations declaring something coming from
1936 another file. This can occur for template friend declarations. */
1937 if (LOCATION_FILE (decl_sloc (result
, false))
1938 != LOCATION_FILE (decl_sloc (t
, false)))
1941 for (; inst
&& inst
!= error_mark_node
; inst
= TREE_CHAIN (inst
))
1943 tree types
= TREE_PURPOSE (inst
);
1944 tree instance
= TREE_VALUE (inst
);
1946 if (TREE_VEC_LENGTH (types
) == 0)
1949 if (!RECORD_OR_UNION_TYPE_P (instance
))
1952 /* We are interested in concrete template instantiations only: skip
1953 partially specialized nodes. */
1954 if (RECORD_OR_UNION_TYPE_P (instance
)
1956 && cpp_check (instance
, HAS_DEPENDENT_TEMPLATE_ARGS
))
1961 pp_string (buffer
, "package ");
1962 package_prefix
= false;
1963 dump_ada_node (buffer
, instance
, t
, spc
, false, true);
1964 dump_template_types (buffer
, types
, spc
);
1965 pp_string (buffer
, " is");
1967 newline_and_indent (buffer
, spc
);
1969 TREE_VISITED (get_underlying_decl (instance
)) = 1;
1970 pp_string (buffer
, "type ");
1971 dump_ada_node (buffer
, instance
, t
, spc
, false, true);
1972 package_prefix
= true;
1974 if (is_tagged_type (instance
))
1975 pp_string (buffer
, " is tagged limited ");
1977 pp_string (buffer
, " is limited ");
1979 dump_ada_node (buffer
, instance
, t
, spc
, false, false);
1980 pp_newline (buffer
);
1982 newline_and_indent (buffer
, spc
);
1984 pp_string (buffer
, "end;");
1985 newline_and_indent (buffer
, spc
);
1986 pp_string (buffer
, "use ");
1987 package_prefix
= false;
1988 dump_ada_node (buffer
, instance
, t
, spc
, false, true);
1989 dump_template_types (buffer
, types
, spc
);
1990 package_prefix
= true;
1991 pp_semicolon (buffer
);
1992 pp_newline (buffer
);
1993 pp_newline (buffer
);
1996 return num_inst
> 0;
1999 /* Return true if NODE is a simple enum types, that can be mapped to an
2000 Ada enum type directly. */
2003 is_simple_enum (tree node
)
2005 HOST_WIDE_INT count
= 0;
2007 for (tree value
= TYPE_VALUES (node
); value
; value
= TREE_CHAIN (value
))
2009 tree int_val
= TREE_VALUE (value
);
2011 if (TREE_CODE (int_val
) != INTEGER_CST
)
2012 int_val
= DECL_INITIAL (int_val
);
2014 if (!tree_fits_shwi_p (int_val
))
2016 else if (tree_to_shwi (int_val
) != count
)
2025 /* Dump in BUFFER an enumeral type NODE of type TYPE in Ada syntax. SPC is
2026 the indentation level. If DISPLAY_CONVENTION is true, also print the
2027 pragma Convention for NODE. */
2030 dump_ada_enum_type (pretty_printer
*buffer
, tree node
, tree type
, int spc
,
2031 bool display_convention
)
2033 if (is_simple_enum (node
))
2037 newline_and_indent (buffer
, spc
- 1);
2038 pp_left_paren (buffer
);
2039 for (tree value
= TYPE_VALUES (node
); value
; value
= TREE_CHAIN (value
))
2046 newline_and_indent (buffer
, spc
);
2049 pp_ada_tree_identifier (buffer
, TREE_PURPOSE (value
), node
, 0, false);
2051 pp_string (buffer
, ");");
2053 newline_and_indent (buffer
, spc
);
2055 if (display_convention
)
2057 pp_string (buffer
, "pragma Convention (C, ");
2058 dump_ada_node (buffer
, DECL_NAME (type
) ? type
: TYPE_NAME (node
),
2059 type
, spc
, false, true);
2060 pp_right_paren (buffer
);
2065 if (TYPE_UNSIGNED (node
))
2066 pp_string (buffer
, "unsigned");
2068 pp_string (buffer
, "int");
2069 for (tree value
= TYPE_VALUES (node
); value
; value
= TREE_CHAIN (value
))
2071 pp_semicolon (buffer
);
2072 newline_and_indent (buffer
, spc
);
2074 pp_ada_tree_identifier (buffer
, TREE_PURPOSE (value
), node
, 0, false);
2075 pp_string (buffer
, " : constant ");
2077 if (TYPE_UNSIGNED (node
))
2078 pp_string (buffer
, "unsigned");
2080 pp_string (buffer
, "int");
2082 pp_string (buffer
, " := ");
2083 dump_ada_node (buffer
,
2084 TREE_CODE (TREE_VALUE (value
)) == INTEGER_CST
2085 ? TREE_VALUE (value
)
2086 : DECL_INITIAL (TREE_VALUE (value
)),
2087 node
, spc
, false, true);
2092 static bool bitfield_used
= false;
2094 /* Recursively dump in BUFFER Ada declarations corresponding to NODE of type
2095 TYPE. SPC is the indentation level. LIMITED_ACCESS indicates whether NODE
2096 can be referenced via a "limited with" clause. NAME_ONLY indicates whether
2097 we should only dump the name of NODE, instead of its full declaration. */
2100 dump_ada_node (pretty_printer
*buffer
, tree node
, tree type
, int spc
,
2101 bool limited_access
, bool name_only
)
2103 if (node
== NULL_TREE
)
2106 switch (TREE_CODE (node
))
2109 pp_string (buffer
, "<<< error >>>");
2112 case IDENTIFIER_NODE
:
2113 pp_ada_tree_identifier (buffer
, node
, type
, 0, limited_access
);
2117 pp_string (buffer
, "--- unexpected node: TREE_LIST");
2121 dump_ada_node (buffer
, BINFO_TYPE (node
), type
, spc
, limited_access
,
2126 pp_string (buffer
, "--- unexpected node: TREE_VEC");
2133 append_withs ("System", false);
2134 pp_string (buffer
, "System.Address");
2137 pp_string (buffer
, "address");
2141 pp_string (buffer
, "<vector>");
2145 pp_string (buffer
, "<complex>");
2150 dump_ada_node (buffer
, TYPE_NAME (node
), node
, spc
, false, true);
2152 dump_ada_enum_type (buffer
, node
, type
, spc
, true);
2156 if (TYPE_NAME (node
)
2157 && TREE_CODE (TYPE_NAME (node
)) == TYPE_DECL
2158 && IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (node
))) [0] == '_'
2159 && (id_equal (DECL_NAME (TYPE_NAME (node
)), "_Float128")
2160 || id_equal (DECL_NAME (TYPE_NAME (node
)), "__float128")))
2162 append_withs ("Interfaces.C.Extensions", false);
2163 pp_string (buffer
, "Extensions.Float_128");
2169 case FIXED_POINT_TYPE
:
2171 if (TYPE_NAME (node
))
2173 if (TREE_CODE (TYPE_NAME (node
)) == IDENTIFIER_NODE
)
2174 pp_ada_tree_identifier (buffer
, TYPE_NAME (node
), node
, 0,
2176 else if (TREE_CODE (TYPE_NAME (node
)) == TYPE_DECL
2177 && DECL_NAME (TYPE_NAME (node
)))
2178 dump_ada_decl_name (buffer
, TYPE_NAME (node
), limited_access
);
2180 pp_string (buffer
, "<unnamed type>");
2182 else if (TREE_CODE (node
) == INTEGER_TYPE
)
2184 append_withs ("Interfaces.C.Extensions", false);
2185 bitfield_used
= true;
2187 if (TYPE_PRECISION (node
) == 1)
2188 pp_string (buffer
, "Extensions.Unsigned_1");
2191 pp_string (buffer
, TYPE_UNSIGNED (node
)
2192 ? "Extensions.Unsigned_"
2193 : "Extensions.Signed_");
2194 pp_decimal_int (buffer
, TYPE_PRECISION (node
));
2198 pp_string (buffer
, "<unnamed type>");
2202 case REFERENCE_TYPE
:
2203 if (name_only
&& TYPE_NAME (node
))
2204 dump_ada_node (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
,
2207 else if (TREE_CODE (TREE_TYPE (node
)) == FUNCTION_TYPE
)
2209 if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (node
))))
2210 pp_string (buffer
, "access procedure");
2212 pp_string (buffer
, "access function");
2214 dump_ada_function_declaration (buffer
, node
, false, false, false,
2217 /* If we are dumping the full type, it means we are part of a
2218 type definition and need also a Convention C pragma. */
2221 pp_semicolon (buffer
);
2222 newline_and_indent (buffer
, spc
);
2223 pp_string (buffer
, "pragma Convention (C, ");
2224 dump_ada_node (buffer
, type
, NULL_TREE
, spc
, false, true);
2225 pp_right_paren (buffer
);
2230 bool is_access
= false;
2231 unsigned int quals
= TYPE_QUALS (TREE_TYPE (node
));
2233 if (VOID_TYPE_P (TREE_TYPE (node
)))
2236 pp_string (buffer
, "new ");
2239 append_withs ("System", false);
2240 pp_string (buffer
, "System.Address");
2243 pp_string (buffer
, "address");
2247 if (TREE_CODE (node
) == POINTER_TYPE
2248 && TREE_CODE (TREE_TYPE (node
)) == INTEGER_TYPE
2249 && id_equal (DECL_NAME (TYPE_NAME (TREE_TYPE (node
))),
2253 pp_string (buffer
, "new ");
2257 pp_string (buffer
, "Interfaces.C.Strings.chars_ptr");
2258 append_withs ("Interfaces.C.Strings", false);
2261 pp_string (buffer
, "chars_ptr");
2265 tree type_name
= TYPE_NAME (TREE_TYPE (node
));
2267 /* For now, handle access-to-access as System.Address. */
2268 if (TREE_CODE (TREE_TYPE (node
)) == POINTER_TYPE
)
2272 append_withs ("System", false);
2274 pp_string (buffer
, "new ");
2275 pp_string (buffer
, "System.Address");
2278 pp_string (buffer
, "address");
2282 if (!package_prefix
)
2283 pp_string (buffer
, "access");
2284 else if (AGGREGATE_TYPE_P (TREE_TYPE (node
)))
2286 if (!type
|| TREE_CODE (type
) != FUNCTION_DECL
)
2288 pp_string (buffer
, "access ");
2291 if (quals
& TYPE_QUAL_CONST
)
2292 pp_string (buffer
, "constant ");
2293 else if (!name_only
)
2294 pp_string (buffer
, "all ");
2296 else if (quals
& TYPE_QUAL_CONST
)
2297 pp_string (buffer
, "in ");
2301 pp_string (buffer
, "access ");
2302 /* ??? should be configurable: access or in out. */
2308 pp_string (buffer
, "access ");
2311 pp_string (buffer
, "all ");
2314 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node
)) && type_name
)
2315 dump_ada_node (buffer
, type_name
, TREE_TYPE (node
), spc
,
2318 dump_ada_node (buffer
, TREE_TYPE (node
), TREE_TYPE (node
),
2327 dump_ada_node (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
,
2330 dump_ada_array_type (buffer
, node
, type
, spc
);
2336 dump_ada_node (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
,
2339 dump_ada_structure (buffer
, node
, type
, spc
, true);
2343 /* We treat the upper half of the sizetype range as negative. This
2344 is consistent with the internal treatment and makes it possible
2345 to generate the (0 .. -1) range for flexible array members. */
2346 if (TREE_TYPE (node
) == sizetype
)
2347 node
= fold_convert (ssizetype
, node
);
2348 if (tree_fits_shwi_p (node
))
2349 pp_wide_integer (buffer
, tree_to_shwi (node
));
2350 else if (tree_fits_uhwi_p (node
))
2351 pp_unsigned_wide_integer (buffer
, tree_to_uhwi (node
));
2354 wide_int val
= wi::to_wide (node
);
2356 if (wi::neg_p (val
))
2361 sprintf (pp_buffer (buffer
)->digit_buffer
,
2362 "16#%" HOST_WIDE_INT_PRINT
"x",
2363 val
.elt (val
.get_len () - 1));
2364 for (i
= val
.get_len () - 2; i
>= 0; i
--)
2365 sprintf (pp_buffer (buffer
)->digit_buffer
,
2366 HOST_WIDE_INT_PRINT_PADDED_HEX
, val
.elt (i
));
2367 pp_string (buffer
, pp_buffer (buffer
)->digit_buffer
);
2379 if (DECL_IS_BUILTIN (node
))
2381 /* Don't print the declaration of built-in types. */
2384 /* If we're in the middle of a declaration, defaults to
2388 append_withs ("System", false);
2389 pp_string (buffer
, "System.Address");
2392 pp_string (buffer
, "address");
2398 dump_ada_decl_name (buffer
, node
, limited_access
);
2401 if (is_tagged_type (TREE_TYPE (node
)))
2405 /* Look for ancestors. */
2406 for (tree fld
= TYPE_FIELDS (TREE_TYPE (node
));
2408 fld
= TREE_CHAIN (fld
))
2410 if (!DECL_NAME (fld
) && is_tagged_type (TREE_TYPE (fld
)))
2414 pp_string (buffer
, "limited new ");
2418 pp_string (buffer
, " and ");
2420 dump_ada_decl_name (buffer
, TYPE_NAME (TREE_TYPE (fld
)),
2425 pp_string (buffer
, first
? "tagged limited " : " with ");
2427 else if (has_nontrivial_methods (TREE_TYPE (node
)))
2428 pp_string (buffer
, "limited ");
2430 dump_ada_node (buffer
, TREE_TYPE (node
), type
, spc
, false, false);
2439 case NAMESPACE_DECL
:
2440 dump_ada_decl_name (buffer
, node
, false);
2444 /* Ignore other nodes (e.g. expressions). */
2451 /* Dump in BUFFER NODE's methods. SPC is the indentation level. Return 1 if
2452 methods were printed, 0 otherwise. */
2455 dump_ada_methods (pretty_printer
*buffer
, tree node
, int spc
)
2457 if (!has_nontrivial_methods (node
))
2460 pp_semicolon (buffer
);
2463 for (tree fld
= TYPE_FIELDS (node
); fld
; fld
= DECL_CHAIN (fld
))
2464 if (TREE_CODE (fld
) == FUNCTION_DECL
)
2468 pp_newline (buffer
);
2469 pp_newline (buffer
);
2472 res
= dump_ada_declaration (buffer
, fld
, node
, spc
);
2478 /* Dump in BUFFER a forward declaration for TYPE present inside T.
2479 SPC is the indentation level. */
2482 dump_forward_type (pretty_printer
*buffer
, tree type
, tree t
, int spc
)
2484 tree decl
= get_underlying_decl (type
);
2486 /* Anonymous pointer and function types. */
2489 if (TREE_CODE (type
) == POINTER_TYPE
)
2490 dump_forward_type (buffer
, TREE_TYPE (type
), t
, spc
);
2491 else if (TREE_CODE (type
) == FUNCTION_TYPE
)
2493 function_args_iterator args_iter
;
2495 dump_forward_type (buffer
, TREE_TYPE (type
), t
, spc
);
2496 FOREACH_FUNCTION_ARGS (type
, arg
, args_iter
)
2497 dump_forward_type (buffer
, arg
, t
, spc
);
2502 if (DECL_IS_BUILTIN (decl
) || TREE_VISITED (decl
))
2505 /* Forward declarations are only needed within a given file. */
2506 if (DECL_SOURCE_FILE (decl
) != DECL_SOURCE_FILE (t
))
2509 /* Generate an incomplete type declaration. */
2510 pp_string (buffer
, "type ");
2511 dump_ada_node (buffer
, decl
, NULL_TREE
, spc
, false, true);
2512 pp_semicolon (buffer
);
2513 newline_and_indent (buffer
, spc
);
2515 /* Only one incomplete declaration is legal for a given type. */
2516 TREE_VISITED (decl
) = 1;
2519 static void dump_nested_type (pretty_printer
*, tree
, tree
, tree
, int);
2521 /* Dump in BUFFER anonymous types nested inside T's definition.
2522 PARENT is the parent node of T. SPC is the indentation level.
2524 In C anonymous nested tagged types have no name whereas in C++ they have
2525 one. In C their TYPE_DECL is at top level whereas in C++ it is nested.
2526 In both languages untagged types (pointers and arrays) have no name.
2527 In C++ the nested TYPE_DECLs can come after their associated FIELD_DECL.
2529 Therefore, in order to have a common processing for both languages, we
2530 disregard anonymous TYPE_DECLs at top level and here we make a first
2531 pass on the nested TYPE_DECLs and a second pass on the unnamed types. */
2534 dump_nested_types (pretty_printer
*buffer
, tree t
, tree parent
, int spc
)
2538 /* Find possible anonymous pointers/arrays/structs/unions recursively. */
2539 type
= TREE_TYPE (t
);
2540 if (type
== NULL_TREE
)
2543 for (field
= TYPE_FIELDS (type
); field
; field
= TREE_CHAIN (field
))
2544 if (TREE_CODE (field
) == TYPE_DECL
2545 && DECL_NAME (field
) != DECL_NAME (t
)
2546 && !DECL_ORIGINAL_TYPE (field
)
2547 && TYPE_NAME (TREE_TYPE (field
)) != TYPE_NAME (type
))
2548 dump_nested_type (buffer
, field
, t
, parent
, spc
);
2550 for (field
= TYPE_FIELDS (type
); field
; field
= TREE_CHAIN (field
))
2551 if (TREE_CODE (field
) == FIELD_DECL
&& !TYPE_NAME (TREE_TYPE (field
)))
2552 dump_nested_type (buffer
, field
, t
, parent
, spc
);
2555 /* Dump in BUFFER the anonymous type of FIELD inside T.
2556 PARENT is the parent node of T. SPC is the indentation level. */
2559 dump_nested_type (pretty_printer
*buffer
, tree field
, tree t
, tree parent
,
2562 tree field_type
= TREE_TYPE (field
);
2565 switch (TREE_CODE (field_type
))
2568 tmp
= TREE_TYPE (field_type
);
2569 dump_forward_type (buffer
, tmp
, t
, spc
);
2573 tmp
= TREE_TYPE (field_type
);
2574 while (TREE_CODE (tmp
) == ARRAY_TYPE
)
2575 tmp
= TREE_TYPE (tmp
);
2576 decl
= get_underlying_decl (tmp
);
2577 if (decl
&& !DECL_NAME (decl
) && !TREE_VISITED (decl
))
2579 /* Generate full declaration. */
2580 dump_nested_type (buffer
, decl
, t
, parent
, spc
);
2581 TREE_VISITED (decl
) = 1;
2583 else if (!decl
&& TREE_CODE (tmp
) == POINTER_TYPE
)
2584 dump_forward_type (buffer
, TREE_TYPE (tmp
), t
, spc
);
2586 /* Special case char arrays. */
2587 if (is_char_array (field_type
))
2588 pp_string (buffer
, "subtype ");
2590 pp_string (buffer
, "type ");
2592 dump_ada_double_name (buffer
, parent
, field
);
2593 pp_string (buffer
, " is ");
2594 dump_ada_array_type (buffer
, field_type
, parent
, spc
);
2595 pp_semicolon (buffer
);
2596 newline_and_indent (buffer
, spc
);
2600 if (is_simple_enum (field_type
))
2601 pp_string (buffer
, "type ");
2603 pp_string (buffer
, "subtype ");
2605 if (TYPE_NAME (field_type
))
2606 dump_ada_node (buffer
, field_type
, NULL_TREE
, spc
, false, true);
2608 dump_ada_double_name (buffer
, parent
, field
);
2609 pp_string (buffer
, " is ");
2610 dump_ada_enum_type (buffer
, field_type
, t
, spc
, false);
2612 if (is_simple_enum (field_type
))
2614 pp_string (buffer
, "pragma Convention (C, ");
2615 if (TYPE_NAME (field_type
))
2616 dump_ada_node (buffer
, field_type
, NULL_TREE
, spc
, false, true);
2618 dump_ada_double_name (buffer
, parent
, field
);
2619 pp_string (buffer
, ");");
2620 newline_and_indent (buffer
, spc
);
2624 pp_semicolon (buffer
);
2625 newline_and_indent (buffer
, spc
);
2631 dump_nested_types (buffer
, field
, t
, spc
);
2633 pp_string (buffer
, "type ");
2635 if (TYPE_NAME (field_type
))
2636 dump_ada_node (buffer
, field_type
, NULL_TREE
, spc
, false, true);
2638 dump_ada_double_name (buffer
, parent
, field
);
2640 if (TREE_CODE (field_type
) == UNION_TYPE
)
2641 pp_string (buffer
, " (discr : unsigned := 0)");
2643 pp_string (buffer
, " is ");
2644 dump_ada_structure (buffer
, field_type
, t
, spc
, false);
2646 pp_string (buffer
, "pragma Convention (C_Pass_By_Copy, ");
2647 if (TYPE_NAME (field_type
))
2648 dump_ada_node (buffer
, field_type
, NULL_TREE
, spc
, false, true);
2650 dump_ada_double_name (buffer
, parent
, field
);
2651 pp_string (buffer
, ");");
2652 newline_and_indent (buffer
, spc
);
2654 if (TREE_CODE (field_type
) == UNION_TYPE
)
2656 pp_string (buffer
, "pragma Unchecked_Union (");
2657 if (TYPE_NAME (field_type
))
2658 dump_ada_node (buffer
, field_type
, NULL_TREE
, spc
, false, true);
2660 dump_ada_double_name (buffer
, parent
, field
);
2661 pp_string (buffer
, ");");
2670 /* Dump in BUFFER constructor spec corresponding to T for TYPE. */
2673 print_constructor (pretty_printer
*buffer
, tree t
, tree type
)
2675 tree decl_name
= DECL_NAME (TYPE_NAME (type
));
2677 pp_string (buffer
, "New_");
2678 pp_ada_tree_identifier (buffer
, decl_name
, t
, 0, false);
2681 /* Dump in BUFFER destructor spec corresponding to T. */
2684 print_destructor (pretty_printer
*buffer
, tree t
, tree type
)
2686 tree decl_name
= DECL_NAME (TYPE_NAME (type
));
2688 pp_string (buffer
, "Delete_");
2689 pp_ada_tree_identifier (buffer
, decl_name
, t
, 0, false);
2692 /* Return the name of type T. */
2697 tree n
= TYPE_NAME (t
);
2699 if (TREE_CODE (n
) == IDENTIFIER_NODE
)
2700 return IDENTIFIER_POINTER (n
);
2702 return IDENTIFIER_POINTER (DECL_NAME (n
));
2705 /* Dump in BUFFER the declaration of a variable T of type TYPE in Ada syntax.
2706 SPC is the indentation level. Return 1 if a declaration was printed,
2710 dump_ada_declaration (pretty_printer
*buffer
, tree t
, tree type
, int spc
)
2712 bool is_var
= false;
2713 bool need_indent
= false;
2714 bool is_class
= false;
2715 tree name
= TYPE_NAME (TREE_TYPE (t
));
2716 tree decl_name
= DECL_NAME (t
);
2717 tree orig
= NULL_TREE
;
2719 if (cpp_check
&& cpp_check (t
, IS_TEMPLATE
))
2720 return dump_ada_template (buffer
, t
, spc
);
2722 /* Skip enumeral values: will be handled as part of the type itself. */
2723 if (TREE_CODE (t
) == CONST_DECL
&& TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
)
2726 if (TREE_CODE (t
) == TYPE_DECL
)
2728 orig
= DECL_ORIGINAL_TYPE (t
);
2730 if (orig
&& TYPE_STUB_DECL (orig
))
2732 tree stub
= TYPE_STUB_DECL (orig
);
2733 tree typ
= TREE_TYPE (stub
);
2735 if (TYPE_NAME (typ
))
2737 /* If types have same representation, and same name (ignoring
2738 casing), then ignore the second type. */
2739 if (type_name (typ
) == type_name (TREE_TYPE (t
))
2740 || !strcasecmp (type_name (typ
), type_name (TREE_TYPE (t
))))
2742 TREE_VISITED (t
) = 1;
2748 if (RECORD_OR_UNION_TYPE_P (typ
))
2749 dump_forward_type (buffer
, stub
, t
, spc
);
2751 pp_string (buffer
, "subtype ");
2752 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2753 pp_string (buffer
, " is ");
2754 dump_ada_node (buffer
, typ
, type
, spc
, false, true);
2755 pp_string (buffer
, "; -- ");
2756 dump_sloc (buffer
, t
);
2758 TREE_VISITED (t
) = 1;
2763 /* Skip unnamed or anonymous structs/unions/enum types. */
2764 if (!orig
&& !decl_name
&& !name
2765 && (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
))
2766 || TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
))
2769 /* Skip anonymous enum types (duplicates of real types). */
2771 && TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
2773 && (*IDENTIFIER_POINTER (decl_name
) == '.'
2774 || *IDENTIFIER_POINTER (decl_name
) == '$'))
2779 switch (TREE_CODE (TREE_TYPE (t
)))
2783 if (!COMPLETE_TYPE_P (TREE_TYPE (t
)))
2785 pp_string (buffer
, "type ");
2786 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2787 pp_string (buffer
, " is null record; -- incomplete struct");
2788 TREE_VISITED (t
) = 1;
2793 && (*IDENTIFIER_POINTER (decl_name
) == '.'
2794 || *IDENTIFIER_POINTER (decl_name
) == '$'))
2796 pp_string (buffer
, "-- skipped anonymous struct ");
2797 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2798 TREE_VISITED (t
) = 1;
2802 if (orig
&& TYPE_NAME (orig
))
2803 pp_string (buffer
, "subtype ");
2806 dump_nested_types (buffer
, t
, t
, spc
);
2808 if (separate_class_package (t
))
2811 pp_string (buffer
, "package Class_");
2812 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2813 pp_string (buffer
, " is");
2815 newline_and_indent (buffer
, spc
);
2818 pp_string (buffer
, "type ");
2823 case REFERENCE_TYPE
:
2824 dump_forward_type (buffer
, TREE_TYPE (TREE_TYPE (t
)), t
, spc
);
2828 if ((orig
&& TYPE_NAME (orig
)) || is_char_array (TREE_TYPE (t
)))
2829 pp_string (buffer
, "subtype ");
2831 pp_string (buffer
, "type ");
2835 pp_string (buffer
, "-- skipped function type ");
2836 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2840 if ((orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
2841 || !is_simple_enum (TREE_TYPE (t
)))
2842 pp_string (buffer
, "subtype ");
2844 pp_string (buffer
, "type ");
2848 pp_string (buffer
, "subtype ");
2850 TREE_VISITED (t
) = 1;
2856 && *IDENTIFIER_POINTER (decl_name
) == '_')
2862 /* Print the type and name. */
2863 if (TREE_CODE (TREE_TYPE (t
)) == ARRAY_TYPE
)
2868 /* Print variable's name. */
2869 dump_ada_node (buffer
, t
, type
, spc
, false, true);
2871 if (TREE_CODE (t
) == TYPE_DECL
)
2873 pp_string (buffer
, " is ");
2875 if (orig
&& TYPE_NAME (orig
))
2876 dump_ada_node (buffer
, TYPE_NAME (orig
), type
, spc
, false, true);
2878 dump_ada_array_type (buffer
, TREE_TYPE (t
), type
, spc
);
2882 tree tmp
= TYPE_NAME (TREE_TYPE (t
));
2884 if (spc
== INDENT_INCR
|| TREE_STATIC (t
))
2887 pp_string (buffer
, " : ");
2889 if (TREE_CODE (TREE_TYPE (TREE_TYPE (t
))) != POINTER_TYPE
)
2890 pp_string (buffer
, "aliased ");
2893 dump_ada_node (buffer
, tmp
, type
, spc
, false, true);
2895 dump_ada_double_name (buffer
, type
, t
);
2897 dump_ada_array_type (buffer
, TREE_TYPE (t
), type
, spc
);
2900 else if (TREE_CODE (t
) == FUNCTION_DECL
)
2902 bool is_abstract_class
= false;
2903 bool is_method
= TREE_CODE (TREE_TYPE (t
)) == METHOD_TYPE
;
2904 tree decl_name
= DECL_NAME (t
);
2905 bool is_abstract
= false;
2906 bool is_constructor
= false;
2907 bool is_destructor
= false;
2908 bool is_copy_constructor
= false;
2909 bool is_move_constructor
= false;
2916 is_abstract
= cpp_check (t
, IS_ABSTRACT
);
2917 is_constructor
= cpp_check (t
, IS_CONSTRUCTOR
);
2918 is_destructor
= cpp_check (t
, IS_DESTRUCTOR
);
2919 is_copy_constructor
= cpp_check (t
, IS_COPY_CONSTRUCTOR
);
2920 is_move_constructor
= cpp_check (t
, IS_MOVE_CONSTRUCTOR
);
2923 /* Skip copy constructors and C++11 move constructors: some are internal
2924 only and those that are not cannot be called easily from Ada. */
2925 if (is_copy_constructor
|| is_move_constructor
)
2928 if (is_constructor
|| is_destructor
)
2930 /* ??? Skip implicit constructors/destructors for now. */
2931 if (DECL_ARTIFICIAL (t
))
2934 /* Only consider constructors/destructors for complete objects. */
2935 if (strncmp (IDENTIFIER_POINTER (decl_name
), "__ct_comp", 9) != 0
2936 && strncmp (IDENTIFIER_POINTER (decl_name
), "__dt_comp", 9) != 0)
2940 /* If this function has an entry in the vtable, we cannot omit it. */
2941 else if (!DECL_VINDEX (t
) && *IDENTIFIER_POINTER (decl_name
) == '_')
2944 pp_string (buffer
, "-- skipped func ");
2945 pp_string (buffer
, IDENTIFIER_POINTER (decl_name
));
2952 if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t
))) && !is_constructor
)
2953 pp_string (buffer
, "procedure ");
2955 pp_string (buffer
, "function ");
2958 print_constructor (buffer
, t
, type
);
2959 else if (is_destructor
)
2960 print_destructor (buffer
, t
, type
);
2962 dump_ada_decl_name (buffer
, t
, false);
2964 dump_ada_function_declaration
2965 (buffer
, t
, is_method
, is_constructor
, is_destructor
, spc
);
2967 if (is_constructor
&& RECORD_OR_UNION_TYPE_P (type
))
2968 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= DECL_CHAIN (fld
))
2969 if (TREE_CODE (fld
) == FUNCTION_DECL
&& cpp_check (fld
, IS_ABSTRACT
))
2971 is_abstract_class
= true;
2975 if (is_abstract
|| is_abstract_class
)
2976 pp_string (buffer
, " is abstract");
2978 pp_semicolon (buffer
);
2979 pp_string (buffer
, " -- ");
2980 dump_sloc (buffer
, t
);
2982 if (is_abstract
|| !DECL_ASSEMBLER_NAME (t
))
2985 newline_and_indent (buffer
, spc
);
2989 pp_string (buffer
, "pragma CPP_Constructor (");
2990 print_constructor (buffer
, t
, type
);
2991 pp_string (buffer
, ", \"");
2992 pp_asm_name (buffer
, t
);
2993 pp_string (buffer
, "\");");
2995 else if (is_destructor
)
2997 pp_string (buffer
, "pragma Import (CPP, ");
2998 print_destructor (buffer
, t
, type
);
2999 pp_string (buffer
, ", \"");
3000 pp_asm_name (buffer
, t
);
3001 pp_string (buffer
, "\");");
3004 dump_ada_import (buffer
, t
);
3008 else if (TREE_CODE (t
) == TYPE_DECL
&& !orig
)
3010 bool is_interface
= false;
3011 bool is_abstract_record
= false;
3016 /* Anonymous structs/unions. */
3017 dump_ada_node (buffer
, TREE_TYPE (t
), t
, spc
, false, true);
3019 if (TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
)
3020 pp_string (buffer
, " (discr : unsigned := 0)");
3022 pp_string (buffer
, " is ");
3024 /* Check whether we have an Ada interface compatible class.
3025 That is only have a vtable non-static data member and no
3026 non-abstract methods. */
3028 && RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
)))
3030 bool has_fields
= false;
3032 /* Check that there are no fields other than the virtual table. */
3033 for (tree fld
= TYPE_FIELDS (TREE_TYPE (t
));
3035 fld
= TREE_CHAIN (fld
))
3037 if (TREE_CODE (fld
) == FIELD_DECL
)
3039 if (!has_fields
&& DECL_VIRTUAL_P (fld
))
3040 is_interface
= true;
3042 is_interface
= false;
3045 else if (TREE_CODE (fld
) == FUNCTION_DECL
3046 && !DECL_ARTIFICIAL (fld
))
3048 if (cpp_check (fld
, IS_ABSTRACT
))
3049 is_abstract_record
= true;
3051 is_interface
= false;
3056 TREE_VISITED (t
) = 1;
3059 pp_string (buffer
, "limited interface; -- ");
3060 dump_sloc (buffer
, t
);
3061 newline_and_indent (buffer
, spc
);
3062 pp_string (buffer
, "pragma Import (CPP, ");
3063 dump_ada_node (buffer
, TYPE_NAME (TREE_TYPE (t
)), type
, spc
, false,
3065 pp_right_paren (buffer
);
3067 dump_ada_methods (buffer
, TREE_TYPE (t
), spc
);
3071 if (is_abstract_record
)
3072 pp_string (buffer
, "abstract ");
3073 dump_ada_node (buffer
, t
, t
, spc
, false, false);
3081 if (TREE_CODE (t
) == FIELD_DECL
&& DECL_NAME (t
))
3082 check_name (buffer
, t
);
3084 /* Print variable/type's name. */
3085 dump_ada_node (buffer
, t
, t
, spc
, false, true);
3087 if (TREE_CODE (t
) == TYPE_DECL
)
3089 const bool is_subtype
= TYPE_NAME (orig
);
3091 if (!is_subtype
&& TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
)
3092 pp_string (buffer
, " (discr : unsigned := 0)");
3094 pp_string (buffer
, " is ");
3096 dump_ada_node (buffer
, orig
, t
, spc
, false, is_subtype
);
3100 if (spc
== INDENT_INCR
|| TREE_STATIC (t
))
3103 pp_string (buffer
, " : ");
3105 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
))
3106 || TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
)
3108 if (TYPE_NAME (TREE_TYPE (t
))
3109 || TREE_CODE (TREE_TYPE (t
)) != ENUMERAL_TYPE
)
3110 pp_string (buffer
, "aliased ");
3112 if (TREE_READONLY (t
) && TREE_CODE (t
) != FIELD_DECL
)
3113 pp_string (buffer
, "constant ");
3115 if (TYPE_NAME (TREE_TYPE (t
)))
3116 dump_ada_node (buffer
, TREE_TYPE (t
), t
, spc
, false, true);
3118 dump_ada_double_name (buffer
, type
, t
);
3122 if (TREE_CODE (TREE_TYPE (t
)) != POINTER_TYPE
3123 && (TYPE_NAME (TREE_TYPE (t
))
3124 || TREE_CODE (TREE_TYPE (t
)) != INTEGER_TYPE
))
3125 pp_string (buffer
, "aliased ");
3127 if (TREE_READONLY (t
) && TREE_CODE (t
) != FIELD_DECL
)
3128 pp_string (buffer
, "constant ");
3130 dump_ada_node (buffer
, TREE_TYPE (t
), t
, spc
, false, true);
3138 newline_and_indent (buffer
, spc
);
3139 pp_string (buffer
, "end;");
3140 newline_and_indent (buffer
, spc
);
3141 pp_string (buffer
, "use Class_");
3142 dump_ada_node (buffer
, t
, type
, spc
, false, true);
3143 pp_semicolon (buffer
);
3144 pp_newline (buffer
);
3146 /* All needed indentation/newline performed already, so return 0. */
3151 pp_string (buffer
, "; -- ");
3152 dump_sloc (buffer
, t
);
3157 newline_and_indent (buffer
, spc
);
3158 dump_ada_import (buffer
, t
);
3164 /* Dump in BUFFER a structure NODE of type TYPE: name, fields, and methods
3165 in Ada syntax. SPC is the indentation level. If DISPLAY_CONVENTION is
3166 true, also print the pragma Convention for NODE. */
3169 dump_ada_structure (pretty_printer
*buffer
, tree node
, tree type
, int spc
,
3170 bool display_convention
)
3172 const bool is_union
= (TREE_CODE (node
) == UNION_TYPE
);
3175 int field_spc
= spc
+ INDENT_INCR
;
3178 bitfield_used
= false;
3180 /* Print the contents of the structure. */
3181 pp_string (buffer
, "record");
3185 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
3186 pp_string (buffer
, "case discr is");
3187 field_spc
= spc
+ INDENT_INCR
* 3;
3190 pp_newline (buffer
);
3192 /* Print the non-static fields of the structure. */
3193 for (tree tmp
= TYPE_FIELDS (node
); tmp
; tmp
= TREE_CHAIN (tmp
))
3195 /* Add parent field if needed. */
3196 if (!DECL_NAME (tmp
))
3198 if (!is_tagged_type (TREE_TYPE (tmp
)))
3200 if (!TYPE_NAME (TREE_TYPE (tmp
)))
3201 dump_ada_declaration (buffer
, tmp
, type
, field_spc
);
3207 pp_string (buffer
, "parent : aliased ");
3210 sprintf (buf
, "field_%d : aliased ", field_num
+ 1);
3211 pp_string (buffer
, buf
);
3213 dump_ada_decl_name (buffer
, TYPE_NAME (TREE_TYPE (tmp
)),
3215 pp_semicolon (buffer
);
3218 pp_newline (buffer
);
3222 else if (TREE_CODE (tmp
) == FIELD_DECL
)
3224 /* Skip internal virtual table field. */
3225 if (!DECL_VIRTUAL_P (tmp
))
3229 if (TREE_CHAIN (tmp
)
3230 && TREE_TYPE (TREE_CHAIN (tmp
)) != node
3231 && TREE_CODE (TREE_CHAIN (tmp
)) != TYPE_DECL
)
3232 sprintf (buf
, "when %d =>", field_num
);
3234 sprintf (buf
, "when others =>");
3236 INDENT (spc
+ INDENT_INCR
* 2);
3237 pp_string (buffer
, buf
);
3238 pp_newline (buffer
);
3241 if (dump_ada_declaration (buffer
, tmp
, type
, field_spc
))
3243 pp_newline (buffer
);
3252 INDENT (spc
+ INDENT_INCR
);
3253 pp_string (buffer
, "end case;");
3254 pp_newline (buffer
);
3259 INDENT (spc
+ INDENT_INCR
);
3260 pp_string (buffer
, "null;");
3261 pp_newline (buffer
);
3265 pp_string (buffer
, "end record;");
3267 newline_and_indent (buffer
, spc
);
3269 if (!display_convention
)
3272 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (type
)))
3274 if (has_nontrivial_methods (TREE_TYPE (type
)))
3275 pp_string (buffer
, "pragma Import (CPP, ");
3277 pp_string (buffer
, "pragma Convention (C_Pass_By_Copy, ");
3280 pp_string (buffer
, "pragma Convention (C, ");
3282 package_prefix
= false;
3283 dump_ada_node (buffer
, TREE_TYPE (type
), type
, spc
, false, true);
3284 package_prefix
= true;
3285 pp_right_paren (buffer
);
3289 pp_semicolon (buffer
);
3290 newline_and_indent (buffer
, spc
);
3291 pp_string (buffer
, "pragma Unchecked_Union (");
3293 dump_ada_node (buffer
, TREE_TYPE (type
), type
, spc
, false, true);
3294 pp_right_paren (buffer
);
3299 pp_semicolon (buffer
);
3300 newline_and_indent (buffer
, spc
);
3301 pp_string (buffer
, "pragma Pack (");
3302 dump_ada_node (buffer
, TREE_TYPE (type
), type
, spc
, false, true);
3303 pp_right_paren (buffer
);
3304 bitfield_used
= false;
3307 need_semicolon
= !dump_ada_methods (buffer
, node
, spc
);
3309 /* Print the static fields of the structure, if any. */
3310 for (tree tmp
= TYPE_FIELDS (node
); tmp
; tmp
= TREE_CHAIN (tmp
))
3312 if (TREE_CODE (tmp
) == VAR_DECL
&& DECL_NAME (tmp
))
3316 need_semicolon
= false;
3317 pp_semicolon (buffer
);
3319 pp_newline (buffer
);
3320 pp_newline (buffer
);
3321 dump_ada_declaration (buffer
, tmp
, type
, spc
);
3326 /* Dump all the declarations in SOURCE_FILE to an Ada spec.
3327 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3328 nodes for SOURCE_FILE. CHECK is used to perform C++ queries on nodes. */
3331 dump_ads (const char *source_file
,
3332 void (*collect_all_refs
)(const char *),
3333 int (*check
)(tree
, cpp_operation
))
3340 pkg_name
= get_ada_package (source_file
);
3342 /* Construct the .ads filename and package name. */
3343 ads_name
= xstrdup (pkg_name
);
3345 for (s
= ads_name
; *s
; s
++)
3351 ads_name
= reconcat (ads_name
, ads_name
, ".ads", NULL
);
3353 /* Write out the .ads file. */
3354 f
= fopen (ads_name
, "w");
3359 pp_needs_newline (&pp
) = true;
3360 pp
.buffer
->stream
= f
;
3362 /* Dump all relevant macros. */
3363 dump_ada_macros (&pp
, source_file
);
3365 /* Reset the table of withs for this file. */
3368 (*collect_all_refs
) (source_file
);
3370 /* Dump all references. */
3372 dump_ada_nodes (&pp
, source_file
);
3374 /* Requires Ada 2005 syntax, so generate corresponding pragma.
3375 Also, disable style checks since this file is auto-generated. */
3376 fprintf (f
, "pragma Ada_2005;\npragma Style_Checks (Off);\n\n");
3381 fprintf (f
, "\npackage %s is\n\n", pkg_name
);
3382 pp_write_text_to_stream (&pp
);
3383 /* ??? need to free pp */
3384 fprintf (f
, "end %s;\n", pkg_name
);
3392 static const char **source_refs
= NULL
;
3393 static int source_refs_used
= 0;
3394 static int source_refs_allocd
= 0;
3396 /* Add an entry for FILENAME to the table SOURCE_REFS. */
3399 collect_source_ref (const char *filename
)
3406 if (source_refs_allocd
== 0)
3408 source_refs_allocd
= 1024;
3409 source_refs
= XNEWVEC (const char *, source_refs_allocd
);
3412 for (i
= 0; i
< source_refs_used
; i
++)
3413 if (filename
== source_refs
[i
])
3416 if (source_refs_used
== source_refs_allocd
)
3418 source_refs_allocd
*= 2;
3419 source_refs
= XRESIZEVEC (const char *, source_refs
, source_refs_allocd
);
3422 source_refs
[source_refs_used
++] = filename
;
3425 /* Main entry point: dump all Ada specs corresponding to SOURCE_REFS
3426 using callbacks COLLECT_ALL_REFS and CHECK.
3427 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3428 nodes for a given source file.
3429 CHECK is used to perform C++ queries on nodes, or NULL for the C
3433 dump_ada_specs (void (*collect_all_refs
)(const char *),
3434 int (*check
)(tree
, cpp_operation
))
3436 /* Iterate over the list of files to dump specs for. */
3437 for (int i
= 0; i
< source_refs_used
; i
++)
3438 dump_ads (source_refs
[i
], collect_all_refs
, check
);
3440 /* Free various tables. */
3442 delete overloaded_names
;