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"
32 /* Local functions, macros and variables. */
33 static int dump_generic_ada_node (pretty_printer
*, tree
, tree
, int, int,
35 static int print_ada_declaration (pretty_printer
*, tree
, tree
, int);
36 static void print_ada_struct_decl (pretty_printer
*, tree
, tree
, int, bool);
37 static void dump_sloc (pretty_printer
*buffer
, tree node
);
38 static void print_comment (pretty_printer
*, const char *);
39 static void print_generic_ada_decl (pretty_printer
*, tree
, const char *);
40 static char *get_ada_package (const char *);
41 static void dump_ada_nodes (pretty_printer
*, const char *);
42 static void reset_ada_withs (void);
43 static void dump_ada_withs (FILE *);
44 static void dump_ads (const char *, void (*)(const char *),
45 int (*)(tree
, cpp_operation
));
46 static char *to_ada_name (const char *, int *);
47 static bool separate_class_package (tree
);
49 #define INDENT(SPACE) \
50 do { int i; for (i = 0; i<SPACE; i++) pp_space (buffer); } while (0)
54 /* Global hook used to perform C++ queries on nodes. */
55 static int (*cpp_check
) (tree
, cpp_operation
) = NULL
;
58 /* Given a cpp MACRO, compute the max length BUFFER_LEN of the macro, as well
59 as max length PARAM_LEN of arguments for fun_like macros, and also set
60 SUPPORTED to 0 if the macro cannot be mapped to an Ada construct. */
63 macro_length (const cpp_macro
*macro
, int *supported
, int *buffer_len
,
76 for (i
= 0; i
< macro
->paramc
; i
++)
78 cpp_hashnode
*param
= macro
->params
[i
];
80 *param_len
+= NODE_LEN (param
);
82 if (i
+ 1 < macro
->paramc
)
84 *param_len
+= 2; /* ", " */
86 else if (macro
->variadic
)
92 *param_len
+= 2; /* ")\0" */
95 for (j
= 0; j
< macro
->count
; j
++)
97 cpp_token
*token
= ¯o
->exp
.tokens
[j
];
99 if (token
->flags
& PREV_WHITE
)
102 if (token
->flags
& STRINGIFY_ARG
|| token
->flags
& PASTE_LEFT
)
108 if (token
->type
== CPP_MACRO_ARG
)
110 NODE_LEN (macro
->params
[token
->val
.macro_arg
.arg_no
- 1]);
112 /* Include enough extra space to handle e.g. special characters. */
113 *buffer_len
+= (cpp_token_len (token
) + 1) * 8;
119 /* Dump all digits/hex chars from NUMBER to BUFFER and return a pointer
120 to the character after the last character written. */
122 static unsigned char *
123 dump_number (unsigned char *number
, unsigned char *buffer
)
125 while (*number
!= '\0'
130 *buffer
++ = *number
++;
135 /* Handle escape character C and convert to an Ada character into BUFFER.
136 Return a pointer to the character after the last character written, or
137 NULL if the escape character is not supported. */
139 static unsigned char *
140 handle_escape_character (unsigned char *buffer
, char c
)
150 strcpy ((char *) buffer
, "\" & ASCII.LF & \"");
155 strcpy ((char *) buffer
, "\" & ASCII.CR & \"");
160 strcpy ((char *) buffer
, "\" & ASCII.HT & \"");
171 /* Dump into PP a set of MAX_ADA_MACROS MACROS (C/C++) as Ada constants when
175 print_ada_macros (pretty_printer
*pp
, cpp_hashnode
**macros
, int max_ada_macros
)
177 int j
, num_macros
= 0, prev_line
= -1;
179 for (j
= 0; j
< max_ada_macros
; j
++)
181 cpp_hashnode
*node
= macros
[j
];
182 const cpp_macro
*macro
= node
->value
.macro
;
184 int supported
= 1, prev_is_one
= 0, buffer_len
, param_len
;
185 int is_string
= 0, is_char
= 0;
187 unsigned char *s
, *params
, *buffer
, *buf_param
, *char_one
= NULL
, *tmp
;
189 macro_length (macro
, &supported
, &buffer_len
, ¶m_len
);
190 s
= buffer
= XALLOCAVEC (unsigned char, buffer_len
);
191 params
= buf_param
= XALLOCAVEC (unsigned char, param_len
);
198 for (i
= 0; i
< macro
->paramc
; i
++)
200 cpp_hashnode
*param
= macro
->params
[i
];
202 memcpy (buf_param
, NODE_NAME (param
), NODE_LEN (param
));
203 buf_param
+= NODE_LEN (param
);
205 if (i
+ 1 < macro
->paramc
)
210 else if (macro
->variadic
)
220 for (i
= 0; supported
&& i
< macro
->count
; i
++)
222 cpp_token
*token
= ¯o
->exp
.tokens
[i
];
225 if (token
->flags
& PREV_WHITE
)
228 if (token
->flags
& STRINGIFY_ARG
|| token
->flags
& PASTE_LEFT
)
238 cpp_hashnode
*param
=
239 macro
->params
[token
->val
.macro_arg
.arg_no
- 1];
240 memcpy (buffer
, NODE_NAME (param
), NODE_LEN (param
));
241 buffer
+= NODE_LEN (param
);
245 case CPP_EQ_EQ
: *buffer
++ = '='; break;
246 case CPP_GREATER
: *buffer
++ = '>'; break;
247 case CPP_LESS
: *buffer
++ = '<'; break;
248 case CPP_PLUS
: *buffer
++ = '+'; break;
249 case CPP_MINUS
: *buffer
++ = '-'; break;
250 case CPP_MULT
: *buffer
++ = '*'; break;
251 case CPP_DIV
: *buffer
++ = '/'; break;
252 case CPP_COMMA
: *buffer
++ = ','; break;
253 case CPP_OPEN_SQUARE
:
254 case CPP_OPEN_PAREN
: *buffer
++ = '('; break;
255 case CPP_CLOSE_SQUARE
: /* fallthrough */
256 case CPP_CLOSE_PAREN
: *buffer
++ = ')'; break;
257 case CPP_DEREF
: /* fallthrough */
258 case CPP_SCOPE
: /* fallthrough */
259 case CPP_DOT
: *buffer
++ = '.'; break;
261 case CPP_EQ
: *buffer
++ = ':'; *buffer
++ = '='; break;
262 case CPP_NOT_EQ
: *buffer
++ = '/'; *buffer
++ = '='; break;
263 case CPP_GREATER_EQ
: *buffer
++ = '>'; *buffer
++ = '='; break;
264 case CPP_LESS_EQ
: *buffer
++ = '<'; *buffer
++ = '='; break;
267 *buffer
++ = 'n'; *buffer
++ = 'o'; *buffer
++ = 't'; break;
269 *buffer
++ = 'm'; *buffer
++ = 'o'; *buffer
++ = 'd'; break;
271 *buffer
++ = 'a'; *buffer
++ = 'n'; *buffer
++ = 'd'; break;
273 *buffer
++ = 'o'; *buffer
++ = 'r'; break;
275 *buffer
++ = 'x'; *buffer
++ = 'o'; *buffer
++ = 'r'; break;
277 strcpy ((char *) buffer
, " and then ");
281 strcpy ((char *) buffer
, " or else ");
287 is_one
= prev_is_one
;
290 case CPP_COMMENT
: break;
301 if (!macro
->fun_like
)
304 buffer
= cpp_spell_token (parse_in
, token
, buffer
, false);
310 const unsigned char *s
= token
->val
.str
.text
;
316 buffer
= handle_escape_character (buffer
, *s
);
335 c
= cpp_interpret_charconst (parse_in
, token
,
336 &chars_seen
, &ignored
);
337 if (c
>= 32 && c
<= 126)
340 *buffer
++ = (char) c
;
346 ((char *) buffer
, "Character'Val (%d)", (int) c
);
347 buffer
+= chars_seen
;
353 tmp
= cpp_token_as_text (parse_in
, token
);
373 buffer
= dump_number (tmp
+ 2, buffer
);
381 buffer
= dump_number (tmp
+ 2, buffer
);
386 /* Dump floating constants unmodified. */
387 if (strchr ((const char *)tmp
, '.'))
388 buffer
= dump_number (tmp
, buffer
);
393 buffer
= dump_number (tmp
+ 1, buffer
);
401 if (tmp
[1] == '\0' || tmp
[1] == 'l' || tmp
[1] == 'u'
402 || tmp
[1] == 'L' || tmp
[1] == 'U')
409 buffer
= dump_number (tmp
, buffer
);
413 buffer
= dump_number (tmp
, buffer
);
421 /* Replace "1 << N" by "2 ** N" */
448 case CPP_CLOSE_BRACE
:
452 case CPP_MINUS_MINUS
:
456 case CPP_HEADER_NAME
:
459 case CPP_OBJC_STRING
:
461 if (!macro
->fun_like
)
464 buffer
= cpp_spell_token (parse_in
, token
, buffer
, false);
468 prev_is_one
= is_one
;
475 if (macro
->fun_like
&& supported
)
477 char *start
= (char *) s
;
480 pp_string (pp
, " -- arg-macro: ");
482 if (*start
== '(' && buffer
[-1] == ')')
487 pp_string (pp
, "function ");
491 pp_string (pp
, "procedure ");
494 pp_string (pp
, (const char *) NODE_NAME (node
));
496 pp_string (pp
, (char *) params
);
498 pp_string (pp
, " -- ");
502 pp_string (pp
, "return ");
503 pp_string (pp
, start
);
507 pp_string (pp
, start
);
513 expanded_location sloc
= expand_location (macro
->line
);
515 if (sloc
.line
!= prev_line
+ 1 && prev_line
> 0)
519 prev_line
= sloc
.line
;
522 ada_name
= to_ada_name ((const char *) NODE_NAME (node
), NULL
);
523 pp_string (pp
, ada_name
);
525 pp_string (pp
, " : ");
528 pp_string (pp
, "aliased constant String");
530 pp_string (pp
, "aliased constant Character");
532 pp_string (pp
, "constant");
534 pp_string (pp
, " := ");
535 pp_string (pp
, (char *) s
);
538 pp_string (pp
, " & ASCII.NUL");
540 pp_string (pp
, "; -- ");
541 pp_string (pp
, sloc
.file
);
543 pp_scalar (pp
, "%d", sloc
.line
);
548 pp_string (pp
, " -- unsupported macro: ");
549 pp_string (pp
, (const char *) cpp_macro_definition (parse_in
, node
));
558 static const char *source_file
;
559 static int max_ada_macros
;
561 /* Callback used to count the number of relevant macros from
562 cpp_forall_identifiers. PFILE and V are not used. NODE is the current macro
566 count_ada_macro (cpp_reader
*pfile ATTRIBUTE_UNUSED
, cpp_hashnode
*node
,
567 void *v ATTRIBUTE_UNUSED
)
569 const cpp_macro
*macro
= node
->value
.macro
;
571 if (node
->type
== NT_MACRO
&& !(node
->flags
& NODE_BUILTIN
)
573 && *NODE_NAME (node
) != '_'
574 && LOCATION_FILE (macro
->line
) == source_file
)
580 static int store_ada_macro_index
;
582 /* Callback used to store relevant macros from cpp_forall_identifiers.
583 PFILE is not used. NODE is the current macro to store if relevant.
584 MACROS is an array of cpp_hashnode* used to store NODE. */
587 store_ada_macro (cpp_reader
*pfile ATTRIBUTE_UNUSED
,
588 cpp_hashnode
*node
, void *macros
)
590 const cpp_macro
*macro
= node
->value
.macro
;
592 if (node
->type
== NT_MACRO
&& !(node
->flags
& NODE_BUILTIN
)
594 && *NODE_NAME (node
) != '_'
595 && LOCATION_FILE (macro
->line
) == source_file
)
596 ((cpp_hashnode
**) macros
)[store_ada_macro_index
++] = node
;
601 /* Callback used to compare (during qsort) macros. NODE1 and NODE2 are the
602 two macro nodes to compare. */
605 compare_macro (const void *node1
, const void *node2
)
607 typedef const cpp_hashnode
*const_hnode
;
609 const_hnode n1
= *(const const_hnode
*) node1
;
610 const_hnode n2
= *(const const_hnode
*) node2
;
612 return n1
->value
.macro
->line
- n2
->value
.macro
->line
;
615 /* Dump in PP all relevant macros appearing in FILE. */
618 dump_ada_macros (pretty_printer
*pp
, const char* file
)
620 cpp_hashnode
**macros
;
622 /* Initialize file-scope variables. */
624 store_ada_macro_index
= 0;
627 /* Count all potentially relevant macros, and then sort them by sloc. */
628 cpp_forall_identifiers (parse_in
, count_ada_macro
, NULL
);
629 macros
= XALLOCAVEC (cpp_hashnode
*, max_ada_macros
);
630 cpp_forall_identifiers (parse_in
, store_ada_macro
, macros
);
631 qsort (macros
, max_ada_macros
, sizeof (cpp_hashnode
*), compare_macro
);
633 print_ada_macros (pp
, macros
, max_ada_macros
);
636 /* Current source file being handled. */
638 static const char *source_file_base
;
640 /* Return sloc of DECL, using sloc of last field if LAST is true. */
643 decl_sloc (const_tree decl
, bool last
)
647 /* Compare the declaration of struct-like types based on the sloc of their
648 last field (if LAST is true), so that more nested types collate before
650 if (TREE_CODE (decl
) == TYPE_DECL
651 && !DECL_ORIGINAL_TYPE (decl
)
652 && RECORD_OR_UNION_TYPE_P (TREE_TYPE (decl
))
653 && (field
= TYPE_FIELDS (TREE_TYPE (decl
))))
656 while (DECL_CHAIN (field
))
657 field
= DECL_CHAIN (field
);
658 return DECL_SOURCE_LOCATION (field
);
661 return DECL_SOURCE_LOCATION (decl
);
664 /* Compare two locations LHS and RHS. */
667 compare_location (location_t lhs
, location_t rhs
)
669 expanded_location xlhs
= expand_location (lhs
);
670 expanded_location xrhs
= expand_location (rhs
);
672 if (xlhs
.file
!= xrhs
.file
)
673 return filename_cmp (xlhs
.file
, xrhs
.file
);
675 if (xlhs
.line
!= xrhs
.line
)
676 return xlhs
.line
- xrhs
.line
;
678 if (xlhs
.column
!= xrhs
.column
)
679 return xlhs
.column
- xrhs
.column
;
684 /* Compare two declarations (LP and RP) by their source location. */
687 compare_node (const void *lp
, const void *rp
)
689 const_tree lhs
= *((const tree
*) lp
);
690 const_tree rhs
= *((const tree
*) rp
);
692 return compare_location (decl_sloc (lhs
, true), decl_sloc (rhs
, true));
695 /* Compare two comments (LP and RP) by their source location. */
698 compare_comment (const void *lp
, const void *rp
)
700 const cpp_comment
*lhs
= (const cpp_comment
*) lp
;
701 const cpp_comment
*rhs
= (const cpp_comment
*) rp
;
703 return compare_location (lhs
->sloc
, rhs
->sloc
);
706 static tree
*to_dump
= NULL
;
707 static int to_dump_count
= 0;
709 /* Collect a list of declarations from T relevant to SOURCE_FILE to be dumped
710 by a subsequent call to dump_ada_nodes. */
713 collect_ada_nodes (tree t
, const char *source_file
)
716 int i
= to_dump_count
;
718 /* Count the likely relevant nodes: do not dump builtins (they are irrelevant
719 in the context of bindings) and namespaces (we do not handle them properly
721 for (n
= t
; n
; n
= TREE_CHAIN (n
))
722 if (!DECL_IS_BUILTIN (n
)
723 && TREE_CODE (n
) != NAMESPACE_DECL
724 && LOCATION_FILE (decl_sloc (n
, false)) == source_file
)
727 /* Allocate sufficient storage for all nodes. */
728 to_dump
= XRESIZEVEC (tree
, to_dump
, to_dump_count
);
730 /* Store the relevant nodes. */
731 for (n
= t
; n
; n
= TREE_CHAIN (n
))
732 if (!DECL_IS_BUILTIN (n
)
733 && TREE_CODE (n
) != NAMESPACE_DECL
734 && LOCATION_FILE (decl_sloc (n
, false)) == source_file
)
738 /* Call back for walk_tree to clear the TREE_VISITED flag of TP. */
741 unmark_visited_r (tree
*tp
, int *walk_subtrees ATTRIBUTE_UNUSED
,
742 void *data ATTRIBUTE_UNUSED
)
744 if (TREE_VISITED (*tp
))
745 TREE_VISITED (*tp
) = 0;
752 /* Dump nodes into PP relevant to SOURCE_FILE, as collected by previous calls
753 to collect_ada_nodes. */
756 dump_ada_nodes (pretty_printer
*pp
, const char *source_file
)
759 cpp_comment_table
*comments
;
761 /* Sort the table of declarations to dump by sloc. */
762 qsort (to_dump
, to_dump_count
, sizeof (tree
), compare_node
);
764 /* Fetch the table of comments. */
765 comments
= cpp_get_comments (parse_in
);
767 /* Sort the comments table by sloc. */
768 if (comments
->count
> 1)
769 qsort (comments
->entries
, comments
->count
, sizeof (cpp_comment
),
772 /* Interleave comments and declarations in line number order. */
776 /* Advance j until comment j is in this file. */
777 while (j
!= comments
->count
778 && LOCATION_FILE (comments
->entries
[j
].sloc
) != source_file
)
781 /* Advance j until comment j is not a duplicate. */
782 while (j
< comments
->count
- 1
783 && !compare_comment (&comments
->entries
[j
],
784 &comments
->entries
[j
+ 1]))
787 /* Write decls until decl i collates after comment j. */
788 while (i
!= to_dump_count
)
790 if (j
== comments
->count
791 || LOCATION_LINE (decl_sloc (to_dump
[i
], false))
792 < LOCATION_LINE (comments
->entries
[j
].sloc
))
793 print_generic_ada_decl (pp
, to_dump
[i
++], source_file
);
798 /* Write comment j, if there is one. */
799 if (j
!= comments
->count
)
800 print_comment (pp
, comments
->entries
[j
++].comment
);
802 } while (i
!= to_dump_count
|| j
!= comments
->count
);
804 /* Clear the TREE_VISITED flag over each subtree we've dumped. */
805 for (i
= 0; i
< to_dump_count
; i
++)
806 walk_tree (&to_dump
[i
], unmark_visited_r
, NULL
, NULL
);
808 /* Finalize the to_dump table. */
817 /* Print a COMMENT to the output stream PP. */
820 print_comment (pretty_printer
*pp
, const char *comment
)
822 int len
= strlen (comment
);
823 char *str
= XALLOCAVEC (char, len
+ 1);
825 bool extra_newline
= false;
827 memcpy (str
, comment
, len
+ 1);
829 /* Trim C/C++ comment indicators. */
830 if (str
[len
- 2] == '*' && str
[len
- 1] == '/')
837 tok
= strtok (str
, "\n");
839 pp_string (pp
, " --");
842 tok
= strtok (NULL
, "\n");
844 /* Leave a blank line after multi-line comments. */
846 extra_newline
= true;
853 /* Print declaration DECL to PP in Ada syntax. The current source file being
854 handled is SOURCE_FILE. */
857 print_generic_ada_decl (pretty_printer
*pp
, tree decl
, const char *source_file
)
859 source_file_base
= source_file
;
861 if (print_ada_declaration (pp
, decl
, NULL_TREE
, INDENT_INCR
))
868 /* Dump a newline and indent BUFFER by SPC chars. */
871 newline_and_indent (pretty_printer
*buffer
, int spc
)
877 struct with
{ char *s
; const char *in_file
; int limited
; };
878 static struct with
*withs
= NULL
;
879 static int withs_max
= 4096;
880 static int with_len
= 0;
882 /* Record a "with" clause on package S (a limited with if LIMITED_ACCESS is
883 true), if not already done. */
886 append_withs (const char *s
, int limited_access
)
891 withs
= XNEWVEC (struct with
, withs_max
);
893 if (with_len
== withs_max
)
896 withs
= XRESIZEVEC (struct with
, withs
, withs_max
);
899 for (i
= 0; i
< with_len
; i
++)
900 if (!strcmp (s
, withs
[i
].s
)
901 && source_file_base
== withs
[i
].in_file
)
903 withs
[i
].limited
&= limited_access
;
907 withs
[with_len
].s
= xstrdup (s
);
908 withs
[with_len
].in_file
= source_file_base
;
909 withs
[with_len
].limited
= limited_access
;
913 /* Reset "with" clauses. */
916 reset_ada_withs (void)
923 for (i
= 0; i
< with_len
; i
++)
931 /* Dump "with" clauses in F. */
934 dump_ada_withs (FILE *f
)
938 fprintf (f
, "with Interfaces.C; use Interfaces.C;\n");
940 for (i
= 0; i
< with_len
; i
++)
942 (f
, "%swith %s;\n", withs
[i
].limited
? "limited " : "", withs
[i
].s
);
945 /* Return suitable Ada package name from FILE. */
948 get_ada_package (const char *file
)
956 s
= strstr (file
, "/include/");
960 base
= lbasename (file
);
962 if (ada_specs_parent
== NULL
)
965 plen
= strlen (ada_specs_parent
) + 1;
967 res
= XNEWVEC (char, plen
+ strlen (base
) + 1);
968 if (ada_specs_parent
!= NULL
) {
969 strcpy (res
, ada_specs_parent
);
973 for (i
= plen
; *base
; base
++, i
++)
985 res
[i
] = (i
== 0 || res
[i
- 1] == '.' || res
[i
- 1] == '_') ? 'u' : '_';
997 static const char *ada_reserved
[] = {
998 "abort", "abs", "abstract", "accept", "access", "aliased", "all", "and",
999 "array", "at", "begin", "body", "case", "constant", "declare", "delay",
1000 "delta", "digits", "do", "else", "elsif", "end", "entry", "exception",
1001 "exit", "for", "function", "generic", "goto", "if", "in", "interface", "is",
1002 "limited", "loop", "mod", "new", "not", "null", "others", "out", "of", "or",
1003 "overriding", "package", "pragma", "private", "procedure", "protected",
1004 "raise", "range", "record", "rem", "renames", "requeue", "return", "reverse",
1005 "select", "separate", "subtype", "synchronized", "tagged", "task",
1006 "terminate", "then", "type", "until", "use", "when", "while", "with", "xor",
1009 /* ??? would be nice to specify this list via a config file, so that users
1010 can create their own dictionary of conflicts. */
1011 static const char *c_duplicates
[] = {
1012 /* system will cause troubles with System.Address. */
1015 /* The following values have other definitions with same name/other
1021 "rl_readline_version",
1027 /* Return a declaration tree corresponding to TYPE. */
1030 get_underlying_decl (tree type
)
1035 /* type is a declaration. */
1039 /* type is a typedef. */
1040 if (TYPE_P (type
) && TYPE_NAME (type
) && DECL_P (TYPE_NAME (type
)))
1041 return TYPE_NAME (type
);
1043 /* TYPE_STUB_DECL has been set for type. */
1044 if (TYPE_P (type
) && TYPE_STUB_DECL (type
))
1045 return TYPE_STUB_DECL (type
);
1050 /* Return whether TYPE has static fields. */
1053 has_static_fields (const_tree type
)
1055 if (!type
|| !RECORD_OR_UNION_TYPE_P (type
))
1058 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= TREE_CHAIN (fld
))
1059 if (TREE_CODE (fld
) == VAR_DECL
&& DECL_NAME (fld
))
1065 /* Return whether TYPE corresponds to an Ada tagged type (has a dispatch
1069 is_tagged_type (const_tree type
)
1071 if (!type
|| !RECORD_OR_UNION_TYPE_P (type
))
1074 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= TREE_CHAIN (fld
))
1075 if (TREE_CODE (fld
) == FUNCTION_DECL
&& DECL_VINDEX (fld
))
1081 /* Return whether TYPE has non-trivial methods, i.e. methods that do something
1082 for the objects of TYPE. In C++, all classes have implicit special methods,
1083 e.g. constructors and destructors, but they can be trivial if the type is
1084 sufficiently simple. */
1087 has_nontrivial_methods (tree type
)
1089 if (!type
|| !RECORD_OR_UNION_TYPE_P (type
))
1092 /* Only C++ types can have methods. */
1096 /* A non-trivial type has non-trivial special methods. */
1097 if (!cpp_check (type
, IS_TRIVIAL
))
1100 /* If there are user-defined methods, they are deemed non-trivial. */
1101 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= DECL_CHAIN (fld
))
1102 if (TREE_CODE (TREE_TYPE (fld
)) == METHOD_TYPE
&& !DECL_ARTIFICIAL (fld
))
1108 /* Generate a legal Ada name from a C NAME, returning a malloc'd string.
1109 SPACE_FOUND, if not NULL, is used to indicate whether a space was found in
1113 to_ada_name (const char *name
, int *space_found
)
1116 int len
= strlen (name
);
1119 char *s
= XNEWVEC (char, len
* 2 + 5);
1123 *space_found
= false;
1125 /* Add trailing "c_" if name is an Ada reserved word. */
1126 for (names
= ada_reserved
; *names
; names
++)
1127 if (!strcasecmp (name
, *names
))
1136 /* Add trailing "c_" if name is an potential case sensitive duplicate. */
1137 for (names
= c_duplicates
; *names
; names
++)
1138 if (!strcmp (name
, *names
))
1146 for (j
= 0; name
[j
] == '_'; j
++)
1151 else if (*name
== '.' || *name
== '$')
1161 /* Replace unsuitable characters for Ada identifiers. */
1163 for (; j
< len
; j
++)
1168 *space_found
= true;
1172 /* ??? missing some C++ operators. */
1176 if (name
[j
+ 1] == '=')
1191 if (name
[j
+ 1] == '=')
1209 s
[len2
++] = name
[j
] == '&' ? 'a' : name
[j
] == '|' ? 'o' : 'x';
1211 if (name
[j
+ 1] == '=')
1224 if (s
[len2
- 1] != '_')
1227 switch (name
[j
+ 1]) {
1230 switch (name
[j
- 1]) {
1231 case '+': s
[len2
++] = 'p'; break; /* + */
1232 case '-': s
[len2
++] = 'm'; break; /* - */
1233 case '*': s
[len2
++] = 't'; break; /* * */
1234 case '/': s
[len2
++] = 'd'; break; /* / */
1240 switch (name
[j
- 1]) {
1241 case '+': s
[len2
++] = 'p'; break; /* += */
1242 case '-': s
[len2
++] = 'm'; break; /* -= */
1243 case '*': s
[len2
++] = 't'; break; /* *= */
1244 case '/': s
[len2
++] = 'd'; break; /* /= */
1278 c
= name
[j
] == '<' ? 'l' : 'g';
1281 switch (name
[j
+ 1]) {
1307 if (len2
&& s
[len2
- 1] == '_')
1312 s
[len2
++] = name
[j
];
1315 if (s
[len2
- 1] == '_')
1323 /* Return true if DECL refers to a C++ class type for which a
1324 separate enclosing package has been or should be generated. */
1327 separate_class_package (tree decl
)
1329 tree type
= TREE_TYPE (decl
);
1330 return has_nontrivial_methods (type
) || has_static_fields (type
);
1333 static bool package_prefix
= true;
1335 /* Dump in BUFFER the name of an identifier NODE of type TYPE, following Ada
1336 syntax. LIMITED_ACCESS indicates whether NODE can be accessed via a limited
1337 'with' clause rather than a regular 'with' clause. */
1340 pp_ada_tree_identifier (pretty_printer
*buffer
, tree node
, tree type
,
1343 const char *name
= IDENTIFIER_POINTER (node
);
1344 int space_found
= false;
1345 char *s
= to_ada_name (name
, &space_found
);
1348 /* If the entity is a type and comes from another file, generate "package"
1350 decl
= get_underlying_decl (type
);
1354 expanded_location xloc
= expand_location (decl_sloc (decl
, false));
1356 if (xloc
.file
&& xloc
.line
)
1358 if (xloc
.file
!= source_file_base
)
1360 switch (TREE_CODE (type
))
1365 case FIXED_POINT_TYPE
:
1367 case REFERENCE_TYPE
:
1375 char *s1
= get_ada_package (xloc
.file
);
1376 append_withs (s1
, limited_access
);
1377 pp_string (buffer
, s1
);
1386 /* Generate the additional package prefix for C++ classes. */
1387 if (separate_class_package (decl
))
1389 pp_string (buffer
, "Class_");
1390 pp_string (buffer
, s
);
1398 if (!strcmp (s
, "short_int"))
1399 pp_string (buffer
, "short");
1400 else if (!strcmp (s
, "short_unsigned_int"))
1401 pp_string (buffer
, "unsigned_short");
1402 else if (!strcmp (s
, "unsigned_int"))
1403 pp_string (buffer
, "unsigned");
1404 else if (!strcmp (s
, "long_int"))
1405 pp_string (buffer
, "long");
1406 else if (!strcmp (s
, "long_unsigned_int"))
1407 pp_string (buffer
, "unsigned_long");
1408 else if (!strcmp (s
, "long_long_int"))
1409 pp_string (buffer
, "Long_Long_Integer");
1410 else if (!strcmp (s
, "long_long_unsigned_int"))
1414 append_withs ("Interfaces.C.Extensions", false);
1415 pp_string (buffer
, "Extensions.unsigned_long_long");
1418 pp_string (buffer
, "unsigned_long_long");
1421 pp_string(buffer
, s
);
1423 if (!strcmp (s
, "bool"))
1427 append_withs ("Interfaces.C.Extensions", false);
1428 pp_string (buffer
, "Extensions.bool");
1431 pp_string (buffer
, "bool");
1434 pp_string(buffer
, s
);
1439 /* Dump in BUFFER the assembly name of T. */
1442 pp_asm_name (pretty_printer
*buffer
, tree t
)
1444 tree name
= DECL_ASSEMBLER_NAME (t
);
1445 char *ada_name
= XALLOCAVEC (char, IDENTIFIER_LENGTH (name
) + 1), *s
;
1446 const char *ident
= IDENTIFIER_POINTER (name
);
1448 for (s
= ada_name
; *ident
; ident
++)
1452 else if (*ident
!= '*')
1457 pp_string (buffer
, ada_name
);
1460 /* Dump in BUFFER the name of a DECL node if set, following Ada syntax.
1461 LIMITED_ACCESS indicates whether NODE can be accessed via a limited
1462 'with' clause rather than a regular 'with' clause. */
1465 dump_ada_decl_name (pretty_printer
*buffer
, tree decl
, int limited_access
)
1467 if (DECL_NAME (decl
))
1468 pp_ada_tree_identifier (buffer
, DECL_NAME (decl
), decl
, limited_access
);
1471 tree type_name
= TYPE_NAME (TREE_TYPE (decl
));
1475 pp_string (buffer
, "anon");
1476 if (TREE_CODE (decl
) == FIELD_DECL
)
1477 pp_scalar (buffer
, "%d", DECL_UID (decl
));
1479 pp_scalar (buffer
, "%d", TYPE_UID (TREE_TYPE (decl
)));
1481 else if (TREE_CODE (type_name
) == IDENTIFIER_NODE
)
1482 pp_ada_tree_identifier (buffer
, type_name
, decl
, limited_access
);
1486 /* Dump in BUFFER a name based on both T1 and T2 followed by a suffix. */
1489 dump_ada_double_name (pretty_printer
*buffer
, tree t1
, tree t2
)
1492 pp_ada_tree_identifier (buffer
, DECL_NAME (t1
), t1
, false);
1495 pp_string (buffer
, "anon");
1496 pp_scalar (buffer
, "%d", TYPE_UID (TREE_TYPE (t1
)));
1499 pp_underscore (buffer
);
1502 pp_ada_tree_identifier (buffer
, DECL_NAME (t2
), t2
, false);
1505 pp_string (buffer
, "anon");
1506 pp_scalar (buffer
, "%d", TYPE_UID (TREE_TYPE (t2
)));
1509 switch (TREE_CODE (TREE_TYPE (t2
)))
1512 pp_string (buffer
, "_array");
1515 pp_string (buffer
, "_struct");
1518 pp_string (buffer
, "_union");
1521 pp_string (buffer
, "_unknown");
1526 /* Dump in BUFFER pragma Import C/CPP on a given node T. */
1529 dump_ada_import (pretty_printer
*buffer
, tree t
)
1531 const char *name
= IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (t
));
1532 int is_stdcall
= TREE_CODE (t
) == FUNCTION_DECL
&&
1533 lookup_attribute ("stdcall", TYPE_ATTRIBUTES (TREE_TYPE (t
)));
1536 pp_string (buffer
, "pragma Import (Stdcall, ");
1537 else if (name
[0] == '_' && name
[1] == 'Z')
1538 pp_string (buffer
, "pragma Import (CPP, ");
1540 pp_string (buffer
, "pragma Import (C, ");
1542 dump_ada_decl_name (buffer
, t
, false);
1543 pp_string (buffer
, ", \"");
1546 pp_string (buffer
, IDENTIFIER_POINTER (DECL_NAME (t
)));
1548 pp_asm_name (buffer
, t
);
1550 pp_string (buffer
, "\");");
1553 /* Check whether T and its type have different names, and append "the_"
1554 otherwise in BUFFER. */
1557 check_name (pretty_printer
*buffer
, tree t
)
1560 tree tmp
= TREE_TYPE (t
);
1562 while (TREE_CODE (tmp
) == POINTER_TYPE
&& !TYPE_NAME (tmp
))
1563 tmp
= TREE_TYPE (tmp
);
1565 if (TREE_CODE (tmp
) != FUNCTION_TYPE
)
1567 if (TREE_CODE (tmp
) == IDENTIFIER_NODE
)
1568 s
= IDENTIFIER_POINTER (tmp
);
1569 else if (!TYPE_NAME (tmp
))
1571 else if (TREE_CODE (TYPE_NAME (tmp
)) == IDENTIFIER_NODE
)
1572 s
= IDENTIFIER_POINTER (TYPE_NAME (tmp
));
1574 s
= IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp
)));
1576 if (!strcasecmp (IDENTIFIER_POINTER (DECL_NAME (t
)), s
))
1577 pp_string (buffer
, "the_");
1581 /* Dump in BUFFER a function declaration FUNC with Ada syntax.
1582 IS_METHOD indicates whether FUNC is a C++ method.
1583 IS_CONSTRUCTOR whether FUNC is a C++ constructor.
1584 IS_DESTRUCTOR whether FUNC is a C++ destructor.
1585 SPC is the current indentation level. */
1588 dump_ada_function_declaration (pretty_printer
*buffer
, tree func
,
1589 int is_method
, int is_constructor
,
1590 int is_destructor
, int spc
)
1593 const tree node
= TREE_TYPE (func
);
1595 int num
= 0, num_args
= 0, have_args
= true, have_ellipsis
= false;
1597 /* Compute number of arguments. */
1598 arg
= TYPE_ARG_TYPES (node
);
1602 while (TREE_CHAIN (arg
) && arg
!= error_mark_node
)
1605 arg
= TREE_CHAIN (arg
);
1608 if (TREE_CODE (TREE_VALUE (arg
)) != VOID_TYPE
)
1611 have_ellipsis
= true;
1622 newline_and_indent (buffer
, spc
+ 1);
1627 pp_left_paren (buffer
);
1630 if (TREE_CODE (func
) == FUNCTION_DECL
)
1631 arg
= DECL_ARGUMENTS (func
);
1635 if (arg
== NULL_TREE
)
1638 arg
= TYPE_ARG_TYPES (node
);
1640 if (arg
&& TREE_CODE (TREE_VALUE (arg
)) == VOID_TYPE
)
1645 arg
= TREE_CHAIN (arg
);
1647 /* Print the argument names (if available) & types. */
1649 for (num
= 1; num
<= num_args
; num
++)
1653 if (DECL_NAME (arg
))
1655 check_name (buffer
, arg
);
1656 pp_ada_tree_identifier (buffer
, DECL_NAME (arg
), NULL_TREE
,
1658 pp_string (buffer
, " : ");
1662 sprintf (buf
, "arg%d : ", num
);
1663 pp_string (buffer
, buf
);
1666 dump_generic_ada_node (buffer
, TREE_TYPE (arg
), node
, spc
, 0, true);
1670 sprintf (buf
, "arg%d : ", num
);
1671 pp_string (buffer
, buf
);
1672 dump_generic_ada_node (buffer
, TREE_VALUE (arg
), node
, spc
, 0, true);
1675 /* If the type is a pointer to a tagged type, we need to differentiate
1676 virtual methods from the rest (non-virtual methods, static member
1677 or regular functions) and import only them as primitive operations,
1678 because they make up the virtual table which is mirrored on the Ada
1679 side by the dispatch table. So we add 'Class to the type of every
1680 parameter that is not the first one of a method which either has a
1681 slot in the virtual table or is a constructor. */
1683 && POINTER_TYPE_P (TREE_TYPE (arg
))
1684 && is_tagged_type (TREE_TYPE (TREE_TYPE (arg
)))
1685 && !(num
== 1 && is_method
&& (DECL_VINDEX (func
) || is_constructor
)))
1686 pp_string (buffer
, "'Class");
1688 arg
= TREE_CHAIN (arg
);
1692 pp_semicolon (buffer
);
1695 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
1703 pp_string (buffer
, " -- , ...");
1704 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
1708 pp_right_paren (buffer
);
1712 /* Dump in BUFFER all the domains associated with an array NODE,
1713 using Ada syntax. SPC is the current indentation level. */
1716 dump_ada_array_domains (pretty_printer
*buffer
, tree node
, int spc
)
1719 pp_left_paren (buffer
);
1721 for (; TREE_CODE (node
) == ARRAY_TYPE
; node
= TREE_TYPE (node
))
1723 tree domain
= TYPE_DOMAIN (node
);
1727 tree min
= TYPE_MIN_VALUE (domain
);
1728 tree max
= TYPE_MAX_VALUE (domain
);
1731 pp_string (buffer
, ", ");
1735 dump_generic_ada_node (buffer
, min
, NULL_TREE
, spc
, 0, true);
1736 pp_string (buffer
, " .. ");
1738 /* If the upper bound is zero, gcc may generate a NULL_TREE
1739 for TYPE_MAX_VALUE rather than an integer_cst. */
1741 dump_generic_ada_node (buffer
, max
, NULL_TREE
, spc
, 0, true);
1743 pp_string (buffer
, "0");
1746 pp_string (buffer
, "size_t");
1748 pp_right_paren (buffer
);
1751 /* Dump in BUFFER file:line information related to NODE. */
1754 dump_sloc (pretty_printer
*buffer
, tree node
)
1756 expanded_location xloc
;
1761 xloc
= expand_location (DECL_SOURCE_LOCATION (node
));
1762 else if (EXPR_HAS_LOCATION (node
))
1763 xloc
= expand_location (EXPR_LOCATION (node
));
1767 pp_string (buffer
, xloc
.file
);
1769 pp_decimal_int (buffer
, xloc
.line
);
1773 /* Return true if T designates a one dimension array of "char". */
1776 is_char_array (tree t
)
1781 /* Retrieve array's type. */
1783 while (TREE_CODE (TREE_TYPE (tmp
)) == ARRAY_TYPE
)
1786 tmp
= TREE_TYPE (tmp
);
1789 tmp
= TREE_TYPE (tmp
);
1790 return num_dim
== 1 && TREE_CODE (tmp
) == INTEGER_TYPE
1791 && id_equal (DECL_NAME (TYPE_NAME (tmp
)), "char");
1794 /* Dump in BUFFER an array type T in Ada syntax. Assume that the "type"
1795 keyword and name have already been printed. PARENT is the parent node of T.
1796 SPC is the indentation level. */
1799 dump_ada_array_type (pretty_printer
*buffer
, tree t
, tree parent
, int spc
)
1801 const bool char_array
= is_char_array (t
);
1804 /* Special case char arrays. */
1807 pp_string (buffer
, "Interfaces.C.char_array ");
1810 pp_string (buffer
, "array ");
1812 /* Print the dimensions. */
1813 dump_ada_array_domains (buffer
, TREE_TYPE (t
), spc
);
1815 /* Retrieve the element type. */
1816 tmp
= TREE_TYPE (t
);
1817 while (TREE_CODE (tmp
) == ARRAY_TYPE
)
1818 tmp
= TREE_TYPE (tmp
);
1820 /* Print array's type. */
1823 pp_string (buffer
, " of ");
1825 if (TREE_CODE (tmp
) != POINTER_TYPE
)
1826 pp_string (buffer
, "aliased ");
1828 if (TYPE_NAME (tmp
) || !RECORD_OR_UNION_TYPE_P (tmp
))
1829 dump_generic_ada_node (buffer
, tmp
, TREE_TYPE (t
), spc
, false, true);
1831 dump_ada_double_name (buffer
, parent
, get_underlying_decl (tmp
));
1835 /* Dump in BUFFER type names associated with a template, each prepended with
1836 '_'. TYPES is the TREE_PURPOSE of a DECL_TEMPLATE_INSTANTIATIONS. SPC is
1837 the indentation level. */
1840 dump_template_types (pretty_printer
*buffer
, tree types
, int spc
)
1843 size_t len
= TREE_VEC_LENGTH (types
);
1845 for (i
= 0; i
< len
; i
++)
1847 tree elem
= TREE_VEC_ELT (types
, i
);
1848 pp_underscore (buffer
);
1849 if (!dump_generic_ada_node (buffer
, elem
, 0, spc
, false, true))
1851 pp_string (buffer
, "unknown");
1852 pp_scalar (buffer
, "%lu", (unsigned long) TREE_HASH (elem
));
1857 /* Dump in BUFFER the contents of all class instantiations associated with
1858 a given template T. SPC is the indentation level. */
1861 dump_ada_template (pretty_printer
*buffer
, tree t
, int spc
)
1863 /* DECL_SIZE_UNIT is DECL_TEMPLATE_INSTANTIATIONS in this context. */
1864 tree inst
= DECL_SIZE_UNIT (t
);
1865 /* This emulates DECL_TEMPLATE_RESULT in this context. */
1866 struct tree_template_decl
{
1867 struct tree_decl_common common
;
1871 tree result
= ((struct tree_template_decl
*) t
)->result
;
1874 /* Don't look at template declarations declaring something coming from
1875 another file. This can occur for template friend declarations. */
1876 if (LOCATION_FILE (decl_sloc (result
, false))
1877 != LOCATION_FILE (decl_sloc (t
, false)))
1880 for (; inst
&& inst
!= error_mark_node
; inst
= TREE_CHAIN (inst
))
1882 tree types
= TREE_PURPOSE (inst
);
1883 tree instance
= TREE_VALUE (inst
);
1885 if (TREE_VEC_LENGTH (types
) == 0)
1888 if (!RECORD_OR_UNION_TYPE_P (instance
))
1891 /* We are interested in concrete template instantiations only: skip
1892 partially specialized nodes. */
1893 if (RECORD_OR_UNION_TYPE_P (instance
)
1895 && cpp_check (instance
, HAS_DEPENDENT_TEMPLATE_ARGS
))
1900 pp_string (buffer
, "package ");
1901 package_prefix
= false;
1902 dump_generic_ada_node (buffer
, instance
, t
, spc
, false, true);
1903 dump_template_types (buffer
, types
, spc
);
1904 pp_string (buffer
, " is");
1906 newline_and_indent (buffer
, spc
);
1908 TREE_VISITED (get_underlying_decl (instance
)) = 1;
1909 pp_string (buffer
, "type ");
1910 dump_generic_ada_node (buffer
, instance
, t
, spc
, false, true);
1911 package_prefix
= true;
1913 if (is_tagged_type (instance
))
1914 pp_string (buffer
, " is tagged limited ");
1916 pp_string (buffer
, " is limited ");
1918 dump_generic_ada_node (buffer
, instance
, t
, spc
, false, false);
1919 pp_newline (buffer
);
1921 newline_and_indent (buffer
, spc
);
1923 pp_string (buffer
, "end;");
1924 newline_and_indent (buffer
, spc
);
1925 pp_string (buffer
, "use ");
1926 package_prefix
= false;
1927 dump_generic_ada_node (buffer
, instance
, t
, spc
, false, true);
1928 dump_template_types (buffer
, types
, spc
);
1929 package_prefix
= true;
1930 pp_semicolon (buffer
);
1931 pp_newline (buffer
);
1932 pp_newline (buffer
);
1935 return num_inst
> 0;
1938 /* Return true if NODE is a simple enum types, that can be mapped to an
1939 Ada enum type directly. */
1942 is_simple_enum (tree node
)
1944 HOST_WIDE_INT count
= 0;
1947 for (value
= TYPE_VALUES (node
); value
; value
= TREE_CHAIN (value
))
1949 tree int_val
= TREE_VALUE (value
);
1951 if (TREE_CODE (int_val
) != INTEGER_CST
)
1952 int_val
= DECL_INITIAL (int_val
);
1954 if (!tree_fits_shwi_p (int_val
))
1956 else if (tree_to_shwi (int_val
) != count
)
1965 static bool bitfield_used
= false;
1967 /* Recursively dump in BUFFER Ada declarations corresponding to NODE of type
1968 TYPE. SPC is the indentation level. LIMITED_ACCESS indicates whether NODE
1969 can be referenced via a "limited with" clause. NAME_ONLY indicates whether
1970 we should only dump the name of NODE, instead of its full declaration. */
1973 dump_generic_ada_node (pretty_printer
*buffer
, tree node
, tree type
, int spc
,
1974 int limited_access
, bool name_only
)
1976 if (node
== NULL_TREE
)
1979 switch (TREE_CODE (node
))
1982 pp_string (buffer
, "<<< error >>>");
1985 case IDENTIFIER_NODE
:
1986 pp_ada_tree_identifier (buffer
, node
, type
, limited_access
);
1990 pp_string (buffer
, "--- unexpected node: TREE_LIST");
1994 dump_generic_ada_node
1995 (buffer
, BINFO_TYPE (node
), type
, spc
, limited_access
, name_only
);
1999 pp_string (buffer
, "--- unexpected node: TREE_VEC");
2005 append_withs ("System", false);
2006 pp_string (buffer
, "System.Address");
2009 pp_string (buffer
, "address");
2013 pp_string (buffer
, "<vector>");
2017 pp_string (buffer
, "<complex>");
2022 dump_generic_ada_node (buffer
, TYPE_NAME (node
), node
, spc
, 0, true);
2025 tree value
= TYPE_VALUES (node
);
2027 if (is_simple_enum (node
))
2031 newline_and_indent (buffer
, spc
- 1);
2032 pp_left_paren (buffer
);
2033 for (; value
; value
= TREE_CHAIN (value
))
2040 newline_and_indent (buffer
, spc
);
2043 pp_ada_tree_identifier
2044 (buffer
, TREE_PURPOSE (value
), node
, false);
2046 pp_string (buffer
, ");");
2048 newline_and_indent (buffer
, spc
);
2049 pp_string (buffer
, "pragma Convention (C, ");
2050 dump_generic_ada_node
2051 (buffer
, DECL_NAME (type
) ? type
: TYPE_NAME (node
), type
,
2053 pp_right_paren (buffer
);
2057 if (TYPE_UNSIGNED (node
))
2058 pp_string (buffer
, "unsigned");
2060 pp_string (buffer
, "int");
2061 for (; value
; value
= TREE_CHAIN (value
))
2063 pp_semicolon (buffer
);
2064 newline_and_indent (buffer
, spc
);
2066 pp_ada_tree_identifier
2067 (buffer
, TREE_PURPOSE (value
), node
, false);
2068 pp_string (buffer
, " : constant ");
2070 dump_generic_ada_node
2071 (buffer
, DECL_NAME (type
) ? type
: TYPE_NAME (node
), type
,
2074 pp_string (buffer
, " := ");
2075 dump_generic_ada_node
2077 TREE_CODE (TREE_VALUE (value
)) == INTEGER_CST
?
2078 TREE_VALUE (value
) : DECL_INITIAL (TREE_VALUE (value
)),
2079 node
, spc
, false, true);
2087 case FIXED_POINT_TYPE
:
2090 enum tree_code_class tclass
;
2092 tclass
= TREE_CODE_CLASS (TREE_CODE (node
));
2094 if (tclass
== tcc_declaration
)
2096 if (DECL_NAME (node
))
2097 pp_ada_tree_identifier
2098 (buffer
, DECL_NAME (node
), NULL_TREE
, limited_access
);
2100 pp_string (buffer
, "<unnamed type decl>");
2102 else if (tclass
== tcc_type
)
2104 if (TYPE_NAME (node
))
2106 if (TREE_CODE (TYPE_NAME (node
)) == IDENTIFIER_NODE
)
2107 pp_ada_tree_identifier (buffer
, TYPE_NAME (node
),
2108 node
, limited_access
);
2109 else if (TREE_CODE (TYPE_NAME (node
)) == TYPE_DECL
2110 && DECL_NAME (TYPE_NAME (node
)))
2111 dump_ada_decl_name (buffer
, TYPE_NAME (node
), limited_access
);
2113 pp_string (buffer
, "<unnamed type>");
2115 else if (TREE_CODE (node
) == INTEGER_TYPE
)
2117 append_withs ("Interfaces.C.Extensions", false);
2118 bitfield_used
= true;
2120 if (TYPE_PRECISION (node
) == 1)
2121 pp_string (buffer
, "Extensions.Unsigned_1");
2124 pp_string (buffer
, (TYPE_UNSIGNED (node
)
2125 ? "Extensions.Unsigned_"
2126 : "Extensions.Signed_"));
2127 pp_decimal_int (buffer
, TYPE_PRECISION (node
));
2131 pp_string (buffer
, "<unnamed type>");
2137 case REFERENCE_TYPE
:
2138 if (name_only
&& TYPE_NAME (node
))
2139 dump_generic_ada_node
2140 (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
, true);
2142 else if (TREE_CODE (TREE_TYPE (node
)) == FUNCTION_TYPE
)
2144 tree fnode
= TREE_TYPE (node
);
2147 if (VOID_TYPE_P (TREE_TYPE (fnode
)))
2149 is_function
= false;
2150 pp_string (buffer
, "access procedure");
2155 pp_string (buffer
, "access function");
2158 dump_ada_function_declaration
2159 (buffer
, node
, false, false, false, spc
+ INDENT_INCR
);
2163 pp_string (buffer
, " return ");
2164 dump_generic_ada_node
2165 (buffer
, TREE_TYPE (fnode
), type
, spc
, 0, true);
2168 /* If we are dumping the full type, it means we are part of a
2169 type definition and need also a Convention C pragma. */
2172 pp_semicolon (buffer
);
2173 newline_and_indent (buffer
, spc
);
2174 pp_string (buffer
, "pragma Convention (C, ");
2175 dump_generic_ada_node
2176 (buffer
, type
, 0, spc
, false, true);
2177 pp_right_paren (buffer
);
2182 int is_access
= false;
2183 unsigned int quals
= TYPE_QUALS (TREE_TYPE (node
));
2185 if (VOID_TYPE_P (TREE_TYPE (node
)))
2188 pp_string (buffer
, "new ");
2191 append_withs ("System", false);
2192 pp_string (buffer
, "System.Address");
2195 pp_string (buffer
, "address");
2199 if (TREE_CODE (node
) == POINTER_TYPE
2200 && TREE_CODE (TREE_TYPE (node
)) == INTEGER_TYPE
2202 (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME
2203 (TREE_TYPE (node
)))), "char"))
2206 pp_string (buffer
, "new ");
2210 pp_string (buffer
, "Interfaces.C.Strings.chars_ptr");
2211 append_withs ("Interfaces.C.Strings", false);
2214 pp_string (buffer
, "chars_ptr");
2218 tree type_name
= TYPE_NAME (TREE_TYPE (node
));
2219 tree decl
= get_underlying_decl (TREE_TYPE (node
));
2220 tree enclosing_decl
= get_underlying_decl (type
);
2222 /* For now, handle access-to-access, access-to-empty-struct
2223 or access-to-incomplete as opaque system.address. */
2224 if (TREE_CODE (TREE_TYPE (node
)) == POINTER_TYPE
2225 || (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node
))
2226 && !TYPE_FIELDS (TREE_TYPE (node
)))
2229 && !TREE_VISITED (decl
)
2230 && DECL_SOURCE_FILE (decl
) == source_file_base
)
2232 && !TREE_VISITED (decl
)
2233 && DECL_SOURCE_FILE (decl
)
2234 == DECL_SOURCE_FILE (enclosing_decl
)
2235 && decl_sloc (decl
, true)
2236 > decl_sloc (enclosing_decl
, true)))
2240 append_withs ("System", false);
2242 pp_string (buffer
, "new ");
2243 pp_string (buffer
, "System.Address");
2246 pp_string (buffer
, "address");
2250 if (!package_prefix
)
2251 pp_string (buffer
, "access");
2252 else if (AGGREGATE_TYPE_P (TREE_TYPE (node
)))
2254 if (!type
|| TREE_CODE (type
) != FUNCTION_DECL
)
2256 pp_string (buffer
, "access ");
2259 if (quals
& TYPE_QUAL_CONST
)
2260 pp_string (buffer
, "constant ");
2261 else if (!name_only
)
2262 pp_string (buffer
, "all ");
2264 else if (quals
& TYPE_QUAL_CONST
)
2265 pp_string (buffer
, "in ");
2269 pp_string (buffer
, "access ");
2270 /* ??? should be configurable: access or in out. */
2276 pp_string (buffer
, "access ");
2279 pp_string (buffer
, "all ");
2282 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node
)) && type_name
)
2283 dump_generic_ada_node (buffer
, type_name
, TREE_TYPE (node
),
2284 spc
, is_access
, true);
2286 dump_generic_ada_node (buffer
, TREE_TYPE (node
),
2287 TREE_TYPE (node
), spc
, 0, true);
2295 dump_generic_ada_node
2296 (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
, true);
2298 dump_ada_array_type (buffer
, node
, type
, spc
);
2305 if (TYPE_NAME (node
))
2306 dump_generic_ada_node
2307 (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
, true);
2310 pp_string (buffer
, "anon_");
2311 pp_scalar (buffer
, "%d", TYPE_UID (node
));
2315 print_ada_struct_decl (buffer
, node
, type
, spc
, true);
2319 /* We treat the upper half of the sizetype range as negative. This
2320 is consistent with the internal treatment and makes it possible
2321 to generate the (0 .. -1) range for flexible array members. */
2322 if (TREE_TYPE (node
) == sizetype
)
2323 node
= fold_convert (ssizetype
, node
);
2324 if (tree_fits_shwi_p (node
))
2325 pp_wide_integer (buffer
, tree_to_shwi (node
));
2326 else if (tree_fits_uhwi_p (node
))
2327 pp_unsigned_wide_integer (buffer
, tree_to_uhwi (node
));
2330 wide_int val
= node
;
2332 if (wi::neg_p (val
))
2337 sprintf (pp_buffer (buffer
)->digit_buffer
,
2338 "16#%" HOST_WIDE_INT_PRINT
"x",
2339 val
.elt (val
.get_len () - 1));
2340 for (i
= val
.get_len () - 2; i
>= 0; i
--)
2341 sprintf (pp_buffer (buffer
)->digit_buffer
,
2342 HOST_WIDE_INT_PRINT_PADDED_HEX
, val
.elt (i
));
2343 pp_string (buffer
, pp_buffer (buffer
)->digit_buffer
);
2356 dump_ada_decl_name (buffer
, node
, limited_access
);
2360 if (DECL_IS_BUILTIN (node
))
2362 /* Don't print the declaration of built-in types. */
2366 /* If we're in the middle of a declaration, defaults to
2370 append_withs ("System", false);
2371 pp_string (buffer
, "System.Address");
2374 pp_string (buffer
, "address");
2380 dump_ada_decl_name (buffer
, node
, limited_access
);
2383 if (is_tagged_type (TREE_TYPE (node
)))
2387 /* Look for ancestors. */
2388 for (tree fld
= TYPE_FIELDS (TREE_TYPE (node
));
2390 fld
= TREE_CHAIN (fld
))
2392 if (!DECL_NAME (fld
) && is_tagged_type (TREE_TYPE (fld
)))
2396 pp_string (buffer
, "limited new ");
2400 pp_string (buffer
, " and ");
2402 dump_ada_decl_name (buffer
, TYPE_NAME (TREE_TYPE (fld
)),
2407 pp_string (buffer
, first
? "tagged limited " : " with ");
2409 else if (has_nontrivial_methods (TREE_TYPE (node
)))
2410 pp_string (buffer
, "limited ");
2412 dump_generic_ada_node
2413 (buffer
, TREE_TYPE (node
), type
, spc
, false, false);
2420 case NAMESPACE_DECL
:
2421 dump_ada_decl_name (buffer
, node
, false);
2425 /* Ignore other nodes (e.g. expressions). */
2432 /* Dump in BUFFER NODE's methods. SPC is the indentation level. Return 1 if
2433 methods were printed, 0 otherwise. */
2436 print_ada_methods (pretty_printer
*buffer
, tree node
, int spc
)
2438 if (!has_nontrivial_methods (node
))
2441 pp_semicolon (buffer
);
2444 for (tree fld
= TYPE_FIELDS (node
); fld
; fld
= DECL_CHAIN (fld
))
2445 if (TREE_CODE (TREE_TYPE (fld
)) == METHOD_TYPE
)
2449 pp_newline (buffer
);
2450 pp_newline (buffer
);
2453 res
= print_ada_declaration (buffer
, fld
, node
, spc
);
2459 static void dump_nested_type (pretty_printer
*, tree
, tree
, tree
, int);
2461 /* Dump in BUFFER anonymous types nested inside T's definition.
2462 PARENT is the parent node of T.
2463 FORWARD indicates whether a forward declaration of T should be generated.
2464 SPC is the indentation level.
2466 In C anonymous nested tagged types have no name whereas in C++ they have
2467 one. In C their TYPE_DECL is at top level whereas in C++ it is nested.
2468 In both languages untagged types (pointers and arrays) have no name.
2469 In C++ the nested TYPE_DECLs can come after their associated FIELD_DECL.
2471 Therefore, in order to have a common processing for both languages, we
2472 disregard anonymous TYPE_DECLs at top level and here we make a first
2473 pass on the nested TYPE_DECLs and a second pass on the unnamed types. */
2476 dump_nested_types (pretty_printer
*buffer
, tree t
, tree parent
, bool forward
,
2481 /* Avoid recursing over the same tree. */
2482 if (TREE_VISITED (t
))
2485 /* Find possible anonymous pointers/arrays/structs/unions recursively. */
2486 type
= TREE_TYPE (t
);
2487 if (type
== NULL_TREE
)
2492 pp_string (buffer
, "type ");
2493 dump_generic_ada_node (buffer
, t
, t
, spc
, false, true);
2494 pp_semicolon (buffer
);
2495 newline_and_indent (buffer
, spc
);
2496 TREE_VISITED (t
) = 1;
2499 for (field
= TYPE_FIELDS (type
); field
; field
= TREE_CHAIN (field
))
2500 if (TREE_CODE (field
) == TYPE_DECL
2501 && DECL_NAME (field
) != DECL_NAME (t
)
2502 && TYPE_NAME (TREE_TYPE (field
)) != TYPE_NAME (type
))
2503 dump_nested_type (buffer
, field
, t
, parent
, spc
);
2505 for (field
= TYPE_FIELDS (type
); field
; field
= TREE_CHAIN (field
))
2506 if (TREE_CODE (field
) == FIELD_DECL
&& !TYPE_NAME (TREE_TYPE (field
)))
2507 dump_nested_type (buffer
, field
, t
, parent
, spc
);
2509 TREE_VISITED (t
) = 1;
2512 /* Dump in BUFFER the anonymous type of FIELD inside T.
2513 PARENT is the parent node of T.
2514 FORWARD indicates whether a forward declaration of T should be generated.
2515 SPC is the indentation level. */
2518 dump_nested_type (pretty_printer
*buffer
, tree field
, tree t
, tree parent
,
2521 tree field_type
= TREE_TYPE (field
);
2524 switch (TREE_CODE (field_type
))
2527 tmp
= TREE_TYPE (field_type
);
2529 if (TREE_CODE (tmp
) == FUNCTION_TYPE
)
2530 for (tmp
= TREE_TYPE (tmp
);
2531 tmp
&& TREE_CODE (tmp
) == POINTER_TYPE
;
2532 tmp
= TREE_TYPE (tmp
))
2535 decl
= get_underlying_decl (tmp
);
2537 && !DECL_IS_BUILTIN (decl
)
2538 && (!RECORD_OR_UNION_TYPE_P (TREE_TYPE (decl
))
2539 || TYPE_FIELDS (TREE_TYPE (decl
)))
2540 && !TREE_VISITED (decl
)
2541 && DECL_SOURCE_FILE (decl
) == DECL_SOURCE_FILE (t
)
2542 && decl_sloc (decl
, true) > decl_sloc (t
, true))
2544 /* Generate forward declaration. */
2545 pp_string (buffer
, "type ");
2546 dump_generic_ada_node (buffer
, decl
, 0, spc
, false, true);
2547 pp_semicolon (buffer
);
2548 newline_and_indent (buffer
, spc
);
2549 TREE_VISITED (decl
) = 1;
2554 tmp
= TREE_TYPE (field_type
);
2555 while (TREE_CODE (tmp
) == ARRAY_TYPE
)
2556 tmp
= TREE_TYPE (tmp
);
2557 decl
= get_underlying_decl (tmp
);
2558 if (decl
&& !DECL_NAME (decl
) && !TREE_VISITED (decl
))
2560 /* Generate full declaration. */
2561 dump_nested_type (buffer
, decl
, t
, parent
, spc
);
2562 TREE_VISITED (decl
) = 1;
2565 /* Special case char arrays. */
2566 if (is_char_array (field
))
2567 pp_string (buffer
, "sub");
2569 pp_string (buffer
, "type ");
2570 dump_ada_double_name (buffer
, parent
, field
);
2571 pp_string (buffer
, " is ");
2572 dump_ada_array_type (buffer
, field
, parent
, spc
);
2573 pp_semicolon (buffer
);
2574 newline_and_indent (buffer
, spc
);
2579 if (TYPE_NAME (TREE_TYPE (t
)) && !TREE_VISITED (t
))
2581 pp_string (buffer
, "type ");
2582 dump_generic_ada_node (buffer
, t
, parent
, spc
, false, true);
2583 pp_semicolon (buffer
);
2584 newline_and_indent (buffer
, spc
);
2587 TREE_VISITED (t
) = 1;
2588 dump_nested_types (buffer
, field
, t
, false, spc
);
2590 pp_string (buffer
, "type ");
2592 if (TYPE_NAME (field_type
))
2594 dump_generic_ada_node (buffer
, field_type
, 0, spc
, false, true);
2595 if (TREE_CODE (field_type
) == UNION_TYPE
)
2596 pp_string (buffer
, " (discr : unsigned := 0)");
2597 pp_string (buffer
, " is ");
2598 print_ada_struct_decl (buffer
, field_type
, t
, spc
, false);
2600 pp_string (buffer
, "pragma Convention (C_Pass_By_Copy, ");
2601 dump_generic_ada_node (buffer
, field_type
, 0, spc
, false, true);
2602 pp_string (buffer
, ");");
2603 newline_and_indent (buffer
, spc
);
2605 if (TREE_CODE (field_type
) == UNION_TYPE
)
2607 pp_string (buffer
, "pragma Unchecked_Union (");
2608 dump_generic_ada_node (buffer
, field_type
, 0, spc
, false, true);
2609 pp_string (buffer
, ");");
2614 dump_ada_double_name (buffer
, parent
, field
);
2615 if (TREE_CODE (field_type
) == UNION_TYPE
)
2616 pp_string (buffer
, " (discr : unsigned := 0)");
2617 pp_string (buffer
, " is ");
2618 print_ada_struct_decl (buffer
, field_type
, t
, spc
, false);
2620 pp_string (buffer
, "pragma Convention (C_Pass_By_Copy, ");
2621 dump_ada_double_name (buffer
, parent
, field
);
2622 pp_string (buffer
, ");");
2623 newline_and_indent (buffer
, spc
);
2625 if (TREE_CODE (field_type
) == UNION_TYPE
)
2627 pp_string (buffer
, "pragma Unchecked_Union (");
2628 dump_ada_double_name (buffer
, parent
, field
);
2629 pp_string (buffer
, ");");
2638 /* Dump in BUFFER constructor spec corresponding to T for TYPE. */
2641 print_constructor (pretty_printer
*buffer
, tree t
, tree type
)
2643 tree decl_name
= DECL_NAME (TYPE_NAME (type
));
2645 pp_string (buffer
, "New_");
2646 pp_ada_tree_identifier (buffer
, decl_name
, t
, false);
2649 /* Dump in BUFFER destructor spec corresponding to T. */
2652 print_destructor (pretty_printer
*buffer
, tree t
, tree type
)
2654 tree decl_name
= DECL_NAME (TYPE_NAME (type
));
2656 pp_string (buffer
, "Delete_");
2657 pp_ada_tree_identifier (buffer
, decl_name
, t
, false);
2660 /* Return the name of type T. */
2665 tree n
= TYPE_NAME (t
);
2667 if (TREE_CODE (n
) == IDENTIFIER_NODE
)
2668 return IDENTIFIER_POINTER (n
);
2670 return IDENTIFIER_POINTER (DECL_NAME (n
));
2673 /* Print in BUFFER the declaration of a variable T of type TYPE in Ada syntax.
2674 SPC is the indentation level. Return 1 if a declaration was printed,
2678 print_ada_declaration (pretty_printer
*buffer
, tree t
, tree type
, int spc
)
2680 int is_var
= 0, need_indent
= 0;
2681 int is_class
= false;
2682 tree name
= TYPE_NAME (TREE_TYPE (t
));
2683 tree decl_name
= DECL_NAME (t
);
2684 tree orig
= NULL_TREE
;
2686 if (cpp_check
&& cpp_check (t
, IS_TEMPLATE
))
2687 return dump_ada_template (buffer
, t
, spc
);
2689 if (TREE_CODE (t
) == CONST_DECL
&& TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
)
2690 /* Skip enumeral values: will be handled as part of the type itself. */
2693 if (TREE_CODE (t
) == TYPE_DECL
)
2695 orig
= DECL_ORIGINAL_TYPE (t
);
2697 if (orig
&& TYPE_STUB_DECL (orig
))
2699 tree stub
= TYPE_STUB_DECL (orig
);
2700 tree typ
= TREE_TYPE (stub
);
2702 if (TYPE_NAME (typ
))
2704 /* If types have same representation, and same name (ignoring
2705 casing), then ignore the second type. */
2706 if (type_name (typ
) == type_name (TREE_TYPE (t
))
2707 || !strcasecmp (type_name (typ
), type_name (TREE_TYPE (t
))))
2709 TREE_VISITED (t
) = 1;
2715 if (RECORD_OR_UNION_TYPE_P (typ
) && !TYPE_FIELDS (typ
))
2717 pp_string (buffer
, "-- skipped empty struct ");
2718 dump_generic_ada_node (buffer
, t
, type
, spc
, false, true);
2722 if (RECORD_OR_UNION_TYPE_P (typ
)
2723 && DECL_SOURCE_FILE (stub
) == source_file_base
)
2724 dump_nested_types (buffer
, stub
, stub
, true, spc
);
2726 pp_string (buffer
, "subtype ");
2727 dump_generic_ada_node (buffer
, t
, type
, spc
, false, true);
2728 pp_string (buffer
, " is ");
2729 dump_generic_ada_node (buffer
, typ
, type
, spc
, false, true);
2730 pp_string (buffer
, "; -- ");
2731 dump_sloc (buffer
, t
);
2734 TREE_VISITED (t
) = 1;
2739 /* Skip unnamed or anonymous structs/unions/enum types. */
2740 if (!orig
&& !decl_name
&& !name
2741 && (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
))
2742 || TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
))
2745 /* Skip anonymous enum types (duplicates of real types). */
2747 && TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
2749 && (*IDENTIFIER_POINTER (decl_name
) == '.'
2750 || *IDENTIFIER_POINTER (decl_name
) == '$'))
2755 switch (TREE_CODE (TREE_TYPE (t
)))
2759 /* Skip empty structs (typically forward references to real
2761 if (!TYPE_FIELDS (TREE_TYPE (t
)))
2763 pp_string (buffer
, "-- skipped empty struct ");
2764 dump_generic_ada_node (buffer
, t
, type
, spc
, false, true);
2769 && (*IDENTIFIER_POINTER (decl_name
) == '.'
2770 || *IDENTIFIER_POINTER (decl_name
) == '$'))
2772 pp_string (buffer
, "-- skipped anonymous struct ");
2773 dump_generic_ada_node (buffer
, t
, type
, spc
, false, true);
2774 TREE_VISITED (t
) = 1;
2778 if (orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
2779 pp_string (buffer
, "subtype ");
2782 dump_nested_types (buffer
, t
, t
, false, spc
);
2784 if (separate_class_package (t
))
2787 pp_string (buffer
, "package Class_");
2788 dump_generic_ada_node (buffer
, t
, type
, spc
, false, true);
2789 pp_string (buffer
, " is");
2791 newline_and_indent (buffer
, spc
);
2794 pp_string (buffer
, "type ");
2800 case REFERENCE_TYPE
:
2801 if ((orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
2802 || is_char_array (t
))
2803 pp_string (buffer
, "subtype ");
2805 pp_string (buffer
, "type ");
2809 pp_string (buffer
, "-- skipped function type ");
2810 dump_generic_ada_node (buffer
, t
, type
, spc
, false, true);
2814 if ((orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
2815 || !is_simple_enum (TREE_TYPE (t
)))
2816 pp_string (buffer
, "subtype ");
2818 pp_string (buffer
, "type ");
2822 pp_string (buffer
, "subtype ");
2824 TREE_VISITED (t
) = 1;
2830 && *IDENTIFIER_POINTER (decl_name
) == '_')
2836 /* Print the type and name. */
2837 if (TREE_CODE (TREE_TYPE (t
)) == ARRAY_TYPE
)
2842 /* Print variable's name. */
2843 dump_generic_ada_node (buffer
, t
, type
, spc
, false, true);
2845 if (TREE_CODE (t
) == TYPE_DECL
)
2847 pp_string (buffer
, " is ");
2849 if (orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
2850 dump_generic_ada_node
2851 (buffer
, TYPE_NAME (orig
), type
, spc
, false, true);
2853 dump_ada_array_type (buffer
, t
, type
, spc
);
2857 tree tmp
= TYPE_NAME (TREE_TYPE (t
));
2859 if (spc
== INDENT_INCR
|| TREE_STATIC (t
))
2862 pp_string (buffer
, " : ");
2864 if (TREE_CODE (TREE_TYPE (TREE_TYPE (t
))) != POINTER_TYPE
)
2865 pp_string (buffer
, "aliased ");
2868 dump_generic_ada_node (buffer
, tmp
, type
, spc
, false, true);
2870 dump_ada_double_name (buffer
, type
, t
);
2872 dump_ada_array_type (buffer
, t
, type
, spc
);
2875 else if (TREE_CODE (t
) == FUNCTION_DECL
)
2877 bool is_function
, is_abstract_class
= false;
2878 bool is_method
= TREE_CODE (TREE_TYPE (t
)) == METHOD_TYPE
;
2879 tree decl_name
= DECL_NAME (t
);
2880 bool is_abstract
= false;
2881 bool is_constructor
= false;
2882 bool is_destructor
= false;
2883 bool is_copy_constructor
= false;
2884 bool is_move_constructor
= false;
2891 is_abstract
= cpp_check (t
, IS_ABSTRACT
);
2892 is_constructor
= cpp_check (t
, IS_CONSTRUCTOR
);
2893 is_destructor
= cpp_check (t
, IS_DESTRUCTOR
);
2894 is_copy_constructor
= cpp_check (t
, IS_COPY_CONSTRUCTOR
);
2895 is_move_constructor
= cpp_check (t
, IS_MOVE_CONSTRUCTOR
);
2898 /* Skip copy constructors and C++11 move constructors: some are internal
2899 only and those that are not cannot be called easily from Ada. */
2900 if (is_copy_constructor
|| is_move_constructor
)
2903 if (is_constructor
|| is_destructor
)
2905 /* ??? Skip implicit constructors/destructors for now. */
2906 if (DECL_ARTIFICIAL (t
))
2909 /* Only consider constructors/destructors for complete objects. */
2910 if (strncmp (IDENTIFIER_POINTER (decl_name
), "__ct_comp", 9) != 0
2911 && strncmp (IDENTIFIER_POINTER (decl_name
), "__dt_comp", 9) != 0)
2915 /* If this function has an entry in the vtable, we cannot omit it. */
2916 else if (!DECL_VINDEX (t
) && *IDENTIFIER_POINTER (decl_name
) == '_')
2919 pp_string (buffer
, "-- skipped func ");
2920 pp_string (buffer
, IDENTIFIER_POINTER (decl_name
));
2927 if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t
))) && !is_constructor
)
2929 pp_string (buffer
, "procedure ");
2930 is_function
= false;
2934 pp_string (buffer
, "function ");
2939 print_constructor (buffer
, t
, type
);
2940 else if (is_destructor
)
2941 print_destructor (buffer
, t
, type
);
2943 dump_ada_decl_name (buffer
, t
, false);
2945 dump_ada_function_declaration
2946 (buffer
, t
, is_method
, is_constructor
, is_destructor
, spc
);
2950 pp_string (buffer
, " return ");
2952 = is_constructor
? DECL_CONTEXT (t
) : TREE_TYPE (TREE_TYPE (t
));
2953 dump_generic_ada_node (buffer
, ret_type
, type
, spc
, false, true);
2956 if (is_constructor
&& RECORD_OR_UNION_TYPE_P (type
))
2957 for (tree fld
= TYPE_FIELDS (type
); fld
; fld
= DECL_CHAIN (fld
))
2958 if (TREE_CODE (TREE_TYPE (fld
)) == METHOD_TYPE
2959 && cpp_check (fld
, IS_ABSTRACT
))
2961 is_abstract_class
= true;
2965 if (is_abstract
|| is_abstract_class
)
2966 pp_string (buffer
, " is abstract");
2968 pp_semicolon (buffer
);
2969 pp_string (buffer
, " -- ");
2970 dump_sloc (buffer
, t
);
2972 if (is_abstract
|| !DECL_ASSEMBLER_NAME (t
))
2975 newline_and_indent (buffer
, spc
);
2979 pp_string (buffer
, "pragma CPP_Constructor (");
2980 print_constructor (buffer
, t
, type
);
2981 pp_string (buffer
, ", \"");
2982 pp_asm_name (buffer
, t
);
2983 pp_string (buffer
, "\");");
2985 else if (is_destructor
)
2987 pp_string (buffer
, "pragma Import (CPP, ");
2988 print_destructor (buffer
, t
, type
);
2989 pp_string (buffer
, ", \"");
2990 pp_asm_name (buffer
, t
);
2991 pp_string (buffer
, "\");");
2995 dump_ada_import (buffer
, t
);
3000 else if (TREE_CODE (t
) == TYPE_DECL
&& !DECL_ORIGINAL_TYPE (t
))
3002 int is_interface
= 0;
3003 int is_abstract_record
= 0;
3008 /* Anonymous structs/unions */
3009 dump_generic_ada_node (buffer
, TREE_TYPE (t
), t
, spc
, false, true);
3011 if (TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
)
3013 pp_string (buffer
, " (discr : unsigned := 0)");
3016 pp_string (buffer
, " is ");
3018 /* Check whether we have an Ada interface compatible class.
3019 That is only have a vtable non-static data member and no
3020 non-abstract methods. */
3022 && RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
)))
3024 bool has_fields
= false;
3026 /* Check that there are no fields other than the virtual table. */
3027 for (tree fld
= TYPE_FIELDS (TREE_TYPE (t
));
3029 fld
= TREE_CHAIN (fld
))
3031 if (TREE_CODE (fld
) == FIELD_DECL
)
3033 if (!has_fields
&& DECL_VIRTUAL_P (fld
))
3039 else if (TREE_CODE (TREE_TYPE (fld
)) == METHOD_TYPE
3040 && !DECL_ARTIFICIAL (fld
))
3042 if (cpp_check (fld
, IS_ABSTRACT
))
3043 is_abstract_record
= 1;
3050 TREE_VISITED (t
) = 1;
3053 pp_string (buffer
, "limited interface; -- ");
3054 dump_sloc (buffer
, t
);
3055 newline_and_indent (buffer
, spc
);
3056 pp_string (buffer
, "pragma Import (CPP, ");
3057 dump_generic_ada_node
3058 (buffer
, TYPE_NAME (TREE_TYPE (t
)), type
, spc
, false, true);
3059 pp_right_paren (buffer
);
3061 print_ada_methods (buffer
, TREE_TYPE (t
), spc
);
3065 if (is_abstract_record
)
3066 pp_string (buffer
, "abstract ");
3067 dump_generic_ada_node (buffer
, t
, t
, spc
, false, false);
3075 if (TREE_CODE (t
) == FIELD_DECL
&& DECL_NAME (t
))
3076 check_name (buffer
, t
);
3078 /* Print variable/type's name. */
3079 dump_generic_ada_node (buffer
, t
, t
, spc
, false, true);
3081 if (TREE_CODE (t
) == TYPE_DECL
)
3083 tree orig
= DECL_ORIGINAL_TYPE (t
);
3084 int is_subtype
= orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
);
3086 if (!is_subtype
&& TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
)
3087 pp_string (buffer
, " (discr : unsigned := 0)");
3089 pp_string (buffer
, " is ");
3091 dump_generic_ada_node (buffer
, orig
, t
, spc
, false, is_subtype
);
3095 if (spc
== INDENT_INCR
|| TREE_STATIC (t
))
3098 pp_string (buffer
, " : ");
3100 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
)))
3102 pp_string (buffer
, "aliased ");
3104 if (TREE_READONLY (t
))
3105 pp_string (buffer
, "constant ");
3107 if (TYPE_NAME (TREE_TYPE (t
)))
3108 dump_generic_ada_node
3109 (buffer
, TREE_TYPE (t
), t
, spc
, false, true);
3111 dump_ada_double_name (buffer
, type
, t
);
3115 if (TREE_CODE (TREE_TYPE (t
)) != POINTER_TYPE
3116 && (TYPE_NAME (TREE_TYPE (t
))
3117 || TREE_CODE (TREE_TYPE (t
)) != INTEGER_TYPE
))
3118 pp_string (buffer
, "aliased ");
3120 if (TREE_READONLY (t
))
3121 pp_string (buffer
, "constant ");
3123 dump_generic_ada_node
3124 (buffer
, TREE_TYPE (t
), TREE_TYPE (t
), spc
, false, true);
3132 newline_and_indent (buffer
, spc
);
3133 pp_string (buffer
, "end;");
3134 newline_and_indent (buffer
, spc
);
3135 pp_string (buffer
, "use Class_");
3136 dump_generic_ada_node (buffer
, t
, type
, spc
, false, true);
3137 pp_semicolon (buffer
);
3138 pp_newline (buffer
);
3140 /* All needed indentation/newline performed already, so return 0. */
3145 pp_string (buffer
, "; -- ");
3146 dump_sloc (buffer
, t
);
3151 newline_and_indent (buffer
, spc
);
3152 dump_ada_import (buffer
, t
);
3158 /* Prints in BUFFER a structure NODE of type TYPE: name, fields, and methods
3159 with Ada syntax. SPC is the indentation level. If DISPLAY_CONVENTION is
3160 true, also print the pragma Convention for NODE. */
3163 print_ada_struct_decl (pretty_printer
*buffer
, tree node
, tree type
, int spc
,
3164 bool display_convention
)
3167 const bool is_union
= (TREE_CODE (node
) == UNION_TYPE
);
3170 int field_spc
= spc
+ INDENT_INCR
;
3173 bitfield_used
= false;
3175 if (TYPE_FIELDS (node
))
3177 /* Print the contents of the structure. */
3178 pp_string (buffer
, "record");
3182 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
3183 pp_string (buffer
, "case discr is");
3184 field_spc
= spc
+ INDENT_INCR
* 3;
3187 pp_newline (buffer
);
3189 /* Print the non-static fields of the structure. */
3190 for (tmp
= TYPE_FIELDS (node
); tmp
; tmp
= TREE_CHAIN (tmp
))
3192 /* Add parent field if needed. */
3193 if (!DECL_NAME (tmp
))
3195 if (!is_tagged_type (TREE_TYPE (tmp
)))
3197 if (!TYPE_NAME (TREE_TYPE (tmp
)))
3198 print_ada_declaration (buffer
, tmp
, type
, field_spc
);
3204 pp_string (buffer
, "parent : aliased ");
3207 sprintf (buf
, "field_%d : aliased ", field_num
+ 1);
3208 pp_string (buffer
, buf
);
3211 (buffer
, TYPE_NAME (TREE_TYPE (tmp
)), false);
3212 pp_semicolon (buffer
);
3214 pp_newline (buffer
);
3218 else if (TREE_CODE (tmp
) == FIELD_DECL
)
3220 /* Skip internal virtual table field. */
3221 if (!DECL_VIRTUAL_P (tmp
))
3225 if (TREE_CHAIN (tmp
)
3226 && TREE_TYPE (TREE_CHAIN (tmp
)) != node
3227 && TREE_CODE (TREE_CHAIN (tmp
)) != TYPE_DECL
)
3228 sprintf (buf
, "when %d =>", field_num
);
3230 sprintf (buf
, "when others =>");
3232 INDENT (spc
+ INDENT_INCR
* 2);
3233 pp_string (buffer
, buf
);
3234 pp_newline (buffer
);
3237 if (print_ada_declaration (buffer
, tmp
, type
, field_spc
))
3239 pp_newline (buffer
);
3248 INDENT (spc
+ INDENT_INCR
);
3249 pp_string (buffer
, "end case;");
3250 pp_newline (buffer
);
3255 INDENT (spc
+ INDENT_INCR
);
3256 pp_string (buffer
, "null;");
3257 pp_newline (buffer
);
3261 pp_string (buffer
, "end record;");
3264 pp_string (buffer
, "null record;");
3266 newline_and_indent (buffer
, spc
);
3268 if (!display_convention
)
3271 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (type
)))
3273 if (has_nontrivial_methods (TREE_TYPE (type
)))
3274 pp_string (buffer
, "pragma Import (CPP, ");
3276 pp_string (buffer
, "pragma Convention (C_Pass_By_Copy, ");
3279 pp_string (buffer
, "pragma Convention (C, ");
3281 package_prefix
= false;
3282 dump_generic_ada_node (buffer
, TREE_TYPE (type
), type
, spc
, false, true);
3283 package_prefix
= true;
3284 pp_right_paren (buffer
);
3288 pp_semicolon (buffer
);
3289 newline_and_indent (buffer
, spc
);
3290 pp_string (buffer
, "pragma Unchecked_Union (");
3292 dump_generic_ada_node (buffer
, TREE_TYPE (type
), type
, spc
, false, true);
3293 pp_right_paren (buffer
);
3298 pp_semicolon (buffer
);
3299 newline_and_indent (buffer
, spc
);
3300 pp_string (buffer
, "pragma Pack (");
3301 dump_generic_ada_node
3302 (buffer
, TREE_TYPE (type
), type
, spc
, false, true);
3303 pp_right_paren (buffer
);
3304 bitfield_used
= false;
3307 need_semicolon
= !print_ada_methods (buffer
, node
, spc
);
3309 /* Print the static fields of the structure, if any. */
3310 for (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 print_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
))
3438 /* Iterate over the list of files to dump specs for */
3439 for (i
= 0; i
< source_refs_used
; i
++)
3440 dump_ads (source_refs
[i
], collect_all_refs
, check
);
3442 /* Free files table. */