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-2017 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_generic_ada_node (pretty_printer
*, tree
, tree
, int, int,
37 static int print_ada_declaration (pretty_printer
*, tree
, tree
, int);
38 static void print_ada_struct_decl (pretty_printer
*, tree
, tree
, int, bool);
39 static void dump_sloc (pretty_printer
*buffer
, tree node
);
40 static void print_comment (pretty_printer
*, const char *);
41 static void print_generic_ada_decl (pretty_printer
*, tree
, const char *);
42 static char *get_ada_package (const char *);
43 static void dump_ada_nodes (pretty_printer
*, const char *);
44 static void reset_ada_withs (void);
45 static void dump_ada_withs (FILE *);
46 static void dump_ads (const char *, void (*)(const char *),
47 int (*)(tree
, cpp_operation
));
48 static char *to_ada_name (const char *, int *);
49 static bool separate_class_package (tree
);
51 #define INDENT(SPACE) \
52 do { int i; for (i = 0; i<SPACE; i++) pp_space (buffer); } while (0)
56 /* Global hook used to perform C++ queries on nodes. */
57 static int (*cpp_check
) (tree
, cpp_operation
) = NULL
;
60 /* Given a cpp MACRO, compute the max length BUFFER_LEN of the macro, as well
61 as max length PARAM_LEN of arguments for fun_like macros, and also set
62 SUPPORTED to 0 if the macro cannot be mapped to an Ada construct. */
65 macro_length (const cpp_macro
*macro
, int *supported
, int *buffer_len
,
78 for (i
= 0; i
< macro
->paramc
; i
++)
80 cpp_hashnode
*param
= macro
->params
[i
];
82 *param_len
+= NODE_LEN (param
);
84 if (i
+ 1 < macro
->paramc
)
86 *param_len
+= 2; /* ", " */
88 else if (macro
->variadic
)
94 *param_len
+= 2; /* ")\0" */
97 for (j
= 0; j
< macro
->count
; j
++)
99 cpp_token
*token
= ¯o
->exp
.tokens
[j
];
101 if (token
->flags
& PREV_WHITE
)
104 if (token
->flags
& STRINGIFY_ARG
|| token
->flags
& PASTE_LEFT
)
110 if (token
->type
== CPP_MACRO_ARG
)
112 NODE_LEN (macro
->params
[token
->val
.macro_arg
.arg_no
- 1]);
114 /* Include enough extra space to handle e.g. special characters. */
115 *buffer_len
+= (cpp_token_len (token
) + 1) * 8;
121 /* Dump all digits/hex chars from NUMBER to BUFFER and return a pointer
122 to the character after the last character written. */
124 static unsigned char *
125 dump_number (unsigned char *number
, unsigned char *buffer
)
127 while (*number
!= '\0'
132 *buffer
++ = *number
++;
137 /* Handle escape character C and convert to an Ada character into BUFFER.
138 Return a pointer to the character after the last character written, or
139 NULL if the escape character is not supported. */
141 static unsigned char *
142 handle_escape_character (unsigned char *buffer
, char c
)
152 strcpy ((char *) buffer
, "\" & ASCII.LF & \"");
157 strcpy ((char *) buffer
, "\" & ASCII.CR & \"");
162 strcpy ((char *) buffer
, "\" & ASCII.HT & \"");
173 /* Dump into PP a set of MAX_ADA_MACROS MACROS (C/C++) as Ada constants when
177 print_ada_macros (pretty_printer
*pp
, cpp_hashnode
**macros
, int max_ada_macros
)
179 int j
, num_macros
= 0, prev_line
= -1;
181 for (j
= 0; j
< max_ada_macros
; j
++)
183 cpp_hashnode
*node
= macros
[j
];
184 const cpp_macro
*macro
= node
->value
.macro
;
186 int supported
= 1, prev_is_one
= 0, buffer_len
, param_len
;
187 int is_string
= 0, is_char
= 0;
189 unsigned char *s
, *params
, *buffer
, *buf_param
, *char_one
= NULL
, *tmp
;
191 macro_length (macro
, &supported
, &buffer_len
, ¶m_len
);
192 s
= buffer
= XALLOCAVEC (unsigned char, buffer_len
);
193 params
= buf_param
= XALLOCAVEC (unsigned char, param_len
);
200 for (i
= 0; i
< macro
->paramc
; i
++)
202 cpp_hashnode
*param
= macro
->params
[i
];
204 memcpy (buf_param
, NODE_NAME (param
), NODE_LEN (param
));
205 buf_param
+= NODE_LEN (param
);
207 if (i
+ 1 < macro
->paramc
)
212 else if (macro
->variadic
)
222 for (i
= 0; supported
&& i
< macro
->count
; i
++)
224 cpp_token
*token
= ¯o
->exp
.tokens
[i
];
227 if (token
->flags
& PREV_WHITE
)
230 if (token
->flags
& STRINGIFY_ARG
|| token
->flags
& PASTE_LEFT
)
240 cpp_hashnode
*param
=
241 macro
->params
[token
->val
.macro_arg
.arg_no
- 1];
242 memcpy (buffer
, NODE_NAME (param
), NODE_LEN (param
));
243 buffer
+= NODE_LEN (param
);
247 case CPP_EQ_EQ
: *buffer
++ = '='; break;
248 case CPP_GREATER
: *buffer
++ = '>'; break;
249 case CPP_LESS
: *buffer
++ = '<'; break;
250 case CPP_PLUS
: *buffer
++ = '+'; break;
251 case CPP_MINUS
: *buffer
++ = '-'; break;
252 case CPP_MULT
: *buffer
++ = '*'; break;
253 case CPP_DIV
: *buffer
++ = '/'; break;
254 case CPP_COMMA
: *buffer
++ = ','; break;
255 case CPP_OPEN_SQUARE
:
256 case CPP_OPEN_PAREN
: *buffer
++ = '('; break;
257 case CPP_CLOSE_SQUARE
: /* fallthrough */
258 case CPP_CLOSE_PAREN
: *buffer
++ = ')'; break;
259 case CPP_DEREF
: /* fallthrough */
260 case CPP_SCOPE
: /* fallthrough */
261 case CPP_DOT
: *buffer
++ = '.'; break;
263 case CPP_EQ
: *buffer
++ = ':'; *buffer
++ = '='; break;
264 case CPP_NOT_EQ
: *buffer
++ = '/'; *buffer
++ = '='; break;
265 case CPP_GREATER_EQ
: *buffer
++ = '>'; *buffer
++ = '='; break;
266 case CPP_LESS_EQ
: *buffer
++ = '<'; *buffer
++ = '='; break;
269 *buffer
++ = 'n'; *buffer
++ = 'o'; *buffer
++ = 't'; break;
271 *buffer
++ = 'm'; *buffer
++ = 'o'; *buffer
++ = 'd'; break;
273 *buffer
++ = 'a'; *buffer
++ = 'n'; *buffer
++ = 'd'; break;
275 *buffer
++ = 'o'; *buffer
++ = 'r'; break;
277 *buffer
++ = 'x'; *buffer
++ = 'o'; *buffer
++ = 'r'; break;
279 strcpy ((char *) buffer
, " and then ");
283 strcpy ((char *) buffer
, " or else ");
289 is_one
= prev_is_one
;
292 case CPP_COMMENT
: break;
303 if (!macro
->fun_like
)
306 buffer
= cpp_spell_token (parse_in
, token
, buffer
, false);
312 const unsigned char *s
= token
->val
.str
.text
;
318 buffer
= handle_escape_character (buffer
, *s
);
337 c
= cpp_interpret_charconst (parse_in
, token
,
338 &chars_seen
, &ignored
);
339 if (c
>= 32 && c
<= 126)
342 *buffer
++ = (char) c
;
348 ((char *) buffer
, "Character'Val (%d)", (int) c
);
349 buffer
+= chars_seen
;
355 tmp
= cpp_token_as_text (parse_in
, token
);
375 buffer
= dump_number (tmp
+ 2, buffer
);
383 buffer
= dump_number (tmp
+ 2, buffer
);
388 /* Dump floating constants unmodified. */
389 if (strchr ((const char *)tmp
, '.'))
390 buffer
= dump_number (tmp
, buffer
);
395 buffer
= dump_number (tmp
+ 1, buffer
);
403 if (tmp
[1] == '\0' || tmp
[1] == 'l' || tmp
[1] == 'u'
404 || tmp
[1] == 'L' || tmp
[1] == 'U')
411 buffer
= dump_number (tmp
, buffer
);
415 buffer
= dump_number (tmp
, buffer
);
423 /* Replace "1 << N" by "2 ** N" */
450 case CPP_CLOSE_BRACE
:
454 case CPP_MINUS_MINUS
:
458 case CPP_HEADER_NAME
:
461 case CPP_OBJC_STRING
:
463 if (!macro
->fun_like
)
466 buffer
= cpp_spell_token (parse_in
, token
, buffer
, false);
470 prev_is_one
= is_one
;
477 if (macro
->fun_like
&& supported
)
479 char *start
= (char *) s
;
482 pp_string (pp
, " -- arg-macro: ");
484 if (*start
== '(' && buffer
[-1] == ')')
489 pp_string (pp
, "function ");
493 pp_string (pp
, "procedure ");
496 pp_string (pp
, (const char *) NODE_NAME (node
));
498 pp_string (pp
, (char *) params
);
500 pp_string (pp
, " -- ");
504 pp_string (pp
, "return ");
505 pp_string (pp
, start
);
509 pp_string (pp
, start
);
515 expanded_location sloc
= expand_location (macro
->line
);
517 if (sloc
.line
!= prev_line
+ 1 && prev_line
> 0)
521 prev_line
= sloc
.line
;
524 ada_name
= to_ada_name ((const char *) NODE_NAME (node
), NULL
);
525 pp_string (pp
, ada_name
);
527 pp_string (pp
, " : ");
530 pp_string (pp
, "aliased constant String");
532 pp_string (pp
, "aliased constant Character");
534 pp_string (pp
, "constant");
536 pp_string (pp
, " := ");
537 pp_string (pp
, (char *) s
);
540 pp_string (pp
, " & ASCII.NUL");
542 pp_string (pp
, "; -- ");
543 pp_string (pp
, sloc
.file
);
545 pp_scalar (pp
, "%d", sloc
.line
);
550 pp_string (pp
, " -- unsupported macro: ");
551 pp_string (pp
, (const char *) cpp_macro_definition (parse_in
, node
));
560 static const char *source_file
;
561 static int max_ada_macros
;
563 /* Callback used to count the number of relevant macros from
564 cpp_forall_identifiers. PFILE and V are not used. NODE is the current macro
568 count_ada_macro (cpp_reader
*pfile ATTRIBUTE_UNUSED
, cpp_hashnode
*node
,
569 void *v ATTRIBUTE_UNUSED
)
571 const cpp_macro
*macro
= node
->value
.macro
;
573 if (node
->type
== NT_MACRO
&& !(node
->flags
& NODE_BUILTIN
)
575 && *NODE_NAME (node
) != '_'
576 && LOCATION_FILE (macro
->line
) == source_file
)
582 static int store_ada_macro_index
;
584 /* Callback used to store relevant macros from cpp_forall_identifiers.
585 PFILE is not used. NODE is the current macro to store if relevant.
586 MACROS is an array of cpp_hashnode* used to store NODE. */
589 store_ada_macro (cpp_reader
*pfile ATTRIBUTE_UNUSED
,
590 cpp_hashnode
*node
, void *macros
)
592 const cpp_macro
*macro
= node
->value
.macro
;
594 if (node
->type
== NT_MACRO
&& !(node
->flags
& NODE_BUILTIN
)
596 && *NODE_NAME (node
) != '_'
597 && LOCATION_FILE (macro
->line
) == source_file
)
598 ((cpp_hashnode
**) macros
)[store_ada_macro_index
++] = node
;
603 /* Callback used to compare (during qsort) macros. NODE1 and NODE2 are the
604 two macro nodes to compare. */
607 compare_macro (const void *node1
, const void *node2
)
609 typedef const cpp_hashnode
*const_hnode
;
611 const_hnode n1
= *(const const_hnode
*) node1
;
612 const_hnode n2
= *(const const_hnode
*) node2
;
614 return n1
->value
.macro
->line
- n2
->value
.macro
->line
;
617 /* Dump in PP all relevant macros appearing in FILE. */
620 dump_ada_macros (pretty_printer
*pp
, const char* file
)
622 cpp_hashnode
**macros
;
624 /* Initialize file-scope variables. */
626 store_ada_macro_index
= 0;
629 /* Count all potentially relevant macros, and then sort them by sloc. */
630 cpp_forall_identifiers (parse_in
, count_ada_macro
, NULL
);
631 macros
= XALLOCAVEC (cpp_hashnode
*, max_ada_macros
);
632 cpp_forall_identifiers (parse_in
, store_ada_macro
, macros
);
633 qsort (macros
, max_ada_macros
, sizeof (cpp_hashnode
*), compare_macro
);
635 print_ada_macros (pp
, macros
, max_ada_macros
);
638 /* Current source file being handled. */
640 static const char *source_file_base
;
642 /* Return sloc of DECL, using sloc of last field if LAST is true. */
645 decl_sloc (const_tree decl
, bool last
)
649 /* Compare the declaration of struct-like types based on the sloc of their
650 last field (if LAST is true), so that more nested types collate before
652 if (TREE_CODE (decl
) == TYPE_DECL
653 && !DECL_ORIGINAL_TYPE (decl
)
654 && RECORD_OR_UNION_TYPE_P (TREE_TYPE (decl
))
655 && (field
= TYPE_FIELDS (TREE_TYPE (decl
))))
658 while (DECL_CHAIN (field
))
659 field
= DECL_CHAIN (field
);
660 return DECL_SOURCE_LOCATION (field
);
663 return DECL_SOURCE_LOCATION (decl
);
666 /* Compare two locations LHS and RHS. */
669 compare_location (location_t lhs
, location_t rhs
)
671 expanded_location xlhs
= expand_location (lhs
);
672 expanded_location xrhs
= expand_location (rhs
);
674 if (xlhs
.file
!= xrhs
.file
)
675 return filename_cmp (xlhs
.file
, xrhs
.file
);
677 if (xlhs
.line
!= xrhs
.line
)
678 return xlhs
.line
- xrhs
.line
;
680 if (xlhs
.column
!= xrhs
.column
)
681 return xlhs
.column
- xrhs
.column
;
686 /* Compare two declarations (LP and RP) by their source location. */
689 compare_node (const void *lp
, const void *rp
)
691 const_tree lhs
= *((const tree
*) lp
);
692 const_tree rhs
= *((const tree
*) rp
);
694 return compare_location (decl_sloc (lhs
, true), decl_sloc (rhs
, true));
697 /* Compare two comments (LP and RP) by their source location. */
700 compare_comment (const void *lp
, const void *rp
)
702 const cpp_comment
*lhs
= (const cpp_comment
*) lp
;
703 const cpp_comment
*rhs
= (const cpp_comment
*) rp
;
705 return compare_location (lhs
->sloc
, rhs
->sloc
);
708 static tree
*to_dump
= NULL
;
709 static int to_dump_count
= 0;
711 /* Collect a list of declarations from T relevant to SOURCE_FILE to be dumped
712 by a subsequent call to dump_ada_nodes. */
715 collect_ada_nodes (tree t
, const char *source_file
)
718 int i
= to_dump_count
;
720 /* Count the likely relevant nodes: do not dump builtins (they are irrelevant
721 in the context of bindings) and namespaces (we do not handle them properly
723 for (n
= t
; n
; n
= TREE_CHAIN (n
))
724 if (!DECL_IS_BUILTIN (n
)
725 && TREE_CODE (n
) != NAMESPACE_DECL
726 && LOCATION_FILE (decl_sloc (n
, false)) == source_file
)
729 /* Allocate sufficient storage for all nodes. */
730 to_dump
= XRESIZEVEC (tree
, to_dump
, to_dump_count
);
732 /* Store the relevant nodes. */
733 for (n
= t
; n
; n
= TREE_CHAIN (n
))
734 if (!DECL_IS_BUILTIN (n
)
735 && TREE_CODE (n
) != NAMESPACE_DECL
736 && LOCATION_FILE (decl_sloc (n
, false)) == source_file
)
740 /* Call back for walk_tree to clear the TREE_VISITED flag of TP. */
743 unmark_visited_r (tree
*tp
, int *walk_subtrees ATTRIBUTE_UNUSED
,
744 void *data ATTRIBUTE_UNUSED
)
746 if (TREE_VISITED (*tp
))
747 TREE_VISITED (*tp
) = 0;
754 /* Dump nodes into PP relevant to SOURCE_FILE, as collected by previous calls
755 to collect_ada_nodes. */
758 dump_ada_nodes (pretty_printer
*pp
, const char *source_file
)
761 cpp_comment_table
*comments
;
763 /* Sort the table of declarations to dump by sloc. */
764 qsort (to_dump
, to_dump_count
, sizeof (tree
), compare_node
);
766 /* Fetch the table of comments. */
767 comments
= cpp_get_comments (parse_in
);
769 /* Sort the comments table by sloc. */
770 if (comments
->count
> 1)
771 qsort (comments
->entries
, comments
->count
, sizeof (cpp_comment
),
774 /* Interleave comments and declarations in line number order. */
778 /* Advance j until comment j is in this file. */
779 while (j
!= comments
->count
780 && LOCATION_FILE (comments
->entries
[j
].sloc
) != source_file
)
783 /* Advance j until comment j is not a duplicate. */
784 while (j
< comments
->count
- 1
785 && !compare_comment (&comments
->entries
[j
],
786 &comments
->entries
[j
+ 1]))
789 /* Write decls until decl i collates after comment j. */
790 while (i
!= to_dump_count
)
792 if (j
== comments
->count
793 || LOCATION_LINE (decl_sloc (to_dump
[i
], false))
794 < LOCATION_LINE (comments
->entries
[j
].sloc
))
795 print_generic_ada_decl (pp
, to_dump
[i
++], source_file
);
800 /* Write comment j, if there is one. */
801 if (j
!= comments
->count
)
802 print_comment (pp
, comments
->entries
[j
++].comment
);
804 } while (i
!= to_dump_count
|| j
!= comments
->count
);
806 /* Clear the TREE_VISITED flag over each subtree we've dumped. */
807 for (i
= 0; i
< to_dump_count
; i
++)
808 walk_tree (&to_dump
[i
], unmark_visited_r
, NULL
, NULL
);
810 /* Finalize the to_dump table. */
819 /* Print a COMMENT to the output stream PP. */
822 print_comment (pretty_printer
*pp
, const char *comment
)
824 int len
= strlen (comment
);
825 char *str
= XALLOCAVEC (char, len
+ 1);
827 bool extra_newline
= false;
829 memcpy (str
, comment
, len
+ 1);
831 /* Trim C/C++ comment indicators. */
832 if (str
[len
- 2] == '*' && str
[len
- 1] == '/')
839 tok
= strtok (str
, "\n");
841 pp_string (pp
, " --");
844 tok
= strtok (NULL
, "\n");
846 /* Leave a blank line after multi-line comments. */
848 extra_newline
= true;
855 /* Print declaration DECL to PP in Ada syntax. The current source file being
856 handled is SOURCE_FILE. */
859 print_generic_ada_decl (pretty_printer
*pp
, tree decl
, const char *source_file
)
861 source_file_base
= source_file
;
863 if (print_ada_declaration (pp
, decl
, NULL_TREE
, INDENT_INCR
))
870 /* Dump a newline and indent BUFFER by SPC chars. */
873 newline_and_indent (pretty_printer
*buffer
, int spc
)
879 struct with
{ char *s
; const char *in_file
; int limited
; };
880 static struct with
*withs
= NULL
;
881 static int withs_max
= 4096;
882 static int with_len
= 0;
884 /* Record a "with" clause on package S (a limited with if LIMITED_ACCESS is
885 true), if not already done. */
888 append_withs (const char *s
, int limited_access
)
893 withs
= XNEWVEC (struct with
, withs_max
);
895 if (with_len
== withs_max
)
898 withs
= XRESIZEVEC (struct with
, withs
, withs_max
);
901 for (i
= 0; i
< with_len
; i
++)
902 if (!strcmp (s
, withs
[i
].s
)
903 && source_file_base
== withs
[i
].in_file
)
905 withs
[i
].limited
&= limited_access
;
909 withs
[with_len
].s
= xstrdup (s
);
910 withs
[with_len
].in_file
= source_file_base
;
911 withs
[with_len
].limited
= limited_access
;
915 /* Reset "with" clauses. */
918 reset_ada_withs (void)
925 for (i
= 0; i
< with_len
; i
++)
933 /* Dump "with" clauses in F. */
936 dump_ada_withs (FILE *f
)
940 fprintf (f
, "with Interfaces.C; use Interfaces.C;\n");
942 for (i
= 0; i
< with_len
; i
++)
944 (f
, "%swith %s;\n", withs
[i
].limited
? "limited " : "", withs
[i
].s
);
947 /* Return suitable Ada package name from FILE. */
950 get_ada_package (const char *file
)
958 s
= strstr (file
, "/include/");
962 base
= lbasename (file
);
964 if (ada_specs_parent
== NULL
)
967 plen
= strlen (ada_specs_parent
) + 1;
969 res
= XNEWVEC (char, plen
+ strlen (base
) + 1);
970 if (ada_specs_parent
!= NULL
) {
971 strcpy (res
, ada_specs_parent
);
975 for (i
= plen
; *base
; base
++, i
++)
987 res
[i
] = (i
== 0 || res
[i
- 1] == '.' || res
[i
- 1] == '_') ? 'u' : '_';
999 static const char *ada_reserved
[] = {
1000 "abort", "abs", "abstract", "accept", "access", "aliased", "all", "and",
1001 "array", "at", "begin", "body", "case", "constant", "declare", "delay",
1002 "delta", "digits", "do", "else", "elsif", "end", "entry", "exception",
1003 "exit", "for", "function", "generic", "goto", "if", "in", "interface", "is",
1004 "limited", "loop", "mod", "new", "not", "null", "others", "out", "of", "or",
1005 "overriding", "package", "pragma", "private", "procedure", "protected",
1006 "raise", "range", "record", "rem", "renames", "requeue", "return", "reverse",
1007 "select", "separate", "subtype", "synchronized", "tagged", "task",
1008 "terminate", "then", "type", "until", "use", "when", "while", "with", "xor",
1011 /* ??? would be nice to specify this list via a config file, so that users
1012 can create their own dictionary of conflicts. */
1013 static const char *c_duplicates
[] = {
1014 /* system will cause troubles with System.Address. */
1017 /* The following values have other definitions with same name/other
1023 "rl_readline_version",
1029 /* Return a declaration tree corresponding to TYPE. */
1032 get_underlying_decl (tree type
)
1037 /* type is a declaration. */
1041 /* type is a typedef. */
1042 if (TYPE_P (type
) && TYPE_NAME (type
) && DECL_P (TYPE_NAME (type
)))
1043 return TYPE_NAME (type
);
1045 /* TYPE_STUB_DECL has been set for type. */
1046 if (TYPE_P (type
) && TYPE_STUB_DECL (type
))
1047 return TYPE_STUB_DECL (type
);
1052 /* Return whether TYPE has static fields. */
1055 has_static_fields (const_tree type
)
1057 if (!type
|| !RECORD_OR_UNION_TYPE_P (type
))
1060 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= TREE_CHAIN (fld
))
1061 if (TREE_CODE (fld
) == VAR_DECL
&& DECL_NAME (fld
))
1067 /* Return whether TYPE corresponds to an Ada tagged type (has a dispatch
1071 is_tagged_type (const_tree type
)
1073 if (!type
|| !RECORD_OR_UNION_TYPE_P (type
))
1076 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= TREE_CHAIN (fld
))
1077 if (TREE_CODE (fld
) == FUNCTION_DECL
&& DECL_VINDEX (fld
))
1083 /* Return whether TYPE has non-trivial methods, i.e. methods that do something
1084 for the objects of TYPE. In C++, all classes have implicit special methods,
1085 e.g. constructors and destructors, but they can be trivial if the type is
1086 sufficiently simple. */
1089 has_nontrivial_methods (tree type
)
1091 if (!type
|| !RECORD_OR_UNION_TYPE_P (type
))
1094 /* Only C++ types can have methods. */
1098 /* A non-trivial type has non-trivial special methods. */
1099 if (!cpp_check (type
, IS_TRIVIAL
))
1102 /* If there are user-defined methods, they are deemed non-trivial. */
1103 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= DECL_CHAIN (fld
))
1104 if (TREE_CODE (fld
) == FUNCTION_DECL
&& !DECL_ARTIFICIAL (fld
))
1110 /* Generate a legal Ada name from a C NAME, returning a malloc'd string.
1111 SPACE_FOUND, if not NULL, is used to indicate whether a space was found in
1115 to_ada_name (const char *name
, int *space_found
)
1118 int len
= strlen (name
);
1121 char *s
= XNEWVEC (char, len
* 2 + 5);
1125 *space_found
= false;
1127 /* Add trailing "c_" if name is an Ada reserved word. */
1128 for (names
= ada_reserved
; *names
; names
++)
1129 if (!strcasecmp (name
, *names
))
1138 /* Add trailing "c_" if name is an potential case sensitive duplicate. */
1139 for (names
= c_duplicates
; *names
; names
++)
1140 if (!strcmp (name
, *names
))
1148 for (j
= 0; name
[j
] == '_'; j
++)
1153 else if (*name
== '.' || *name
== '$')
1163 /* Replace unsuitable characters for Ada identifiers. */
1165 for (; j
< len
; j
++)
1170 *space_found
= true;
1174 /* ??? missing some C++ operators. */
1178 if (name
[j
+ 1] == '=')
1193 if (name
[j
+ 1] == '=')
1211 s
[len2
++] = name
[j
] == '&' ? 'a' : name
[j
] == '|' ? 'o' : 'x';
1213 if (name
[j
+ 1] == '=')
1226 if (s
[len2
- 1] != '_')
1229 switch (name
[j
+ 1]) {
1232 switch (name
[j
- 1]) {
1233 case '+': s
[len2
++] = 'p'; break; /* + */
1234 case '-': s
[len2
++] = 'm'; break; /* - */
1235 case '*': s
[len2
++] = 't'; break; /* * */
1236 case '/': s
[len2
++] = 'd'; break; /* / */
1242 switch (name
[j
- 1]) {
1243 case '+': s
[len2
++] = 'p'; break; /* += */
1244 case '-': s
[len2
++] = 'm'; break; /* -= */
1245 case '*': s
[len2
++] = 't'; break; /* *= */
1246 case '/': s
[len2
++] = 'd'; break; /* /= */
1280 c
= name
[j
] == '<' ? 'l' : 'g';
1283 switch (name
[j
+ 1]) {
1309 if (len2
&& s
[len2
- 1] == '_')
1314 s
[len2
++] = name
[j
];
1317 if (s
[len2
- 1] == '_')
1325 /* Return true if DECL refers to a C++ class type for which a
1326 separate enclosing package has been or should be generated. */
1329 separate_class_package (tree decl
)
1331 tree type
= TREE_TYPE (decl
);
1332 return has_nontrivial_methods (type
) || has_static_fields (type
);
1335 static bool package_prefix
= true;
1337 /* Dump in BUFFER the name of an identifier NODE of type TYPE, following Ada
1338 syntax. LIMITED_ACCESS indicates whether NODE can be accessed via a limited
1339 'with' clause rather than a regular 'with' clause. */
1342 pp_ada_tree_identifier (pretty_printer
*buffer
, tree node
, tree type
,
1345 const char *name
= IDENTIFIER_POINTER (node
);
1346 int space_found
= false;
1347 char *s
= to_ada_name (name
, &space_found
);
1350 /* If the entity is a type and comes from another file, generate "package"
1352 decl
= get_underlying_decl (type
);
1356 expanded_location xloc
= expand_location (decl_sloc (decl
, false));
1358 if (xloc
.file
&& xloc
.line
)
1360 if (xloc
.file
!= source_file_base
)
1362 switch (TREE_CODE (type
))
1367 case FIXED_POINT_TYPE
:
1369 case REFERENCE_TYPE
:
1377 char *s1
= get_ada_package (xloc
.file
);
1378 append_withs (s1
, limited_access
);
1379 pp_string (buffer
, s1
);
1388 /* Generate the additional package prefix for C++ classes. */
1389 if (separate_class_package (decl
))
1391 pp_string (buffer
, "Class_");
1392 pp_string (buffer
, s
);
1400 if (!strcmp (s
, "short_int"))
1401 pp_string (buffer
, "short");
1402 else if (!strcmp (s
, "short_unsigned_int"))
1403 pp_string (buffer
, "unsigned_short");
1404 else if (!strcmp (s
, "unsigned_int"))
1405 pp_string (buffer
, "unsigned");
1406 else if (!strcmp (s
, "long_int"))
1407 pp_string (buffer
, "long");
1408 else if (!strcmp (s
, "long_unsigned_int"))
1409 pp_string (buffer
, "unsigned_long");
1410 else if (!strcmp (s
, "long_long_int"))
1411 pp_string (buffer
, "Long_Long_Integer");
1412 else if (!strcmp (s
, "long_long_unsigned_int"))
1416 append_withs ("Interfaces.C.Extensions", false);
1417 pp_string (buffer
, "Extensions.unsigned_long_long");
1420 pp_string (buffer
, "unsigned_long_long");
1423 pp_string(buffer
, s
);
1425 if (!strcmp (s
, "bool"))
1429 append_withs ("Interfaces.C.Extensions", false);
1430 pp_string (buffer
, "Extensions.bool");
1433 pp_string (buffer
, "bool");
1436 pp_string(buffer
, s
);
1441 /* Dump in BUFFER the assembly name of T. */
1444 pp_asm_name (pretty_printer
*buffer
, tree t
)
1446 tree name
= DECL_ASSEMBLER_NAME (t
);
1447 char *ada_name
= XALLOCAVEC (char, IDENTIFIER_LENGTH (name
) + 1), *s
;
1448 const char *ident
= IDENTIFIER_POINTER (name
);
1450 for (s
= ada_name
; *ident
; ident
++)
1454 else if (*ident
!= '*')
1459 pp_string (buffer
, ada_name
);
1462 /* Dump in BUFFER the name of a DECL node if set, following Ada syntax.
1463 LIMITED_ACCESS indicates whether NODE can be accessed via a limited
1464 'with' clause rather than a regular 'with' clause. */
1467 dump_ada_decl_name (pretty_printer
*buffer
, tree decl
, int limited_access
)
1469 if (DECL_NAME (decl
))
1470 pp_ada_tree_identifier (buffer
, DECL_NAME (decl
), decl
, limited_access
);
1473 tree type_name
= TYPE_NAME (TREE_TYPE (decl
));
1477 pp_string (buffer
, "anon");
1478 if (TREE_CODE (decl
) == FIELD_DECL
)
1479 pp_scalar (buffer
, "%d", DECL_UID (decl
));
1481 pp_scalar (buffer
, "%d", TYPE_UID (TREE_TYPE (decl
)));
1483 else if (TREE_CODE (type_name
) == IDENTIFIER_NODE
)
1484 pp_ada_tree_identifier (buffer
, type_name
, decl
, limited_access
);
1488 /* Dump in BUFFER a name based on both T1 and T2 followed by a suffix. */
1491 dump_ada_double_name (pretty_printer
*buffer
, tree t1
, tree t2
)
1494 pp_ada_tree_identifier (buffer
, DECL_NAME (t1
), t1
, false);
1497 pp_string (buffer
, "anon");
1498 pp_scalar (buffer
, "%d", TYPE_UID (TREE_TYPE (t1
)));
1501 pp_underscore (buffer
);
1504 pp_ada_tree_identifier (buffer
, DECL_NAME (t2
), t2
, false);
1507 pp_string (buffer
, "anon");
1508 pp_scalar (buffer
, "%d", TYPE_UID (TREE_TYPE (t2
)));
1511 switch (TREE_CODE (TREE_TYPE (t2
)))
1514 pp_string (buffer
, "_array");
1517 pp_string (buffer
, "_struct");
1520 pp_string (buffer
, "_union");
1523 pp_string (buffer
, "_unknown");
1528 /* Dump in BUFFER pragma Import C/CPP on a given node T. */
1531 dump_ada_import (pretty_printer
*buffer
, tree t
)
1533 const char *name
= IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (t
));
1534 int is_stdcall
= TREE_CODE (t
) == FUNCTION_DECL
&&
1535 lookup_attribute ("stdcall", TYPE_ATTRIBUTES (TREE_TYPE (t
)));
1538 pp_string (buffer
, "pragma Import (Stdcall, ");
1539 else if (name
[0] == '_' && name
[1] == 'Z')
1540 pp_string (buffer
, "pragma Import (CPP, ");
1542 pp_string (buffer
, "pragma Import (C, ");
1544 dump_ada_decl_name (buffer
, t
, false);
1545 pp_string (buffer
, ", \"");
1548 pp_string (buffer
, IDENTIFIER_POINTER (DECL_NAME (t
)));
1550 pp_asm_name (buffer
, t
);
1552 pp_string (buffer
, "\");");
1555 /* Check whether T and its type have different names, and append "the_"
1556 otherwise in BUFFER. */
1559 check_name (pretty_printer
*buffer
, tree t
)
1562 tree tmp
= TREE_TYPE (t
);
1564 while (TREE_CODE (tmp
) == POINTER_TYPE
&& !TYPE_NAME (tmp
))
1565 tmp
= TREE_TYPE (tmp
);
1567 if (TREE_CODE (tmp
) != FUNCTION_TYPE
)
1569 if (TREE_CODE (tmp
) == IDENTIFIER_NODE
)
1570 s
= IDENTIFIER_POINTER (tmp
);
1571 else if (!TYPE_NAME (tmp
))
1573 else if (TREE_CODE (TYPE_NAME (tmp
)) == IDENTIFIER_NODE
)
1574 s
= IDENTIFIER_POINTER (TYPE_NAME (tmp
));
1576 s
= IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp
)));
1578 if (!strcasecmp (IDENTIFIER_POINTER (DECL_NAME (t
)), s
))
1579 pp_string (buffer
, "the_");
1583 /* Dump in BUFFER a function declaration FUNC with Ada syntax.
1584 IS_METHOD indicates whether FUNC is a C++ method.
1585 IS_CONSTRUCTOR whether FUNC is a C++ constructor.
1586 IS_DESTRUCTOR whether FUNC is a C++ destructor.
1587 SPC is the current indentation level. */
1590 dump_ada_function_declaration (pretty_printer
*buffer
, tree func
,
1591 int is_method
, int is_constructor
,
1592 int is_destructor
, int spc
)
1595 const tree node
= TREE_TYPE (func
);
1597 int num
= 0, num_args
= 0, have_args
= true, have_ellipsis
= false;
1599 /* Compute number of arguments. */
1600 arg
= TYPE_ARG_TYPES (node
);
1604 while (TREE_CHAIN (arg
) && arg
!= error_mark_node
)
1607 arg
= TREE_CHAIN (arg
);
1610 if (TREE_CODE (TREE_VALUE (arg
)) != VOID_TYPE
)
1613 have_ellipsis
= true;
1624 newline_and_indent (buffer
, spc
+ 1);
1629 pp_left_paren (buffer
);
1632 if (TREE_CODE (func
) == FUNCTION_DECL
)
1633 arg
= DECL_ARGUMENTS (func
);
1637 if (arg
== NULL_TREE
)
1640 arg
= TYPE_ARG_TYPES (node
);
1642 if (arg
&& TREE_CODE (TREE_VALUE (arg
)) == VOID_TYPE
)
1647 arg
= TREE_CHAIN (arg
);
1649 /* Print the argument names (if available) & types. */
1651 for (num
= 1; num
<= num_args
; num
++)
1655 if (DECL_NAME (arg
))
1657 check_name (buffer
, arg
);
1658 pp_ada_tree_identifier (buffer
, DECL_NAME (arg
), NULL_TREE
,
1660 pp_string (buffer
, " : ");
1664 sprintf (buf
, "arg%d : ", num
);
1665 pp_string (buffer
, buf
);
1668 dump_generic_ada_node (buffer
, TREE_TYPE (arg
), node
, spc
, 0, true);
1672 sprintf (buf
, "arg%d : ", num
);
1673 pp_string (buffer
, buf
);
1674 dump_generic_ada_node (buffer
, TREE_VALUE (arg
), node
, spc
, 0, true);
1677 /* If the type is a pointer to a tagged type, we need to differentiate
1678 virtual methods from the rest (non-virtual methods, static member
1679 or regular functions) and import only them as primitive operations,
1680 because they make up the virtual table which is mirrored on the Ada
1681 side by the dispatch table. So we add 'Class to the type of every
1682 parameter that is not the first one of a method which either has a
1683 slot in the virtual table or is a constructor. */
1685 && POINTER_TYPE_P (TREE_TYPE (arg
))
1686 && is_tagged_type (TREE_TYPE (TREE_TYPE (arg
)))
1687 && !(num
== 1 && is_method
&& (DECL_VINDEX (func
) || is_constructor
)))
1688 pp_string (buffer
, "'Class");
1690 arg
= TREE_CHAIN (arg
);
1694 pp_semicolon (buffer
);
1697 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
1705 pp_string (buffer
, " -- , ...");
1706 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
1710 pp_right_paren (buffer
);
1714 /* Dump in BUFFER all the domains associated with an array NODE,
1715 using Ada syntax. SPC is the current indentation level. */
1718 dump_ada_array_domains (pretty_printer
*buffer
, tree node
, int spc
)
1721 pp_left_paren (buffer
);
1723 for (; TREE_CODE (node
) == ARRAY_TYPE
; node
= TREE_TYPE (node
))
1725 tree domain
= TYPE_DOMAIN (node
);
1729 tree min
= TYPE_MIN_VALUE (domain
);
1730 tree max
= TYPE_MAX_VALUE (domain
);
1733 pp_string (buffer
, ", ");
1737 dump_generic_ada_node (buffer
, min
, NULL_TREE
, spc
, 0, true);
1738 pp_string (buffer
, " .. ");
1740 /* If the upper bound is zero, gcc may generate a NULL_TREE
1741 for TYPE_MAX_VALUE rather than an integer_cst. */
1743 dump_generic_ada_node (buffer
, max
, NULL_TREE
, spc
, 0, true);
1745 pp_string (buffer
, "0");
1748 pp_string (buffer
, "size_t");
1750 pp_right_paren (buffer
);
1753 /* Dump in BUFFER file:line information related to NODE. */
1756 dump_sloc (pretty_printer
*buffer
, tree node
)
1758 expanded_location xloc
;
1763 xloc
= expand_location (DECL_SOURCE_LOCATION (node
));
1764 else if (EXPR_HAS_LOCATION (node
))
1765 xloc
= expand_location (EXPR_LOCATION (node
));
1769 pp_string (buffer
, xloc
.file
);
1771 pp_decimal_int (buffer
, xloc
.line
);
1775 /* Return true if T designates a one dimension array of "char". */
1778 is_char_array (tree t
)
1783 /* Retrieve array's type. */
1785 while (TREE_CODE (TREE_TYPE (tmp
)) == ARRAY_TYPE
)
1788 tmp
= TREE_TYPE (tmp
);
1791 tmp
= TREE_TYPE (tmp
);
1792 return num_dim
== 1 && TREE_CODE (tmp
) == INTEGER_TYPE
1793 && id_equal (DECL_NAME (TYPE_NAME (tmp
)), "char");
1796 /* Dump in BUFFER an array type T in Ada syntax. Assume that the "type"
1797 keyword and name have already been printed. PARENT is the parent node of T.
1798 SPC is the indentation level. */
1801 dump_ada_array_type (pretty_printer
*buffer
, tree t
, tree parent
, int spc
)
1803 const bool char_array
= is_char_array (t
);
1806 /* Special case char arrays. */
1809 pp_string (buffer
, "Interfaces.C.char_array ");
1812 pp_string (buffer
, "array ");
1814 /* Print the dimensions. */
1815 dump_ada_array_domains (buffer
, TREE_TYPE (t
), spc
);
1817 /* Retrieve the element type. */
1818 tmp
= TREE_TYPE (t
);
1819 while (TREE_CODE (tmp
) == ARRAY_TYPE
)
1820 tmp
= TREE_TYPE (tmp
);
1822 /* Print array's type. */
1825 pp_string (buffer
, " of ");
1827 if (TREE_CODE (tmp
) != POINTER_TYPE
)
1828 pp_string (buffer
, "aliased ");
1830 if (TYPE_NAME (tmp
) || !RECORD_OR_UNION_TYPE_P (tmp
))
1831 dump_generic_ada_node (buffer
, tmp
, TREE_TYPE (t
), spc
, false, true);
1833 dump_ada_double_name (buffer
, parent
, get_underlying_decl (tmp
));
1837 /* Dump in BUFFER type names associated with a template, each prepended with
1838 '_'. TYPES is the TREE_PURPOSE of a DECL_TEMPLATE_INSTANTIATIONS. SPC is
1839 the indentation level. */
1842 dump_template_types (pretty_printer
*buffer
, tree types
, int spc
)
1845 size_t len
= TREE_VEC_LENGTH (types
);
1847 for (i
= 0; i
< len
; i
++)
1849 tree elem
= TREE_VEC_ELT (types
, i
);
1850 pp_underscore (buffer
);
1851 if (!dump_generic_ada_node (buffer
, elem
, 0, spc
, false, true))
1853 pp_string (buffer
, "unknown");
1854 pp_scalar (buffer
, "%lu", (unsigned long) TREE_HASH (elem
));
1859 /* Dump in BUFFER the contents of all class instantiations associated with
1860 a given template T. SPC is the indentation level. */
1863 dump_ada_template (pretty_printer
*buffer
, tree t
, int spc
)
1865 /* DECL_SIZE_UNIT is DECL_TEMPLATE_INSTANTIATIONS in this context. */
1866 tree inst
= DECL_SIZE_UNIT (t
);
1867 /* This emulates DECL_TEMPLATE_RESULT in this context. */
1868 struct tree_template_decl
{
1869 struct tree_decl_common common
;
1873 tree result
= ((struct tree_template_decl
*) t
)->result
;
1876 /* Don't look at template declarations declaring something coming from
1877 another file. This can occur for template friend declarations. */
1878 if (LOCATION_FILE (decl_sloc (result
, false))
1879 != LOCATION_FILE (decl_sloc (t
, false)))
1882 for (; inst
&& inst
!= error_mark_node
; inst
= TREE_CHAIN (inst
))
1884 tree types
= TREE_PURPOSE (inst
);
1885 tree instance
= TREE_VALUE (inst
);
1887 if (TREE_VEC_LENGTH (types
) == 0)
1890 if (!RECORD_OR_UNION_TYPE_P (instance
))
1893 /* We are interested in concrete template instantiations only: skip
1894 partially specialized nodes. */
1895 if (RECORD_OR_UNION_TYPE_P (instance
)
1897 && cpp_check (instance
, HAS_DEPENDENT_TEMPLATE_ARGS
))
1902 pp_string (buffer
, "package ");
1903 package_prefix
= false;
1904 dump_generic_ada_node (buffer
, instance
, t
, spc
, false, true);
1905 dump_template_types (buffer
, types
, spc
);
1906 pp_string (buffer
, " is");
1908 newline_and_indent (buffer
, spc
);
1910 TREE_VISITED (get_underlying_decl (instance
)) = 1;
1911 pp_string (buffer
, "type ");
1912 dump_generic_ada_node (buffer
, instance
, t
, spc
, false, true);
1913 package_prefix
= true;
1915 if (is_tagged_type (instance
))
1916 pp_string (buffer
, " is tagged limited ");
1918 pp_string (buffer
, " is limited ");
1920 dump_generic_ada_node (buffer
, instance
, t
, spc
, false, false);
1921 pp_newline (buffer
);
1923 newline_and_indent (buffer
, spc
);
1925 pp_string (buffer
, "end;");
1926 newline_and_indent (buffer
, spc
);
1927 pp_string (buffer
, "use ");
1928 package_prefix
= false;
1929 dump_generic_ada_node (buffer
, instance
, t
, spc
, false, true);
1930 dump_template_types (buffer
, types
, spc
);
1931 package_prefix
= true;
1932 pp_semicolon (buffer
);
1933 pp_newline (buffer
);
1934 pp_newline (buffer
);
1937 return num_inst
> 0;
1940 /* Return true if NODE is a simple enum types, that can be mapped to an
1941 Ada enum type directly. */
1944 is_simple_enum (tree node
)
1946 HOST_WIDE_INT count
= 0;
1949 for (value
= TYPE_VALUES (node
); value
; value
= TREE_CHAIN (value
))
1951 tree int_val
= TREE_VALUE (value
);
1953 if (TREE_CODE (int_val
) != INTEGER_CST
)
1954 int_val
= DECL_INITIAL (int_val
);
1956 if (!tree_fits_shwi_p (int_val
))
1958 else if (tree_to_shwi (int_val
) != count
)
1967 static bool bitfield_used
= false;
1969 /* Recursively dump in BUFFER Ada declarations corresponding to NODE of type
1970 TYPE. SPC is the indentation level. LIMITED_ACCESS indicates whether NODE
1971 can be referenced via a "limited with" clause. NAME_ONLY indicates whether
1972 we should only dump the name of NODE, instead of its full declaration. */
1975 dump_generic_ada_node (pretty_printer
*buffer
, tree node
, tree type
, int spc
,
1976 int limited_access
, bool name_only
)
1978 if (node
== NULL_TREE
)
1981 switch (TREE_CODE (node
))
1984 pp_string (buffer
, "<<< error >>>");
1987 case IDENTIFIER_NODE
:
1988 pp_ada_tree_identifier (buffer
, node
, type
, limited_access
);
1992 pp_string (buffer
, "--- unexpected node: TREE_LIST");
1996 dump_generic_ada_node
1997 (buffer
, BINFO_TYPE (node
), type
, spc
, limited_access
, name_only
);
2001 pp_string (buffer
, "--- unexpected node: TREE_VEC");
2007 append_withs ("System", false);
2008 pp_string (buffer
, "System.Address");
2011 pp_string (buffer
, "address");
2015 pp_string (buffer
, "<vector>");
2019 pp_string (buffer
, "<complex>");
2024 dump_generic_ada_node (buffer
, TYPE_NAME (node
), node
, spc
, 0, true);
2027 tree value
= TYPE_VALUES (node
);
2029 if (is_simple_enum (node
))
2033 newline_and_indent (buffer
, spc
- 1);
2034 pp_left_paren (buffer
);
2035 for (; value
; value
= TREE_CHAIN (value
))
2042 newline_and_indent (buffer
, spc
);
2045 pp_ada_tree_identifier
2046 (buffer
, TREE_PURPOSE (value
), node
, false);
2048 pp_string (buffer
, ");");
2050 newline_and_indent (buffer
, spc
);
2051 pp_string (buffer
, "pragma Convention (C, ");
2052 dump_generic_ada_node
2053 (buffer
, DECL_NAME (type
) ? type
: TYPE_NAME (node
), type
,
2055 pp_right_paren (buffer
);
2059 if (TYPE_UNSIGNED (node
))
2060 pp_string (buffer
, "unsigned");
2062 pp_string (buffer
, "int");
2063 for (; value
; value
= TREE_CHAIN (value
))
2065 pp_semicolon (buffer
);
2066 newline_and_indent (buffer
, spc
);
2068 pp_ada_tree_identifier
2069 (buffer
, TREE_PURPOSE (value
), node
, false);
2070 pp_string (buffer
, " : constant ");
2072 dump_generic_ada_node
2073 (buffer
, DECL_NAME (type
) ? type
: TYPE_NAME (node
), type
,
2076 pp_string (buffer
, " := ");
2077 dump_generic_ada_node
2079 TREE_CODE (TREE_VALUE (value
)) == INTEGER_CST
?
2080 TREE_VALUE (value
) : DECL_INITIAL (TREE_VALUE (value
)),
2081 node
, spc
, false, true);
2089 case FIXED_POINT_TYPE
:
2092 enum tree_code_class tclass
;
2094 tclass
= TREE_CODE_CLASS (TREE_CODE (node
));
2096 if (tclass
== tcc_declaration
)
2098 if (DECL_NAME (node
))
2099 pp_ada_tree_identifier
2100 (buffer
, DECL_NAME (node
), NULL_TREE
, limited_access
);
2102 pp_string (buffer
, "<unnamed type decl>");
2104 else if (tclass
== tcc_type
)
2106 if (TYPE_NAME (node
))
2108 if (TREE_CODE (TYPE_NAME (node
)) == IDENTIFIER_NODE
)
2109 pp_ada_tree_identifier (buffer
, TYPE_NAME (node
),
2110 node
, limited_access
);
2111 else if (TREE_CODE (TYPE_NAME (node
)) == TYPE_DECL
2112 && DECL_NAME (TYPE_NAME (node
)))
2113 dump_ada_decl_name (buffer
, TYPE_NAME (node
), limited_access
);
2115 pp_string (buffer
, "<unnamed type>");
2117 else if (TREE_CODE (node
) == INTEGER_TYPE
)
2119 append_withs ("Interfaces.C.Extensions", false);
2120 bitfield_used
= true;
2122 if (TYPE_PRECISION (node
) == 1)
2123 pp_string (buffer
, "Extensions.Unsigned_1");
2126 pp_string (buffer
, (TYPE_UNSIGNED (node
)
2127 ? "Extensions.Unsigned_"
2128 : "Extensions.Signed_"));
2129 pp_decimal_int (buffer
, TYPE_PRECISION (node
));
2133 pp_string (buffer
, "<unnamed type>");
2139 case REFERENCE_TYPE
:
2140 if (name_only
&& TYPE_NAME (node
))
2141 dump_generic_ada_node
2142 (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
, true);
2144 else if (TREE_CODE (TREE_TYPE (node
)) == FUNCTION_TYPE
)
2146 tree fnode
= TREE_TYPE (node
);
2149 if (VOID_TYPE_P (TREE_TYPE (fnode
)))
2151 is_function
= false;
2152 pp_string (buffer
, "access procedure");
2157 pp_string (buffer
, "access function");
2160 dump_ada_function_declaration
2161 (buffer
, node
, false, false, false, spc
+ INDENT_INCR
);
2165 pp_string (buffer
, " return ");
2166 dump_generic_ada_node
2167 (buffer
, TREE_TYPE (fnode
), type
, spc
, 0, true);
2170 /* If we are dumping the full type, it means we are part of a
2171 type definition and need also a Convention C pragma. */
2174 pp_semicolon (buffer
);
2175 newline_and_indent (buffer
, spc
);
2176 pp_string (buffer
, "pragma Convention (C, ");
2177 dump_generic_ada_node
2178 (buffer
, type
, 0, spc
, false, true);
2179 pp_right_paren (buffer
);
2184 int is_access
= false;
2185 unsigned int quals
= TYPE_QUALS (TREE_TYPE (node
));
2187 if (VOID_TYPE_P (TREE_TYPE (node
)))
2190 pp_string (buffer
, "new ");
2193 append_withs ("System", false);
2194 pp_string (buffer
, "System.Address");
2197 pp_string (buffer
, "address");
2201 if (TREE_CODE (node
) == POINTER_TYPE
2202 && TREE_CODE (TREE_TYPE (node
)) == INTEGER_TYPE
2204 (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME
2205 (TREE_TYPE (node
)))), "char"))
2208 pp_string (buffer
, "new ");
2212 pp_string (buffer
, "Interfaces.C.Strings.chars_ptr");
2213 append_withs ("Interfaces.C.Strings", false);
2216 pp_string (buffer
, "chars_ptr");
2220 tree type_name
= TYPE_NAME (TREE_TYPE (node
));
2221 tree decl
= get_underlying_decl (TREE_TYPE (node
));
2222 tree enclosing_decl
= get_underlying_decl (type
);
2224 /* For now, handle access-to-access, access-to-empty-struct
2225 or access-to-incomplete as opaque system.address. */
2226 if (TREE_CODE (TREE_TYPE (node
)) == POINTER_TYPE
2227 || (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node
))
2228 && !TYPE_FIELDS (TREE_TYPE (node
)))
2231 && !TREE_VISITED (decl
)
2232 && DECL_SOURCE_FILE (decl
) == source_file_base
)
2234 && !TREE_VISITED (decl
)
2235 && DECL_SOURCE_FILE (decl
)
2236 == DECL_SOURCE_FILE (enclosing_decl
)
2237 && decl_sloc (decl
, true)
2238 > decl_sloc (enclosing_decl
, true)))
2242 append_withs ("System", false);
2244 pp_string (buffer
, "new ");
2245 pp_string (buffer
, "System.Address");
2248 pp_string (buffer
, "address");
2252 if (!package_prefix
)
2253 pp_string (buffer
, "access");
2254 else if (AGGREGATE_TYPE_P (TREE_TYPE (node
)))
2256 if (!type
|| TREE_CODE (type
) != FUNCTION_DECL
)
2258 pp_string (buffer
, "access ");
2261 if (quals
& TYPE_QUAL_CONST
)
2262 pp_string (buffer
, "constant ");
2263 else if (!name_only
)
2264 pp_string (buffer
, "all ");
2266 else if (quals
& TYPE_QUAL_CONST
)
2267 pp_string (buffer
, "in ");
2271 pp_string (buffer
, "access ");
2272 /* ??? should be configurable: access or in out. */
2278 pp_string (buffer
, "access ");
2281 pp_string (buffer
, "all ");
2284 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node
)) && type_name
)
2285 dump_generic_ada_node (buffer
, type_name
, TREE_TYPE (node
),
2286 spc
, is_access
, true);
2288 dump_generic_ada_node (buffer
, TREE_TYPE (node
),
2289 TREE_TYPE (node
), spc
, 0, true);
2297 dump_generic_ada_node
2298 (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
, true);
2300 dump_ada_array_type (buffer
, node
, type
, spc
);
2307 if (TYPE_NAME (node
))
2308 dump_generic_ada_node
2309 (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
, true);
2312 pp_string (buffer
, "anon_");
2313 pp_scalar (buffer
, "%d", TYPE_UID (node
));
2317 print_ada_struct_decl (buffer
, node
, type
, spc
, true);
2321 /* We treat the upper half of the sizetype range as negative. This
2322 is consistent with the internal treatment and makes it possible
2323 to generate the (0 .. -1) range for flexible array members. */
2324 if (TREE_TYPE (node
) == sizetype
)
2325 node
= fold_convert (ssizetype
, node
);
2326 if (tree_fits_shwi_p (node
))
2327 pp_wide_integer (buffer
, tree_to_shwi (node
));
2328 else if (tree_fits_uhwi_p (node
))
2329 pp_unsigned_wide_integer (buffer
, tree_to_uhwi (node
));
2332 wide_int val
= node
;
2334 if (wi::neg_p (val
))
2339 sprintf (pp_buffer (buffer
)->digit_buffer
,
2340 "16#%" HOST_WIDE_INT_PRINT
"x",
2341 val
.elt (val
.get_len () - 1));
2342 for (i
= val
.get_len () - 2; i
>= 0; i
--)
2343 sprintf (pp_buffer (buffer
)->digit_buffer
,
2344 HOST_WIDE_INT_PRINT_PADDED_HEX
, val
.elt (i
));
2345 pp_string (buffer
, pp_buffer (buffer
)->digit_buffer
);
2358 dump_ada_decl_name (buffer
, node
, limited_access
);
2362 if (DECL_IS_BUILTIN (node
))
2364 /* Don't print the declaration of built-in types. */
2368 /* If we're in the middle of a declaration, defaults to
2372 append_withs ("System", false);
2373 pp_string (buffer
, "System.Address");
2376 pp_string (buffer
, "address");
2382 dump_ada_decl_name (buffer
, node
, limited_access
);
2385 if (is_tagged_type (TREE_TYPE (node
)))
2389 /* Look for ancestors. */
2390 for (tree fld
= TYPE_FIELDS (TREE_TYPE (node
));
2392 fld
= TREE_CHAIN (fld
))
2394 if (!DECL_NAME (fld
) && is_tagged_type (TREE_TYPE (fld
)))
2398 pp_string (buffer
, "limited new ");
2402 pp_string (buffer
, " and ");
2404 dump_ada_decl_name (buffer
, TYPE_NAME (TREE_TYPE (fld
)),
2409 pp_string (buffer
, first
? "tagged limited " : " with ");
2411 else if (has_nontrivial_methods (TREE_TYPE (node
)))
2412 pp_string (buffer
, "limited ");
2414 dump_generic_ada_node
2415 (buffer
, TREE_TYPE (node
), type
, spc
, false, false);
2422 case NAMESPACE_DECL
:
2423 dump_ada_decl_name (buffer
, node
, false);
2427 /* Ignore other nodes (e.g. expressions). */
2434 /* Dump in BUFFER NODE's methods. SPC is the indentation level. Return 1 if
2435 methods were printed, 0 otherwise. */
2438 print_ada_methods (pretty_printer
*buffer
, tree node
, int spc
)
2440 if (!has_nontrivial_methods (node
))
2443 pp_semicolon (buffer
);
2446 for (tree fld
= TYPE_FIELDS (node
); fld
; fld
= DECL_CHAIN (fld
))
2447 if (TREE_CODE (fld
) == FUNCTION_DECL
)
2451 pp_newline (buffer
);
2452 pp_newline (buffer
);
2455 res
= print_ada_declaration (buffer
, fld
, node
, spc
);
2461 static void dump_nested_type (pretty_printer
*, tree
, tree
, tree
, int);
2463 /* Dump in BUFFER anonymous types nested inside T's definition.
2464 PARENT is the parent node of T.
2465 FORWARD indicates whether a forward declaration of T should be generated.
2466 SPC is the indentation level.
2468 In C anonymous nested tagged types have no name whereas in C++ they have
2469 one. In C their TYPE_DECL is at top level whereas in C++ it is nested.
2470 In both languages untagged types (pointers and arrays) have no name.
2471 In C++ the nested TYPE_DECLs can come after their associated FIELD_DECL.
2473 Therefore, in order to have a common processing for both languages, we
2474 disregard anonymous TYPE_DECLs at top level and here we make a first
2475 pass on the nested TYPE_DECLs and a second pass on the unnamed types. */
2478 dump_nested_types (pretty_printer
*buffer
, tree t
, tree parent
, bool forward
,
2483 /* Avoid recursing over the same tree. */
2484 if (TREE_VISITED (t
))
2487 /* Find possible anonymous pointers/arrays/structs/unions recursively. */
2488 type
= TREE_TYPE (t
);
2489 if (type
== NULL_TREE
)
2494 pp_string (buffer
, "type ");
2495 dump_generic_ada_node (buffer
, t
, t
, spc
, false, true);
2496 pp_semicolon (buffer
);
2497 newline_and_indent (buffer
, spc
);
2498 TREE_VISITED (t
) = 1;
2501 for (field
= TYPE_FIELDS (type
); field
; field
= TREE_CHAIN (field
))
2502 if (TREE_CODE (field
) == TYPE_DECL
2503 && DECL_NAME (field
) != DECL_NAME (t
)
2504 && TYPE_NAME (TREE_TYPE (field
)) != TYPE_NAME (type
))
2505 dump_nested_type (buffer
, field
, t
, parent
, spc
);
2507 for (field
= TYPE_FIELDS (type
); field
; field
= TREE_CHAIN (field
))
2508 if (TREE_CODE (field
) == FIELD_DECL
&& !TYPE_NAME (TREE_TYPE (field
)))
2509 dump_nested_type (buffer
, field
, t
, parent
, spc
);
2511 TREE_VISITED (t
) = 1;
2514 /* Dump in BUFFER the anonymous type of FIELD inside T.
2515 PARENT is the parent node of T.
2516 FORWARD indicates whether a forward declaration of T should be generated.
2517 SPC is the indentation level. */
2520 dump_nested_type (pretty_printer
*buffer
, tree field
, tree t
, tree parent
,
2523 tree field_type
= TREE_TYPE (field
);
2526 switch (TREE_CODE (field_type
))
2529 tmp
= TREE_TYPE (field_type
);
2531 if (TREE_CODE (tmp
) == FUNCTION_TYPE
)
2532 for (tmp
= TREE_TYPE (tmp
);
2533 tmp
&& TREE_CODE (tmp
) == POINTER_TYPE
;
2534 tmp
= TREE_TYPE (tmp
))
2537 decl
= get_underlying_decl (tmp
);
2539 && !DECL_IS_BUILTIN (decl
)
2540 && (!RECORD_OR_UNION_TYPE_P (TREE_TYPE (decl
))
2541 || TYPE_FIELDS (TREE_TYPE (decl
)))
2542 && !TREE_VISITED (decl
)
2543 && DECL_SOURCE_FILE (decl
) == DECL_SOURCE_FILE (t
)
2544 && decl_sloc (decl
, true) > decl_sloc (t
, true))
2546 /* Generate forward declaration. */
2547 pp_string (buffer
, "type ");
2548 dump_generic_ada_node (buffer
, decl
, 0, spc
, false, true);
2549 pp_semicolon (buffer
);
2550 newline_and_indent (buffer
, spc
);
2551 TREE_VISITED (decl
) = 1;
2556 tmp
= TREE_TYPE (field_type
);
2557 while (TREE_CODE (tmp
) == ARRAY_TYPE
)
2558 tmp
= TREE_TYPE (tmp
);
2559 decl
= get_underlying_decl (tmp
);
2560 if (decl
&& !DECL_NAME (decl
) && !TREE_VISITED (decl
))
2562 /* Generate full declaration. */
2563 dump_nested_type (buffer
, decl
, t
, parent
, spc
);
2564 TREE_VISITED (decl
) = 1;
2567 /* Special case char arrays. */
2568 if (is_char_array (field
))
2569 pp_string (buffer
, "sub");
2571 pp_string (buffer
, "type ");
2572 dump_ada_double_name (buffer
, parent
, field
);
2573 pp_string (buffer
, " is ");
2574 dump_ada_array_type (buffer
, field
, parent
, spc
);
2575 pp_semicolon (buffer
);
2576 newline_and_indent (buffer
, spc
);
2581 if (TYPE_NAME (TREE_TYPE (t
)) && !TREE_VISITED (t
))
2583 pp_string (buffer
, "type ");
2584 dump_generic_ada_node (buffer
, t
, parent
, spc
, false, true);
2585 pp_semicolon (buffer
);
2586 newline_and_indent (buffer
, spc
);
2589 TREE_VISITED (t
) = 1;
2590 dump_nested_types (buffer
, field
, t
, false, spc
);
2592 pp_string (buffer
, "type ");
2594 if (TYPE_NAME (field_type
))
2596 dump_generic_ada_node (buffer
, field_type
, 0, spc
, false, true);
2597 if (TREE_CODE (field_type
) == UNION_TYPE
)
2598 pp_string (buffer
, " (discr : unsigned := 0)");
2599 pp_string (buffer
, " is ");
2600 print_ada_struct_decl (buffer
, field_type
, t
, spc
, false);
2602 pp_string (buffer
, "pragma Convention (C_Pass_By_Copy, ");
2603 dump_generic_ada_node (buffer
, field_type
, 0, spc
, false, true);
2604 pp_string (buffer
, ");");
2605 newline_and_indent (buffer
, spc
);
2607 if (TREE_CODE (field_type
) == UNION_TYPE
)
2609 pp_string (buffer
, "pragma Unchecked_Union (");
2610 dump_generic_ada_node (buffer
, field_type
, 0, spc
, false, true);
2611 pp_string (buffer
, ");");
2616 dump_ada_double_name (buffer
, parent
, field
);
2617 if (TREE_CODE (field_type
) == UNION_TYPE
)
2618 pp_string (buffer
, " (discr : unsigned := 0)");
2619 pp_string (buffer
, " is ");
2620 print_ada_struct_decl (buffer
, field_type
, t
, spc
, false);
2622 pp_string (buffer
, "pragma Convention (C_Pass_By_Copy, ");
2623 dump_ada_double_name (buffer
, parent
, field
);
2624 pp_string (buffer
, ");");
2625 newline_and_indent (buffer
, spc
);
2627 if (TREE_CODE (field_type
) == UNION_TYPE
)
2629 pp_string (buffer
, "pragma Unchecked_Union (");
2630 dump_ada_double_name (buffer
, parent
, field
);
2631 pp_string (buffer
, ");");
2640 /* Dump in BUFFER constructor spec corresponding to T for TYPE. */
2643 print_constructor (pretty_printer
*buffer
, tree t
, tree type
)
2645 tree decl_name
= DECL_NAME (TYPE_NAME (type
));
2647 pp_string (buffer
, "New_");
2648 pp_ada_tree_identifier (buffer
, decl_name
, t
, false);
2651 /* Dump in BUFFER destructor spec corresponding to T. */
2654 print_destructor (pretty_printer
*buffer
, tree t
, tree type
)
2656 tree decl_name
= DECL_NAME (TYPE_NAME (type
));
2658 pp_string (buffer
, "Delete_");
2659 pp_ada_tree_identifier (buffer
, decl_name
, t
, false);
2662 /* Return the name of type T. */
2667 tree n
= TYPE_NAME (t
);
2669 if (TREE_CODE (n
) == IDENTIFIER_NODE
)
2670 return IDENTIFIER_POINTER (n
);
2672 return IDENTIFIER_POINTER (DECL_NAME (n
));
2675 /* Print in BUFFER the declaration of a variable T of type TYPE in Ada syntax.
2676 SPC is the indentation level. Return 1 if a declaration was printed,
2680 print_ada_declaration (pretty_printer
*buffer
, tree t
, tree type
, int spc
)
2682 int is_var
= 0, need_indent
= 0;
2683 int is_class
= false;
2684 tree name
= TYPE_NAME (TREE_TYPE (t
));
2685 tree decl_name
= DECL_NAME (t
);
2686 tree orig
= NULL_TREE
;
2688 if (cpp_check
&& cpp_check (t
, IS_TEMPLATE
))
2689 return dump_ada_template (buffer
, t
, spc
);
2691 if (TREE_CODE (t
) == CONST_DECL
&& TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
)
2692 /* Skip enumeral values: will be handled as part of the type itself. */
2695 if (TREE_CODE (t
) == TYPE_DECL
)
2697 orig
= DECL_ORIGINAL_TYPE (t
);
2699 if (orig
&& TYPE_STUB_DECL (orig
))
2701 tree stub
= TYPE_STUB_DECL (orig
);
2702 tree typ
= TREE_TYPE (stub
);
2704 if (TYPE_NAME (typ
))
2706 /* If types have same representation, and same name (ignoring
2707 casing), then ignore the second type. */
2708 if (type_name (typ
) == type_name (TREE_TYPE (t
))
2709 || !strcasecmp (type_name (typ
), type_name (TREE_TYPE (t
))))
2711 TREE_VISITED (t
) = 1;
2717 if (RECORD_OR_UNION_TYPE_P (typ
) && !TYPE_FIELDS (typ
))
2719 pp_string (buffer
, "-- skipped empty struct ");
2720 dump_generic_ada_node (buffer
, t
, type
, spc
, false, true);
2724 if (RECORD_OR_UNION_TYPE_P (typ
)
2725 && DECL_SOURCE_FILE (stub
) == source_file_base
)
2726 dump_nested_types (buffer
, stub
, stub
, true, spc
);
2728 pp_string (buffer
, "subtype ");
2729 dump_generic_ada_node (buffer
, t
, type
, spc
, false, true);
2730 pp_string (buffer
, " is ");
2731 dump_generic_ada_node (buffer
, typ
, type
, spc
, false, true);
2732 pp_string (buffer
, "; -- ");
2733 dump_sloc (buffer
, t
);
2736 TREE_VISITED (t
) = 1;
2741 /* Skip unnamed or anonymous structs/unions/enum types. */
2742 if (!orig
&& !decl_name
&& !name
2743 && (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
))
2744 || TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
))
2747 /* Skip anonymous enum types (duplicates of real types). */
2749 && TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
2751 && (*IDENTIFIER_POINTER (decl_name
) == '.'
2752 || *IDENTIFIER_POINTER (decl_name
) == '$'))
2757 switch (TREE_CODE (TREE_TYPE (t
)))
2761 /* Skip empty structs (typically forward references to real
2763 if (!TYPE_FIELDS (TREE_TYPE (t
)))
2765 pp_string (buffer
, "-- skipped empty struct ");
2766 dump_generic_ada_node (buffer
, t
, type
, spc
, false, true);
2771 && (*IDENTIFIER_POINTER (decl_name
) == '.'
2772 || *IDENTIFIER_POINTER (decl_name
) == '$'))
2774 pp_string (buffer
, "-- skipped anonymous struct ");
2775 dump_generic_ada_node (buffer
, t
, type
, spc
, false, true);
2776 TREE_VISITED (t
) = 1;
2780 if (orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
2781 pp_string (buffer
, "subtype ");
2784 dump_nested_types (buffer
, t
, t
, false, spc
);
2786 if (separate_class_package (t
))
2789 pp_string (buffer
, "package Class_");
2790 dump_generic_ada_node (buffer
, t
, type
, spc
, false, true);
2791 pp_string (buffer
, " is");
2793 newline_and_indent (buffer
, spc
);
2796 pp_string (buffer
, "type ");
2802 case REFERENCE_TYPE
:
2803 if ((orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
2804 || is_char_array (t
))
2805 pp_string (buffer
, "subtype ");
2807 pp_string (buffer
, "type ");
2811 pp_string (buffer
, "-- skipped function type ");
2812 dump_generic_ada_node (buffer
, t
, type
, spc
, false, true);
2816 if ((orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
2817 || !is_simple_enum (TREE_TYPE (t
)))
2818 pp_string (buffer
, "subtype ");
2820 pp_string (buffer
, "type ");
2824 pp_string (buffer
, "subtype ");
2826 TREE_VISITED (t
) = 1;
2832 && *IDENTIFIER_POINTER (decl_name
) == '_')
2838 /* Print the type and name. */
2839 if (TREE_CODE (TREE_TYPE (t
)) == ARRAY_TYPE
)
2844 /* Print variable's name. */
2845 dump_generic_ada_node (buffer
, t
, type
, spc
, false, true);
2847 if (TREE_CODE (t
) == TYPE_DECL
)
2849 pp_string (buffer
, " is ");
2851 if (orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
2852 dump_generic_ada_node
2853 (buffer
, TYPE_NAME (orig
), type
, spc
, false, true);
2855 dump_ada_array_type (buffer
, t
, type
, spc
);
2859 tree tmp
= TYPE_NAME (TREE_TYPE (t
));
2861 if (spc
== INDENT_INCR
|| TREE_STATIC (t
))
2864 pp_string (buffer
, " : ");
2866 if (TREE_CODE (TREE_TYPE (TREE_TYPE (t
))) != POINTER_TYPE
)
2867 pp_string (buffer
, "aliased ");
2870 dump_generic_ada_node (buffer
, tmp
, type
, spc
, false, true);
2872 dump_ada_double_name (buffer
, type
, t
);
2874 dump_ada_array_type (buffer
, t
, type
, spc
);
2877 else if (TREE_CODE (t
) == FUNCTION_DECL
)
2879 bool is_function
, is_abstract_class
= false;
2880 bool is_method
= TREE_CODE (TREE_TYPE (t
)) == METHOD_TYPE
;
2881 tree decl_name
= DECL_NAME (t
);
2882 bool is_abstract
= false;
2883 bool is_constructor
= false;
2884 bool is_destructor
= false;
2885 bool is_copy_constructor
= false;
2886 bool is_move_constructor
= false;
2893 is_abstract
= cpp_check (t
, IS_ABSTRACT
);
2894 is_constructor
= cpp_check (t
, IS_CONSTRUCTOR
);
2895 is_destructor
= cpp_check (t
, IS_DESTRUCTOR
);
2896 is_copy_constructor
= cpp_check (t
, IS_COPY_CONSTRUCTOR
);
2897 is_move_constructor
= cpp_check (t
, IS_MOVE_CONSTRUCTOR
);
2900 /* Skip copy constructors and C++11 move constructors: some are internal
2901 only and those that are not cannot be called easily from Ada. */
2902 if (is_copy_constructor
|| is_move_constructor
)
2905 if (is_constructor
|| is_destructor
)
2907 /* ??? Skip implicit constructors/destructors for now. */
2908 if (DECL_ARTIFICIAL (t
))
2911 /* Only consider constructors/destructors for complete objects. */
2912 if (strncmp (IDENTIFIER_POINTER (decl_name
), "__ct_comp", 9) != 0
2913 && strncmp (IDENTIFIER_POINTER (decl_name
), "__dt_comp", 9) != 0)
2917 /* If this function has an entry in the vtable, we cannot omit it. */
2918 else if (!DECL_VINDEX (t
) && *IDENTIFIER_POINTER (decl_name
) == '_')
2921 pp_string (buffer
, "-- skipped func ");
2922 pp_string (buffer
, IDENTIFIER_POINTER (decl_name
));
2929 if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t
))) && !is_constructor
)
2931 pp_string (buffer
, "procedure ");
2932 is_function
= false;
2936 pp_string (buffer
, "function ");
2941 print_constructor (buffer
, t
, type
);
2942 else if (is_destructor
)
2943 print_destructor (buffer
, t
, type
);
2945 dump_ada_decl_name (buffer
, t
, false);
2947 dump_ada_function_declaration
2948 (buffer
, t
, is_method
, is_constructor
, is_destructor
, spc
);
2952 pp_string (buffer
, " return ");
2954 = is_constructor
? DECL_CONTEXT (t
) : TREE_TYPE (TREE_TYPE (t
));
2955 dump_generic_ada_node (buffer
, ret_type
, type
, spc
, false, true);
2958 if (is_constructor
&& RECORD_OR_UNION_TYPE_P (type
))
2959 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= DECL_CHAIN (fld
))
2960 if (TREE_CODE (fld
) == FUNCTION_DECL
&& cpp_check (fld
, IS_ABSTRACT
))
2962 is_abstract_class
= true;
2966 if (is_abstract
|| is_abstract_class
)
2967 pp_string (buffer
, " is abstract");
2969 pp_semicolon (buffer
);
2970 pp_string (buffer
, " -- ");
2971 dump_sloc (buffer
, t
);
2973 if (is_abstract
|| !DECL_ASSEMBLER_NAME (t
))
2976 newline_and_indent (buffer
, spc
);
2980 pp_string (buffer
, "pragma CPP_Constructor (");
2981 print_constructor (buffer
, t
, type
);
2982 pp_string (buffer
, ", \"");
2983 pp_asm_name (buffer
, t
);
2984 pp_string (buffer
, "\");");
2986 else if (is_destructor
)
2988 pp_string (buffer
, "pragma Import (CPP, ");
2989 print_destructor (buffer
, t
, type
);
2990 pp_string (buffer
, ", \"");
2991 pp_asm_name (buffer
, t
);
2992 pp_string (buffer
, "\");");
2996 dump_ada_import (buffer
, t
);
3001 else if (TREE_CODE (t
) == TYPE_DECL
&& !DECL_ORIGINAL_TYPE (t
))
3003 int is_interface
= 0;
3004 int is_abstract_record
= 0;
3009 /* Anonymous structs/unions */
3010 dump_generic_ada_node (buffer
, TREE_TYPE (t
), t
, spc
, false, true);
3012 if (TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
)
3014 pp_string (buffer
, " (discr : unsigned := 0)");
3017 pp_string (buffer
, " is ");
3019 /* Check whether we have an Ada interface compatible class.
3020 That is only have a vtable non-static data member and no
3021 non-abstract methods. */
3023 && RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
)))
3025 bool has_fields
= false;
3027 /* Check that there are no fields other than the virtual table. */
3028 for (tree fld
= TYPE_FIELDS (TREE_TYPE (t
));
3030 fld
= TREE_CHAIN (fld
))
3032 if (TREE_CODE (fld
) == FIELD_DECL
)
3034 if (!has_fields
&& DECL_VIRTUAL_P (fld
))
3040 else if (TREE_CODE (fld
) == FUNCTION_DECL
3041 && !DECL_ARTIFICIAL (fld
))
3043 if (cpp_check (fld
, IS_ABSTRACT
))
3044 is_abstract_record
= 1;
3051 TREE_VISITED (t
) = 1;
3054 pp_string (buffer
, "limited interface; -- ");
3055 dump_sloc (buffer
, t
);
3056 newline_and_indent (buffer
, spc
);
3057 pp_string (buffer
, "pragma Import (CPP, ");
3058 dump_generic_ada_node
3059 (buffer
, TYPE_NAME (TREE_TYPE (t
)), type
, spc
, false, true);
3060 pp_right_paren (buffer
);
3062 print_ada_methods (buffer
, TREE_TYPE (t
), spc
);
3066 if (is_abstract_record
)
3067 pp_string (buffer
, "abstract ");
3068 dump_generic_ada_node (buffer
, t
, t
, spc
, false, false);
3076 if (TREE_CODE (t
) == FIELD_DECL
&& DECL_NAME (t
))
3077 check_name (buffer
, t
);
3079 /* Print variable/type's name. */
3080 dump_generic_ada_node (buffer
, t
, t
, spc
, false, true);
3082 if (TREE_CODE (t
) == TYPE_DECL
)
3084 tree orig
= DECL_ORIGINAL_TYPE (t
);
3085 int is_subtype
= orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
);
3087 if (!is_subtype
&& TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
)
3088 pp_string (buffer
, " (discr : unsigned := 0)");
3090 pp_string (buffer
, " is ");
3092 dump_generic_ada_node (buffer
, orig
, t
, spc
, false, is_subtype
);
3096 if (spc
== INDENT_INCR
|| TREE_STATIC (t
))
3099 pp_string (buffer
, " : ");
3101 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
)))
3103 pp_string (buffer
, "aliased ");
3105 if (TREE_READONLY (t
))
3106 pp_string (buffer
, "constant ");
3108 if (TYPE_NAME (TREE_TYPE (t
)))
3109 dump_generic_ada_node
3110 (buffer
, TREE_TYPE (t
), t
, spc
, false, true);
3112 dump_ada_double_name (buffer
, type
, t
);
3116 if (TREE_CODE (TREE_TYPE (t
)) != POINTER_TYPE
3117 && (TYPE_NAME (TREE_TYPE (t
))
3118 || TREE_CODE (TREE_TYPE (t
)) != INTEGER_TYPE
))
3119 pp_string (buffer
, "aliased ");
3121 if (TREE_READONLY (t
))
3122 pp_string (buffer
, "constant ");
3124 dump_generic_ada_node
3125 (buffer
, TREE_TYPE (t
), TREE_TYPE (t
), spc
, false, true);
3133 newline_and_indent (buffer
, spc
);
3134 pp_string (buffer
, "end;");
3135 newline_and_indent (buffer
, spc
);
3136 pp_string (buffer
, "use Class_");
3137 dump_generic_ada_node (buffer
, t
, type
, spc
, false, true);
3138 pp_semicolon (buffer
);
3139 pp_newline (buffer
);
3141 /* All needed indentation/newline performed already, so return 0. */
3146 pp_string (buffer
, "; -- ");
3147 dump_sloc (buffer
, t
);
3152 newline_and_indent (buffer
, spc
);
3153 dump_ada_import (buffer
, t
);
3159 /* Prints in BUFFER a structure NODE of type TYPE: name, fields, and methods
3160 with Ada syntax. SPC is the indentation level. If DISPLAY_CONVENTION is
3161 true, also print the pragma Convention for NODE. */
3164 print_ada_struct_decl (pretty_printer
*buffer
, tree node
, tree type
, int spc
,
3165 bool display_convention
)
3168 const bool is_union
= (TREE_CODE (node
) == UNION_TYPE
);
3171 int field_spc
= spc
+ INDENT_INCR
;
3174 bitfield_used
= false;
3176 if (TYPE_FIELDS (node
))
3178 /* Print the contents of the structure. */
3179 pp_string (buffer
, "record");
3183 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
3184 pp_string (buffer
, "case discr is");
3185 field_spc
= spc
+ INDENT_INCR
* 3;
3188 pp_newline (buffer
);
3190 /* Print the non-static fields of the structure. */
3191 for (tmp
= TYPE_FIELDS (node
); tmp
; tmp
= TREE_CHAIN (tmp
))
3193 /* Add parent field if needed. */
3194 if (!DECL_NAME (tmp
))
3196 if (!is_tagged_type (TREE_TYPE (tmp
)))
3198 if (!TYPE_NAME (TREE_TYPE (tmp
)))
3199 print_ada_declaration (buffer
, tmp
, type
, field_spc
);
3205 pp_string (buffer
, "parent : aliased ");
3208 sprintf (buf
, "field_%d : aliased ", field_num
+ 1);
3209 pp_string (buffer
, buf
);
3212 (buffer
, TYPE_NAME (TREE_TYPE (tmp
)), false);
3213 pp_semicolon (buffer
);
3215 pp_newline (buffer
);
3219 else if (TREE_CODE (tmp
) == FIELD_DECL
)
3221 /* Skip internal virtual table field. */
3222 if (!DECL_VIRTUAL_P (tmp
))
3226 if (TREE_CHAIN (tmp
)
3227 && TREE_TYPE (TREE_CHAIN (tmp
)) != node
3228 && TREE_CODE (TREE_CHAIN (tmp
)) != TYPE_DECL
)
3229 sprintf (buf
, "when %d =>", field_num
);
3231 sprintf (buf
, "when others =>");
3233 INDENT (spc
+ INDENT_INCR
* 2);
3234 pp_string (buffer
, buf
);
3235 pp_newline (buffer
);
3238 if (print_ada_declaration (buffer
, tmp
, type
, field_spc
))
3240 pp_newline (buffer
);
3249 INDENT (spc
+ INDENT_INCR
);
3250 pp_string (buffer
, "end case;");
3251 pp_newline (buffer
);
3256 INDENT (spc
+ INDENT_INCR
);
3257 pp_string (buffer
, "null;");
3258 pp_newline (buffer
);
3262 pp_string (buffer
, "end record;");
3265 pp_string (buffer
, "null 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_generic_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_generic_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_generic_ada_node
3303 (buffer
, TREE_TYPE (type
), type
, spc
, false, true);
3304 pp_right_paren (buffer
);
3305 bitfield_used
= false;
3308 need_semicolon
= !print_ada_methods (buffer
, node
, spc
);
3310 /* Print the static fields of the structure, if any. */
3311 for (tmp
= TYPE_FIELDS (node
); tmp
; tmp
= TREE_CHAIN (tmp
))
3313 if (TREE_CODE (tmp
) == VAR_DECL
&& DECL_NAME (tmp
))
3317 need_semicolon
= false;
3318 pp_semicolon (buffer
);
3320 pp_newline (buffer
);
3321 pp_newline (buffer
);
3322 print_ada_declaration (buffer
, tmp
, type
, spc
);
3327 /* Dump all the declarations in SOURCE_FILE to an Ada spec.
3328 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3329 nodes for SOURCE_FILE. CHECK is used to perform C++ queries on nodes. */
3332 dump_ads (const char *source_file
,
3333 void (*collect_all_refs
)(const char *),
3334 int (*check
)(tree
, cpp_operation
))
3341 pkg_name
= get_ada_package (source_file
);
3343 /* Construct the .ads filename and package name. */
3344 ads_name
= xstrdup (pkg_name
);
3346 for (s
= ads_name
; *s
; s
++)
3352 ads_name
= reconcat (ads_name
, ads_name
, ".ads", NULL
);
3354 /* Write out the .ads file. */
3355 f
= fopen (ads_name
, "w");
3360 pp_needs_newline (&pp
) = true;
3361 pp
.buffer
->stream
= f
;
3363 /* Dump all relevant macros. */
3364 dump_ada_macros (&pp
, source_file
);
3366 /* Reset the table of withs for this file. */
3369 (*collect_all_refs
) (source_file
);
3371 /* Dump all references. */
3373 dump_ada_nodes (&pp
, source_file
);
3375 /* Requires Ada 2005 syntax, so generate corresponding pragma.
3376 Also, disable style checks since this file is auto-generated. */
3377 fprintf (f
, "pragma Ada_2005;\npragma Style_Checks (Off);\n\n");
3382 fprintf (f
, "\npackage %s is\n\n", pkg_name
);
3383 pp_write_text_to_stream (&pp
);
3384 /* ??? need to free pp */
3385 fprintf (f
, "end %s;\n", pkg_name
);
3393 static const char **source_refs
= NULL
;
3394 static int source_refs_used
= 0;
3395 static int source_refs_allocd
= 0;
3397 /* Add an entry for FILENAME to the table SOURCE_REFS. */
3400 collect_source_ref (const char *filename
)
3407 if (source_refs_allocd
== 0)
3409 source_refs_allocd
= 1024;
3410 source_refs
= XNEWVEC (const char *, source_refs_allocd
);
3413 for (i
= 0; i
< source_refs_used
; i
++)
3414 if (filename
== source_refs
[i
])
3417 if (source_refs_used
== source_refs_allocd
)
3419 source_refs_allocd
*= 2;
3420 source_refs
= XRESIZEVEC (const char *, source_refs
, source_refs_allocd
);
3423 source_refs
[source_refs_used
++] = filename
;
3426 /* Main entry point: dump all Ada specs corresponding to SOURCE_REFS
3427 using callbacks COLLECT_ALL_REFS and CHECK.
3428 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3429 nodes for a given source file.
3430 CHECK is used to perform C++ queries on nodes, or NULL for the C
3434 dump_ada_specs (void (*collect_all_refs
)(const char *),
3435 int (*check
)(tree
, cpp_operation
))
3439 /* Iterate over the list of files to dump specs for */
3440 for (i
= 0; i
< source_refs_used
; i
++)
3441 dump_ads (source_refs
[i
], collect_all_refs
, check
);
3443 /* Free files table. */