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-2014 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"
28 #include "c-ada-spec.h"
31 #include "cpp-id-data.h"
33 /* Adapted from hwint.h to use the Ada prefix. */
34 #if HOST_BITS_PER_WIDE_INT == HOST_BITS_PER_LONG
35 # if HOST_BITS_PER_WIDE_INT == 64
36 # define ADA_HOST_WIDE_INT_PRINT_DOUBLE_HEX \
37 "16#%" HOST_LONG_FORMAT "x%016" HOST_LONG_FORMAT "x#"
39 # define ADA_HOST_WIDE_INT_PRINT_DOUBLE_HEX \
40 "16#%" HOST_LONG_FORMAT "x%08" HOST_LONG_FORMAT "x#"
43 /* We can assume that 'long long' is at least 64 bits. */
44 # define ADA_HOST_WIDE_INT_PRINT_DOUBLE_HEX \
45 "16#%" HOST_LONG_LONG_FORMAT "x%016" HOST_LONG_LONG_FORMAT "x#"
46 #endif /* HOST_BITS_PER_WIDE_INT == HOST_BITS_PER_LONG */
48 /* Local functions, macros and variables. */
49 static int dump_generic_ada_node (pretty_printer
*, tree
, tree
, int, int,
51 static int print_ada_declaration (pretty_printer
*, tree
, tree
, int);
52 static void print_ada_struct_decl (pretty_printer
*, tree
, tree
, int, bool);
53 static void dump_sloc (pretty_printer
*buffer
, tree node
);
54 static void print_comment (pretty_printer
*, const char *);
55 static void print_generic_ada_decl (pretty_printer
*, tree
, const char *);
56 static char *get_ada_package (const char *);
57 static void dump_ada_nodes (pretty_printer
*, const char *);
58 static void reset_ada_withs (void);
59 static void dump_ada_withs (FILE *);
60 static void dump_ads (const char *, void (*)(const char *),
61 int (*)(tree
, cpp_operation
));
62 static char *to_ada_name (const char *, int *);
63 static bool separate_class_package (tree
);
65 #define INDENT(SPACE) \
66 do { int i; for (i = 0; i<SPACE; i++) pp_space (buffer); } while (0)
70 /* Global hook used to perform C++ queries on nodes. */
71 static int (*cpp_check
) (tree
, cpp_operation
) = NULL
;
74 /* Given a cpp MACRO, compute the max length BUFFER_LEN of the macro, as well
75 as max length PARAM_LEN of arguments for fun_like macros, and also set
76 SUPPORTED to 0 if the macro cannot be mapped to an Ada construct. */
79 macro_length (const cpp_macro
*macro
, int *supported
, int *buffer_len
,
92 for (i
= 0; i
< macro
->paramc
; i
++)
94 cpp_hashnode
*param
= macro
->params
[i
];
96 *param_len
+= NODE_LEN (param
);
98 if (i
+ 1 < macro
->paramc
)
100 *param_len
+= 2; /* ", " */
102 else if (macro
->variadic
)
108 *param_len
+= 2; /* ")\0" */
111 for (j
= 0; j
< macro
->count
; j
++)
113 cpp_token
*token
= ¯o
->exp
.tokens
[j
];
115 if (token
->flags
& PREV_WHITE
)
118 if (token
->flags
& STRINGIFY_ARG
|| token
->flags
& PASTE_LEFT
)
124 if (token
->type
== CPP_MACRO_ARG
)
126 NODE_LEN (macro
->params
[token
->val
.macro_arg
.arg_no
- 1]);
128 /* Include enough extra space to handle e.g. special characters. */
129 *buffer_len
+= (cpp_token_len (token
) + 1) * 8;
135 /* Dump into PP a set of MAX_ADA_MACROS MACROS (C/C++) as Ada constants when
139 print_ada_macros (pretty_printer
*pp
, cpp_hashnode
**macros
, int max_ada_macros
)
141 int j
, num_macros
= 0, prev_line
= -1;
143 for (j
= 0; j
< max_ada_macros
; j
++)
145 cpp_hashnode
*node
= macros
[j
];
146 const cpp_macro
*macro
= node
->value
.macro
;
148 int supported
= 1, prev_is_one
= 0, buffer_len
, param_len
;
149 int is_string
= 0, is_char
= 0;
151 unsigned char *s
, *params
, *buffer
, *buf_param
, *char_one
= NULL
;
153 macro_length (macro
, &supported
, &buffer_len
, ¶m_len
);
154 s
= buffer
= XALLOCAVEC (unsigned char, buffer_len
);
155 params
= buf_param
= XALLOCAVEC (unsigned char, param_len
);
162 for (i
= 0; i
< macro
->paramc
; i
++)
164 cpp_hashnode
*param
= macro
->params
[i
];
166 memcpy (buf_param
, NODE_NAME (param
), NODE_LEN (param
));
167 buf_param
+= NODE_LEN (param
);
169 if (i
+ 1 < macro
->paramc
)
174 else if (macro
->variadic
)
184 for (i
= 0; supported
&& i
< macro
->count
; i
++)
186 cpp_token
*token
= ¯o
->exp
.tokens
[i
];
189 if (token
->flags
& PREV_WHITE
)
192 if (token
->flags
& STRINGIFY_ARG
|| token
->flags
& PASTE_LEFT
)
202 cpp_hashnode
*param
=
203 macro
->params
[token
->val
.macro_arg
.arg_no
- 1];
204 memcpy (buffer
, NODE_NAME (param
), NODE_LEN (param
));
205 buffer
+= NODE_LEN (param
);
209 case CPP_EQ_EQ
: *buffer
++ = '='; break;
210 case CPP_GREATER
: *buffer
++ = '>'; break;
211 case CPP_LESS
: *buffer
++ = '<'; break;
212 case CPP_PLUS
: *buffer
++ = '+'; break;
213 case CPP_MINUS
: *buffer
++ = '-'; break;
214 case CPP_MULT
: *buffer
++ = '*'; break;
215 case CPP_DIV
: *buffer
++ = '/'; break;
216 case CPP_COMMA
: *buffer
++ = ','; break;
217 case CPP_OPEN_SQUARE
:
218 case CPP_OPEN_PAREN
: *buffer
++ = '('; break;
219 case CPP_CLOSE_SQUARE
: /* fallthrough */
220 case CPP_CLOSE_PAREN
: *buffer
++ = ')'; break;
221 case CPP_DEREF
: /* fallthrough */
222 case CPP_SCOPE
: /* fallthrough */
223 case CPP_DOT
: *buffer
++ = '.'; break;
225 case CPP_EQ
: *buffer
++ = ':'; *buffer
++ = '='; break;
226 case CPP_NOT_EQ
: *buffer
++ = '/'; *buffer
++ = '='; break;
227 case CPP_GREATER_EQ
: *buffer
++ = '>'; *buffer
++ = '='; break;
228 case CPP_LESS_EQ
: *buffer
++ = '<'; *buffer
++ = '='; break;
231 *buffer
++ = 'n'; *buffer
++ = 'o'; *buffer
++ = 't'; break;
233 *buffer
++ = 'm'; *buffer
++ = 'o'; *buffer
++ = 'd'; break;
235 *buffer
++ = 'a'; *buffer
++ = 'n'; *buffer
++ = 'd'; break;
237 *buffer
++ = 'o'; *buffer
++ = 'r'; break;
239 *buffer
++ = 'x'; *buffer
++ = 'o'; *buffer
++ = 'r'; break;
241 strcpy ((char *) buffer
, " and then ");
245 strcpy ((char *) buffer
, " or else ");
251 is_one
= prev_is_one
;
254 case CPP_COMMENT
: break;
266 if (!macro
->fun_like
)
269 buffer
= cpp_spell_token (parse_in
, token
, buffer
, false);
279 c
= cpp_interpret_charconst (parse_in
, token
,
280 &chars_seen
, &ignored
);
281 if (c
>= 32 && c
<= 126)
284 *buffer
++ = (char) c
;
290 ((char *) buffer
, "Character'Val (%d)", (int) c
);
291 buffer
+= chars_seen
;
299 /* Replace "1 << N" by "2 ** N" */
326 case CPP_CLOSE_BRACE
:
330 case CPP_MINUS_MINUS
:
334 case CPP_HEADER_NAME
:
337 case CPP_OBJC_STRING
:
339 if (!macro
->fun_like
)
342 buffer
= cpp_spell_token (parse_in
, token
, buffer
, false);
346 prev_is_one
= is_one
;
353 if (macro
->fun_like
&& supported
)
355 char *start
= (char *) s
;
358 pp_string (pp
, " -- arg-macro: ");
360 if (*start
== '(' && buffer
[-1] == ')')
365 pp_string (pp
, "function ");
369 pp_string (pp
, "procedure ");
372 pp_string (pp
, (const char *) NODE_NAME (node
));
374 pp_string (pp
, (char *) params
);
376 pp_string (pp
, " -- ");
380 pp_string (pp
, "return ");
381 pp_string (pp
, start
);
385 pp_string (pp
, start
);
391 expanded_location sloc
= expand_location (macro
->line
);
393 if (sloc
.line
!= prev_line
+ 1)
397 prev_line
= sloc
.line
;
400 ada_name
= to_ada_name ((const char *) NODE_NAME (node
), NULL
);
401 pp_string (pp
, ada_name
);
403 pp_string (pp
, " : ");
406 pp_string (pp
, "aliased constant String");
408 pp_string (pp
, "aliased constant Character");
410 pp_string (pp
, "constant");
412 pp_string (pp
, " := ");
413 pp_string (pp
, (char *) s
);
416 pp_string (pp
, " & ASCII.NUL");
418 pp_string (pp
, "; -- ");
419 pp_string (pp
, sloc
.file
);
421 pp_scalar (pp
, "%d", sloc
.line
);
426 pp_string (pp
, " -- unsupported macro: ");
427 pp_string (pp
, (const char *) cpp_macro_definition (parse_in
, node
));
436 static const char *source_file
;
437 static int max_ada_macros
;
439 /* Callback used to count the number of relevant macros from
440 cpp_forall_identifiers. PFILE and V are not used. NODE is the current macro
444 count_ada_macro (cpp_reader
*pfile ATTRIBUTE_UNUSED
, cpp_hashnode
*node
,
445 void *v ATTRIBUTE_UNUSED
)
447 const cpp_macro
*macro
= node
->value
.macro
;
449 if (node
->type
== NT_MACRO
&& !(node
->flags
& NODE_BUILTIN
)
451 && *NODE_NAME (node
) != '_'
452 && LOCATION_FILE (macro
->line
) == source_file
)
458 static int store_ada_macro_index
;
460 /* Callback used to store relevant macros from cpp_forall_identifiers.
461 PFILE is not used. NODE is the current macro to store if relevant.
462 MACROS is an array of cpp_hashnode* used to store NODE. */
465 store_ada_macro (cpp_reader
*pfile ATTRIBUTE_UNUSED
,
466 cpp_hashnode
*node
, void *macros
)
468 const cpp_macro
*macro
= node
->value
.macro
;
470 if (node
->type
== NT_MACRO
&& !(node
->flags
& NODE_BUILTIN
)
472 && *NODE_NAME (node
) != '_'
473 && LOCATION_FILE (macro
->line
) == source_file
)
474 ((cpp_hashnode
**) macros
)[store_ada_macro_index
++] = node
;
479 /* Callback used to compare (during qsort) macros. NODE1 and NODE2 are the
480 two macro nodes to compare. */
483 compare_macro (const void *node1
, const void *node2
)
485 typedef const cpp_hashnode
*const_hnode
;
487 const_hnode n1
= *(const const_hnode
*) node1
;
488 const_hnode n2
= *(const const_hnode
*) node2
;
490 return n1
->value
.macro
->line
- n2
->value
.macro
->line
;
493 /* Dump in PP all relevant macros appearing in FILE. */
496 dump_ada_macros (pretty_printer
*pp
, const char* file
)
498 cpp_hashnode
**macros
;
500 /* Initialize file-scope variables. */
502 store_ada_macro_index
= 0;
505 /* Count all potentially relevant macros, and then sort them by sloc. */
506 cpp_forall_identifiers (parse_in
, count_ada_macro
, NULL
);
507 macros
= XALLOCAVEC (cpp_hashnode
*, max_ada_macros
);
508 cpp_forall_identifiers (parse_in
, store_ada_macro
, macros
);
509 qsort (macros
, max_ada_macros
, sizeof (cpp_hashnode
*), compare_macro
);
511 print_ada_macros (pp
, macros
, max_ada_macros
);
514 /* Current source file being handled. */
516 static const char *source_file_base
;
518 /* Compare the declaration (DECL) of struct-like types based on the sloc of
519 their last field (if LAST is true), so that more nested types collate before
521 If ORIG_TYPE is true, also consider struct with a DECL_ORIGINAL_TYPE. */
524 decl_sloc_common (const_tree decl
, bool last
, bool orig_type
)
526 tree type
= TREE_TYPE (decl
);
528 if (TREE_CODE (decl
) == TYPE_DECL
529 && (orig_type
|| !DECL_ORIGINAL_TYPE (decl
))
530 && RECORD_OR_UNION_TYPE_P (type
)
531 && TYPE_FIELDS (type
))
533 tree f
= TYPE_FIELDS (type
);
536 while (TREE_CHAIN (f
))
539 return DECL_SOURCE_LOCATION (f
);
542 return DECL_SOURCE_LOCATION (decl
);
545 /* Return sloc of DECL, using sloc of last field if LAST is true. */
548 decl_sloc (const_tree decl
, bool last
)
550 return decl_sloc_common (decl
, last
, false);
553 /* Compare two locations LHS and RHS. */
556 compare_location (location_t lhs
, location_t rhs
)
558 expanded_location xlhs
= expand_location (lhs
);
559 expanded_location xrhs
= expand_location (rhs
);
561 if (xlhs
.file
!= xrhs
.file
)
562 return filename_cmp (xlhs
.file
, xrhs
.file
);
564 if (xlhs
.line
!= xrhs
.line
)
565 return xlhs
.line
- xrhs
.line
;
567 if (xlhs
.column
!= xrhs
.column
)
568 return xlhs
.column
- xrhs
.column
;
573 /* Compare two declarations (LP and RP) by their source location. */
576 compare_node (const void *lp
, const void *rp
)
578 const_tree lhs
= *((const tree
*) lp
);
579 const_tree rhs
= *((const tree
*) rp
);
581 return compare_location (decl_sloc (lhs
, true), decl_sloc (rhs
, true));
584 /* Compare two comments (LP and RP) by their source location. */
587 compare_comment (const void *lp
, const void *rp
)
589 const cpp_comment
*lhs
= (const cpp_comment
*) lp
;
590 const cpp_comment
*rhs
= (const cpp_comment
*) rp
;
592 return compare_location (lhs
->sloc
, rhs
->sloc
);
595 static tree
*to_dump
= NULL
;
596 static int to_dump_count
= 0;
598 /* Collect a list of declarations from T relevant to SOURCE_FILE to be dumped
599 by a subsequent call to dump_ada_nodes. */
602 collect_ada_nodes (tree t
, const char *source_file
)
605 int i
= to_dump_count
;
607 /* Count the likely relevant nodes. */
608 for (n
= t
; n
; n
= TREE_CHAIN (n
))
609 if (!DECL_IS_BUILTIN (n
)
610 && LOCATION_FILE (decl_sloc (n
, false)) == source_file
)
613 /* Allocate sufficient storage for all nodes. */
614 to_dump
= XRESIZEVEC (tree
, to_dump
, to_dump_count
);
616 /* Store the relevant nodes. */
617 for (n
= t
; n
; n
= TREE_CHAIN (n
))
618 if (!DECL_IS_BUILTIN (n
)
619 && LOCATION_FILE (decl_sloc (n
, false)) == source_file
)
623 /* Call back for walk_tree to clear the TREE_VISITED flag of TP. */
626 unmark_visited_r (tree
*tp
, int *walk_subtrees ATTRIBUTE_UNUSED
,
627 void *data ATTRIBUTE_UNUSED
)
629 if (TREE_VISITED (*tp
))
630 TREE_VISITED (*tp
) = 0;
637 /* Dump nodes into PP relevant to SOURCE_FILE, as collected by previous calls
638 to collect_ada_nodes. */
641 dump_ada_nodes (pretty_printer
*pp
, const char *source_file
)
644 cpp_comment_table
*comments
;
646 /* Sort the table of declarations to dump by sloc. */
647 qsort (to_dump
, to_dump_count
, sizeof (tree
), compare_node
);
649 /* Fetch the table of comments. */
650 comments
= cpp_get_comments (parse_in
);
652 /* Sort the comments table by sloc. */
653 qsort (comments
->entries
, comments
->count
, sizeof (cpp_comment
),
656 /* Interleave comments and declarations in line number order. */
660 /* Advance j until comment j is in this file. */
661 while (j
!= comments
->count
662 && LOCATION_FILE (comments
->entries
[j
].sloc
) != source_file
)
665 /* Advance j until comment j is not a duplicate. */
666 while (j
< comments
->count
- 1
667 && !compare_comment (&comments
->entries
[j
],
668 &comments
->entries
[j
+ 1]))
671 /* Write decls until decl i collates after comment j. */
672 while (i
!= to_dump_count
)
674 if (j
== comments
->count
675 || LOCATION_LINE (decl_sloc (to_dump
[i
], false))
676 < LOCATION_LINE (comments
->entries
[j
].sloc
))
677 print_generic_ada_decl (pp
, to_dump
[i
++], source_file
);
682 /* Write comment j, if there is one. */
683 if (j
!= comments
->count
)
684 print_comment (pp
, comments
->entries
[j
++].comment
);
686 } while (i
!= to_dump_count
|| j
!= comments
->count
);
688 /* Clear the TREE_VISITED flag over each subtree we've dumped. */
689 for (i
= 0; i
< to_dump_count
; i
++)
690 walk_tree (&to_dump
[i
], unmark_visited_r
, NULL
, NULL
);
692 /* Finalize the to_dump table. */
701 /* Print a COMMENT to the output stream PP. */
704 print_comment (pretty_printer
*pp
, const char *comment
)
706 int len
= strlen (comment
);
707 char *str
= XALLOCAVEC (char, len
+ 1);
709 bool extra_newline
= false;
711 memcpy (str
, comment
, len
+ 1);
713 /* Trim C/C++ comment indicators. */
714 if (str
[len
- 2] == '*' && str
[len
- 1] == '/')
721 tok
= strtok (str
, "\n");
723 pp_string (pp
, " --");
726 tok
= strtok (NULL
, "\n");
728 /* Leave a blank line after multi-line comments. */
730 extra_newline
= true;
737 /* Print declaration DECL to PP in Ada syntax. The current source file being
738 handled is SOURCE_FILE. */
741 print_generic_ada_decl (pretty_printer
*pp
, tree decl
, const char *source_file
)
743 source_file_base
= source_file
;
745 if (print_ada_declaration (pp
, decl
, 0, INDENT_INCR
))
752 /* Dump a newline and indent BUFFER by SPC chars. */
755 newline_and_indent (pretty_printer
*buffer
, int spc
)
761 struct with
{ char *s
; const char *in_file
; int limited
; };
762 static struct with
*withs
= NULL
;
763 static int withs_max
= 4096;
764 static int with_len
= 0;
766 /* Record a "with" clause on package S (a limited with if LIMITED_ACCESS is
767 true), if not already done. */
770 append_withs (const char *s
, int limited_access
)
775 withs
= XNEWVEC (struct with
, withs_max
);
777 if (with_len
== withs_max
)
780 withs
= XRESIZEVEC (struct with
, withs
, withs_max
);
783 for (i
= 0; i
< with_len
; i
++)
784 if (!strcmp (s
, withs
[i
].s
)
785 && source_file_base
== withs
[i
].in_file
)
787 withs
[i
].limited
&= limited_access
;
791 withs
[with_len
].s
= xstrdup (s
);
792 withs
[with_len
].in_file
= source_file_base
;
793 withs
[with_len
].limited
= limited_access
;
797 /* Reset "with" clauses. */
800 reset_ada_withs (void)
807 for (i
= 0; i
< with_len
; i
++)
815 /* Dump "with" clauses in F. */
818 dump_ada_withs (FILE *f
)
822 fprintf (f
, "with Interfaces.C; use Interfaces.C;\n");
824 for (i
= 0; i
< with_len
; i
++)
826 (f
, "%swith %s;\n", withs
[i
].limited
? "limited " : "", withs
[i
].s
);
829 /* Return suitable Ada package name from FILE. */
832 get_ada_package (const char *file
)
840 s
= strstr (file
, "/include/");
844 base
= lbasename (file
);
846 if (ada_specs_parent
== NULL
)
849 plen
= strlen (ada_specs_parent
) + 1;
851 res
= XNEWVEC (char, plen
+ strlen (base
) + 1);
852 if (ada_specs_parent
!= NULL
) {
853 strcpy (res
, ada_specs_parent
);
857 for (i
= plen
; *base
; base
++, i
++)
869 res
[i
] = (i
== 0 || res
[i
- 1] == '.' || res
[i
- 1] == '_') ? 'u' : '_';
881 static const char *ada_reserved
[] = {
882 "abort", "abs", "abstract", "accept", "access", "aliased", "all", "and",
883 "array", "at", "begin", "body", "case", "constant", "declare", "delay",
884 "delta", "digits", "do", "else", "elsif", "end", "entry", "exception",
885 "exit", "for", "function", "generic", "goto", "if", "in", "interface", "is",
886 "limited", "loop", "mod", "new", "not", "null", "others", "out", "of", "or",
887 "overriding", "package", "pragma", "private", "procedure", "protected",
888 "raise", "range", "record", "rem", "renames", "requeue", "return", "reverse",
889 "select", "separate", "subtype", "synchronized", "tagged", "task",
890 "terminate", "then", "type", "until", "use", "when", "while", "with", "xor",
893 /* ??? would be nice to specify this list via a config file, so that users
894 can create their own dictionary of conflicts. */
895 static const char *c_duplicates
[] = {
896 /* system will cause troubles with System.Address. */
899 /* The following values have other definitions with same name/other
905 "rl_readline_version",
911 /* Return a declaration tree corresponding to TYPE. */
914 get_underlying_decl (tree type
)
916 tree decl
= NULL_TREE
;
918 if (type
== NULL_TREE
)
921 /* type is a declaration. */
925 /* type is a typedef. */
926 if (TYPE_P (type
) && TYPE_NAME (type
) && DECL_P (TYPE_NAME (type
)))
927 decl
= TYPE_NAME (type
);
929 /* TYPE_STUB_DECL has been set for type. */
930 if (TYPE_P (type
) && TYPE_STUB_DECL (type
) &&
931 DECL_P (TYPE_STUB_DECL (type
)))
932 decl
= TYPE_STUB_DECL (type
);
937 /* Return whether TYPE has static fields. */
940 has_static_fields (const_tree type
)
944 if (!type
|| !RECORD_OR_UNION_TYPE_P (type
))
947 for (tmp
= TYPE_FIELDS (type
); tmp
; tmp
= TREE_CHAIN (tmp
))
948 if (DECL_NAME (tmp
) && TREE_STATIC (tmp
))
954 /* Return whether TYPE corresponds to an Ada tagged type (has a dispatch
958 is_tagged_type (const_tree type
)
962 if (!type
|| !RECORD_OR_UNION_TYPE_P (type
))
965 for (tmp
= TYPE_METHODS (type
); tmp
; tmp
= TREE_CHAIN (tmp
))
966 if (DECL_VINDEX (tmp
))
972 /* Return whether TYPE has non-trivial methods, i.e. methods that do something
973 for the objects of TYPE. In C++, all classes have implicit special methods,
974 e.g. constructors and destructors, but they can be trivial if the type is
975 sufficiently simple. */
978 has_nontrivial_methods (tree type
)
982 if (!type
|| !RECORD_OR_UNION_TYPE_P (type
))
985 /* Only C++ types can have methods. */
989 /* A non-trivial type has non-trivial special methods. */
990 if (!cpp_check (type
, IS_TRIVIAL
))
993 /* If there are user-defined methods, they are deemed non-trivial. */
994 for (tmp
= TYPE_METHODS (type
); tmp
; tmp
= TREE_CHAIN (tmp
))
995 if (!DECL_ARTIFICIAL (tmp
))
1001 /* Generate a legal Ada name from a C NAME, returning a malloc'd string.
1002 SPACE_FOUND, if not NULL, is used to indicate whether a space was found in
1006 to_ada_name (const char *name
, int *space_found
)
1009 int len
= strlen (name
);
1012 char *s
= XNEWVEC (char, len
* 2 + 5);
1016 *space_found
= false;
1018 /* Add trailing "c_" if name is an Ada reserved word. */
1019 for (names
= ada_reserved
; *names
; names
++)
1020 if (!strcasecmp (name
, *names
))
1029 /* Add trailing "c_" if name is an potential case sensitive duplicate. */
1030 for (names
= c_duplicates
; *names
; names
++)
1031 if (!strcmp (name
, *names
))
1039 for (j
= 0; name
[j
] == '_'; j
++)
1044 else if (*name
== '.' || *name
== '$')
1054 /* Replace unsuitable characters for Ada identifiers. */
1056 for (; j
< len
; j
++)
1061 *space_found
= true;
1065 /* ??? missing some C++ operators. */
1069 if (name
[j
+ 1] == '=')
1084 if (name
[j
+ 1] == '=')
1102 s
[len2
++] = name
[j
] == '&' ? 'a' : name
[j
] == '|' ? 'o' : 'x';
1104 if (name
[j
+ 1] == '=')
1117 if (s
[len2
- 1] != '_')
1120 switch (name
[j
+ 1]) {
1123 switch (name
[j
- 1]) {
1124 case '+': s
[len2
++] = 'p'; break; /* + */
1125 case '-': s
[len2
++] = 'm'; break; /* - */
1126 case '*': s
[len2
++] = 't'; break; /* * */
1127 case '/': s
[len2
++] = 'd'; break; /* / */
1133 switch (name
[j
- 1]) {
1134 case '+': s
[len2
++] = 'p'; break; /* += */
1135 case '-': s
[len2
++] = 'm'; break; /* -= */
1136 case '*': s
[len2
++] = 't'; break; /* *= */
1137 case '/': s
[len2
++] = 'd'; break; /* /= */
1171 c
= name
[j
] == '<' ? 'l' : 'g';
1174 switch (name
[j
+ 1]) {
1200 if (len2
&& s
[len2
- 1] == '_')
1205 s
[len2
++] = name
[j
];
1208 if (s
[len2
- 1] == '_')
1216 /* Return true if DECL refers to a C++ class type for which a
1217 separate enclosing package has been or should be generated. */
1220 separate_class_package (tree decl
)
1222 tree type
= TREE_TYPE (decl
);
1223 return has_nontrivial_methods (type
) || has_static_fields (type
);
1226 static bool package_prefix
= true;
1228 /* Dump in BUFFER the name of an identifier NODE of type TYPE, following Ada
1229 syntax. LIMITED_ACCESS indicates whether NODE can be accessed via a limited
1230 'with' clause rather than a regular 'with' clause. */
1233 pp_ada_tree_identifier (pretty_printer
*buffer
, tree node
, tree type
,
1236 const char *name
= IDENTIFIER_POINTER (node
);
1237 int space_found
= false;
1238 char *s
= to_ada_name (name
, &space_found
);
1241 /* If the entity is a type and comes from another file, generate "package"
1243 decl
= get_underlying_decl (type
);
1247 expanded_location xloc
= expand_location (decl_sloc (decl
, false));
1249 if (xloc
.file
&& xloc
.line
)
1251 if (xloc
.file
!= source_file_base
)
1253 switch (TREE_CODE (type
))
1258 case FIXED_POINT_TYPE
:
1260 case REFERENCE_TYPE
:
1265 case QUAL_UNION_TYPE
:
1269 char *s1
= get_ada_package (xloc
.file
);
1270 append_withs (s1
, limited_access
);
1271 pp_string (buffer
, s1
);
1280 /* Generate the additional package prefix for C++ classes. */
1281 if (separate_class_package (decl
))
1283 pp_string (buffer
, "Class_");
1284 pp_string (buffer
, s
);
1292 if (!strcmp (s
, "short_int"))
1293 pp_string (buffer
, "short");
1294 else if (!strcmp (s
, "short_unsigned_int"))
1295 pp_string (buffer
, "unsigned_short");
1296 else if (!strcmp (s
, "unsigned_int"))
1297 pp_string (buffer
, "unsigned");
1298 else if (!strcmp (s
, "long_int"))
1299 pp_string (buffer
, "long");
1300 else if (!strcmp (s
, "long_unsigned_int"))
1301 pp_string (buffer
, "unsigned_long");
1302 else if (!strcmp (s
, "long_long_int"))
1303 pp_string (buffer
, "Long_Long_Integer");
1304 else if (!strcmp (s
, "long_long_unsigned_int"))
1308 append_withs ("Interfaces.C.Extensions", false);
1309 pp_string (buffer
, "Extensions.unsigned_long_long");
1312 pp_string (buffer
, "unsigned_long_long");
1315 pp_string(buffer
, s
);
1317 if (!strcmp (s
, "bool"))
1321 append_withs ("Interfaces.C.Extensions", false);
1322 pp_string (buffer
, "Extensions.bool");
1325 pp_string (buffer
, "bool");
1328 pp_string(buffer
, s
);
1333 /* Dump in BUFFER the assembly name of T. */
1336 pp_asm_name (pretty_printer
*buffer
, tree t
)
1338 tree name
= DECL_ASSEMBLER_NAME (t
);
1339 char *ada_name
= XALLOCAVEC (char, IDENTIFIER_LENGTH (name
) + 1), *s
;
1340 const char *ident
= IDENTIFIER_POINTER (name
);
1342 for (s
= ada_name
; *ident
; ident
++)
1346 else if (*ident
!= '*')
1351 pp_string (buffer
, ada_name
);
1354 /* Dump in BUFFER the name of a DECL node if set, following Ada syntax.
1355 LIMITED_ACCESS indicates whether NODE can be accessed via a limited
1356 'with' clause rather than a regular 'with' clause. */
1359 dump_ada_decl_name (pretty_printer
*buffer
, tree decl
, int limited_access
)
1361 if (DECL_NAME (decl
))
1362 pp_ada_tree_identifier (buffer
, DECL_NAME (decl
), decl
, limited_access
);
1365 tree type_name
= TYPE_NAME (TREE_TYPE (decl
));
1369 pp_string (buffer
, "anon");
1370 if (TREE_CODE (decl
) == FIELD_DECL
)
1371 pp_scalar (buffer
, "%d", DECL_UID (decl
));
1373 pp_scalar (buffer
, "%d", TYPE_UID (TREE_TYPE (decl
)));
1375 else if (TREE_CODE (type_name
) == IDENTIFIER_NODE
)
1376 pp_ada_tree_identifier (buffer
, type_name
, decl
, limited_access
);
1380 /* Dump in BUFFER a name based on both T1 and T2, followed by S. */
1383 dump_ada_double_name (pretty_printer
*buffer
, tree t1
, tree t2
, const char *s
)
1386 pp_ada_tree_identifier (buffer
, DECL_NAME (t1
), t1
, false);
1389 pp_string (buffer
, "anon");
1390 pp_scalar (buffer
, "%d", TYPE_UID (TREE_TYPE (t1
)));
1393 pp_underscore (buffer
);
1396 pp_ada_tree_identifier (buffer
, DECL_NAME (t2
), t2
, false);
1399 pp_string (buffer
, "anon");
1400 pp_scalar (buffer
, "%d", TYPE_UID (TREE_TYPE (t2
)));
1403 pp_string (buffer
, s
);
1406 /* Dump in BUFFER pragma Import C/CPP on a given node T. */
1409 dump_ada_import (pretty_printer
*buffer
, tree t
)
1411 const char *name
= IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (t
));
1412 int is_stdcall
= TREE_CODE (t
) == FUNCTION_DECL
&&
1413 lookup_attribute ("stdcall", TYPE_ATTRIBUTES (TREE_TYPE (t
)));
1416 pp_string (buffer
, "pragma Import (Stdcall, ");
1417 else if (name
[0] == '_' && name
[1] == 'Z')
1418 pp_string (buffer
, "pragma Import (CPP, ");
1420 pp_string (buffer
, "pragma Import (C, ");
1422 dump_ada_decl_name (buffer
, t
, false);
1423 pp_string (buffer
, ", \"");
1426 pp_string (buffer
, IDENTIFIER_POINTER (DECL_NAME (t
)));
1428 pp_asm_name (buffer
, t
);
1430 pp_string (buffer
, "\");");
1433 /* Check whether T and its type have different names, and append "the_"
1434 otherwise in BUFFER. */
1437 check_name (pretty_printer
*buffer
, tree t
)
1440 tree tmp
= TREE_TYPE (t
);
1442 while (TREE_CODE (tmp
) == POINTER_TYPE
&& !TYPE_NAME (tmp
))
1443 tmp
= TREE_TYPE (tmp
);
1445 if (TREE_CODE (tmp
) != FUNCTION_TYPE
)
1447 if (TREE_CODE (tmp
) == IDENTIFIER_NODE
)
1448 s
= IDENTIFIER_POINTER (tmp
);
1449 else if (!TYPE_NAME (tmp
))
1451 else if (TREE_CODE (TYPE_NAME (tmp
)) == IDENTIFIER_NODE
)
1452 s
= IDENTIFIER_POINTER (TYPE_NAME (tmp
));
1454 s
= IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp
)));
1456 if (!strcasecmp (IDENTIFIER_POINTER (DECL_NAME (t
)), s
))
1457 pp_string (buffer
, "the_");
1461 /* Dump in BUFFER a function declaration FUNC with Ada syntax.
1462 IS_METHOD indicates whether FUNC is a C++ method.
1463 IS_CONSTRUCTOR whether FUNC is a C++ constructor.
1464 IS_DESTRUCTOR whether FUNC is a C++ destructor.
1465 SPC is the current indentation level. */
1468 dump_ada_function_declaration (pretty_printer
*buffer
, tree func
,
1469 int is_method
, int is_constructor
,
1470 int is_destructor
, int spc
)
1473 const tree node
= TREE_TYPE (func
);
1475 int num
= 0, num_args
= 0, have_args
= true, have_ellipsis
= false;
1477 /* Compute number of arguments. */
1478 arg
= TYPE_ARG_TYPES (node
);
1482 while (TREE_CHAIN (arg
) && arg
!= error_mark_node
)
1485 arg
= TREE_CHAIN (arg
);
1488 if (TREE_CODE (TREE_VALUE (arg
)) != VOID_TYPE
)
1491 have_ellipsis
= true;
1502 newline_and_indent (buffer
, spc
+ 1);
1507 pp_left_paren (buffer
);
1510 if (TREE_CODE (func
) == FUNCTION_DECL
)
1511 arg
= DECL_ARGUMENTS (func
);
1515 if (arg
== NULL_TREE
)
1518 arg
= TYPE_ARG_TYPES (node
);
1520 if (arg
&& TREE_CODE (TREE_VALUE (arg
)) == VOID_TYPE
)
1525 arg
= TREE_CHAIN (arg
);
1527 /* Print the argument names (if available) & types. */
1529 for (num
= 1; num
<= num_args
; num
++)
1533 if (DECL_NAME (arg
))
1535 check_name (buffer
, arg
);
1536 pp_ada_tree_identifier (buffer
, DECL_NAME (arg
), 0, false);
1537 pp_string (buffer
, " : ");
1541 sprintf (buf
, "arg%d : ", num
);
1542 pp_string (buffer
, buf
);
1545 dump_generic_ada_node (buffer
, TREE_TYPE (arg
), node
, spc
, 0, true);
1549 sprintf (buf
, "arg%d : ", num
);
1550 pp_string (buffer
, buf
);
1551 dump_generic_ada_node (buffer
, TREE_VALUE (arg
), node
, spc
, 0, true);
1554 if (TREE_TYPE (arg
) && TREE_TYPE (TREE_TYPE (arg
))
1555 && is_tagged_type (TREE_TYPE (TREE_TYPE (arg
))))
1558 || (num
!= 1 || (!DECL_VINDEX (func
) && !is_constructor
)))
1559 pp_string (buffer
, "'Class");
1562 arg
= TREE_CHAIN (arg
);
1566 pp_semicolon (buffer
);
1569 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
1577 pp_string (buffer
, " -- , ...");
1578 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
1582 pp_right_paren (buffer
);
1586 /* Dump in BUFFER all the domains associated with an array NODE,
1587 using Ada syntax. SPC is the current indentation level. */
1590 dump_ada_array_domains (pretty_printer
*buffer
, tree node
, int spc
)
1593 pp_left_paren (buffer
);
1595 for (; TREE_CODE (node
) == ARRAY_TYPE
; node
= TREE_TYPE (node
))
1597 tree domain
= TYPE_DOMAIN (node
);
1601 tree min
= TYPE_MIN_VALUE (domain
);
1602 tree max
= TYPE_MAX_VALUE (domain
);
1605 pp_string (buffer
, ", ");
1609 dump_generic_ada_node (buffer
, min
, NULL_TREE
, spc
, 0, true);
1610 pp_string (buffer
, " .. ");
1612 /* If the upper bound is zero, gcc may generate a NULL_TREE
1613 for TYPE_MAX_VALUE rather than an integer_cst. */
1615 dump_generic_ada_node (buffer
, max
, NULL_TREE
, spc
, 0, true);
1617 pp_string (buffer
, "0");
1620 pp_string (buffer
, "size_t");
1622 pp_right_paren (buffer
);
1625 /* Dump in BUFFER file:line information related to NODE. */
1628 dump_sloc (pretty_printer
*buffer
, tree node
)
1630 expanded_location xloc
;
1634 if (TREE_CODE_CLASS (TREE_CODE (node
)) == tcc_declaration
)
1635 xloc
= expand_location (DECL_SOURCE_LOCATION (node
));
1636 else if (EXPR_HAS_LOCATION (node
))
1637 xloc
= expand_location (EXPR_LOCATION (node
));
1641 pp_string (buffer
, xloc
.file
);
1643 pp_decimal_int (buffer
, xloc
.line
);
1647 /* Return true if T designates a one dimension array of "char". */
1650 is_char_array (tree t
)
1655 /* Retrieve array's type. */
1657 while (TREE_CODE (TREE_TYPE (tmp
)) == ARRAY_TYPE
)
1660 tmp
= TREE_TYPE (tmp
);
1663 tmp
= TREE_TYPE (tmp
);
1664 return num_dim
== 1 && TREE_CODE (tmp
) == INTEGER_TYPE
1665 && !strcmp (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp
))), "char");
1668 /* Dump in BUFFER an array type T in Ada syntax. Assume that the "type"
1669 keyword and name have already been printed. SPC is the indentation
1673 dump_ada_array_type (pretty_printer
*buffer
, tree t
, int spc
)
1676 bool char_array
= is_char_array (t
);
1678 /* Special case char arrays. */
1681 pp_string (buffer
, "Interfaces.C.char_array ");
1684 pp_string (buffer
, "array ");
1686 /* Print the dimensions. */
1687 dump_ada_array_domains (buffer
, TREE_TYPE (t
), spc
);
1689 /* Retrieve array's type. */
1690 tmp
= TREE_TYPE (t
);
1691 while (TREE_CODE (TREE_TYPE (tmp
)) == ARRAY_TYPE
)
1692 tmp
= TREE_TYPE (tmp
);
1694 /* Print array's type. */
1697 pp_string (buffer
, " of ");
1699 if (TREE_CODE (TREE_TYPE (tmp
)) != POINTER_TYPE
)
1700 pp_string (buffer
, "aliased ");
1702 dump_generic_ada_node
1703 (buffer
, TREE_TYPE (tmp
), TREE_TYPE (t
), spc
, false, true);
1707 /* Dump in BUFFER type names associated with a template, each prepended with
1708 '_'. TYPES is the TREE_PURPOSE of a DECL_TEMPLATE_INSTANTIATIONS. SPC is
1709 the indentation level. */
1712 dump_template_types (pretty_printer
*buffer
, tree types
, int spc
)
1715 size_t len
= TREE_VEC_LENGTH (types
);
1717 for (i
= 0; i
< len
; i
++)
1719 tree elem
= TREE_VEC_ELT (types
, i
);
1720 pp_underscore (buffer
);
1721 if (!dump_generic_ada_node (buffer
, elem
, 0, spc
, false, true))
1723 pp_string (buffer
, "unknown");
1724 pp_scalar (buffer
, "%lu", (unsigned long) TREE_HASH (elem
));
1729 /* Dump in BUFFER the contents of all class instantiations associated with
1730 a given template T. SPC is the indentation level. */
1733 dump_ada_template (pretty_printer
*buffer
, tree t
, int spc
)
1735 /* DECL_VINDEX is DECL_TEMPLATE_INSTANTIATIONS in this context. */
1736 tree inst
= DECL_VINDEX (t
);
1737 /* DECL_RESULT_FLD is DECL_TEMPLATE_RESULT in this context. */
1738 tree result
= DECL_RESULT_FLD (t
);
1741 /* Don't look at template declarations declaring something coming from
1742 another file. This can occur for template friend declarations. */
1743 if (LOCATION_FILE (decl_sloc (result
, false))
1744 != LOCATION_FILE (decl_sloc (t
, false)))
1747 while (inst
&& inst
!= error_mark_node
)
1749 tree types
= TREE_PURPOSE (inst
);
1750 tree instance
= TREE_VALUE (inst
);
1752 if (TREE_VEC_LENGTH (types
) == 0)
1755 if (!TYPE_P (instance
) || !TYPE_METHODS (instance
))
1760 pp_string (buffer
, "package ");
1761 package_prefix
= false;
1762 dump_generic_ada_node (buffer
, instance
, t
, spc
, false, true);
1763 dump_template_types (buffer
, types
, spc
);
1764 pp_string (buffer
, " is");
1766 newline_and_indent (buffer
, spc
);
1768 TREE_VISITED (get_underlying_decl (instance
)) = 1;
1769 pp_string (buffer
, "type ");
1770 dump_generic_ada_node (buffer
, instance
, t
, spc
, false, true);
1771 package_prefix
= true;
1773 if (is_tagged_type (instance
))
1774 pp_string (buffer
, " is tagged limited ");
1776 pp_string (buffer
, " is limited ");
1778 dump_generic_ada_node (buffer
, instance
, t
, spc
, false, false);
1779 pp_newline (buffer
);
1781 newline_and_indent (buffer
, spc
);
1783 pp_string (buffer
, "end;");
1784 newline_and_indent (buffer
, spc
);
1785 pp_string (buffer
, "use ");
1786 package_prefix
= false;
1787 dump_generic_ada_node (buffer
, instance
, t
, spc
, false, true);
1788 dump_template_types (buffer
, types
, spc
);
1789 package_prefix
= true;
1790 pp_semicolon (buffer
);
1791 pp_newline (buffer
);
1792 pp_newline (buffer
);
1794 inst
= TREE_CHAIN (inst
);
1797 return num_inst
> 0;
1800 /* Return true if NODE is a simple enum types, that can be mapped to an
1801 Ada enum type directly. */
1804 is_simple_enum (tree node
)
1806 HOST_WIDE_INT count
= 0;
1809 for (value
= TYPE_VALUES (node
); value
; value
= TREE_CHAIN (value
))
1811 tree int_val
= TREE_VALUE (value
);
1813 if (TREE_CODE (int_val
) != INTEGER_CST
)
1814 int_val
= DECL_INITIAL (int_val
);
1816 if (!tree_fits_shwi_p (int_val
))
1818 else if (tree_to_shwi (int_val
) != count
)
1827 static bool in_function
= true;
1828 static bool bitfield_used
= false;
1830 /* Recursively dump in BUFFER Ada declarations corresponding to NODE of type
1831 TYPE. SPC is the indentation level. LIMITED_ACCESS indicates whether NODE
1832 can be referenced via a "limited with" clause. NAME_ONLY indicates whether
1833 we should only dump the name of NODE, instead of its full declaration. */
1836 dump_generic_ada_node (pretty_printer
*buffer
, tree node
, tree type
, int spc
,
1837 int limited_access
, bool name_only
)
1839 if (node
== NULL_TREE
)
1842 switch (TREE_CODE (node
))
1845 pp_string (buffer
, "<<< error >>>");
1848 case IDENTIFIER_NODE
:
1849 pp_ada_tree_identifier (buffer
, node
, type
, limited_access
);
1853 pp_string (buffer
, "--- unexpected node: TREE_LIST");
1857 dump_generic_ada_node
1858 (buffer
, BINFO_TYPE (node
), type
, spc
, limited_access
, name_only
);
1861 pp_string (buffer
, "--- unexpected node: TREE_VEC");
1867 append_withs ("System", false);
1868 pp_string (buffer
, "System.Address");
1871 pp_string (buffer
, "address");
1875 pp_string (buffer
, "<vector>");
1879 pp_string (buffer
, "<complex>");
1884 dump_generic_ada_node
1885 (buffer
, TYPE_NAME (node
), node
, spc
, 0, true);
1888 tree value
= TYPE_VALUES (node
);
1890 if (is_simple_enum (node
))
1894 newline_and_indent (buffer
, spc
- 1);
1895 pp_left_paren (buffer
);
1896 for (; value
; value
= TREE_CHAIN (value
))
1903 newline_and_indent (buffer
, spc
);
1906 pp_ada_tree_identifier
1907 (buffer
, TREE_PURPOSE (value
), node
, false);
1909 pp_string (buffer
, ");");
1911 newline_and_indent (buffer
, spc
);
1912 pp_string (buffer
, "pragma Convention (C, ");
1913 dump_generic_ada_node
1914 (buffer
, DECL_NAME (type
) ? type
: TYPE_NAME (node
), type
,
1916 pp_right_paren (buffer
);
1920 pp_string (buffer
, "unsigned");
1921 for (; value
; value
= TREE_CHAIN (value
))
1923 pp_semicolon (buffer
);
1924 newline_and_indent (buffer
, spc
);
1926 pp_ada_tree_identifier
1927 (buffer
, TREE_PURPOSE (value
), node
, false);
1928 pp_string (buffer
, " : constant ");
1930 dump_generic_ada_node
1931 (buffer
, DECL_NAME (type
) ? type
: TYPE_NAME (node
), type
,
1934 pp_string (buffer
, " := ");
1935 dump_generic_ada_node
1937 TREE_CODE (TREE_VALUE (value
)) == INTEGER_CST
?
1938 TREE_VALUE (value
) : DECL_INITIAL (TREE_VALUE (value
)),
1939 node
, spc
, false, true);
1947 case FIXED_POINT_TYPE
:
1950 enum tree_code_class tclass
;
1952 tclass
= TREE_CODE_CLASS (TREE_CODE (node
));
1954 if (tclass
== tcc_declaration
)
1956 if (DECL_NAME (node
))
1957 pp_ada_tree_identifier
1958 (buffer
, DECL_NAME (node
), 0, limited_access
);
1960 pp_string (buffer
, "<unnamed type decl>");
1962 else if (tclass
== tcc_type
)
1964 if (TYPE_NAME (node
))
1966 if (TREE_CODE (TYPE_NAME (node
)) == IDENTIFIER_NODE
)
1967 pp_ada_tree_identifier (buffer
, TYPE_NAME (node
),
1968 node
, limited_access
);
1969 else if (TREE_CODE (TYPE_NAME (node
)) == TYPE_DECL
1970 && DECL_NAME (TYPE_NAME (node
)))
1971 dump_ada_decl_name (buffer
, TYPE_NAME (node
), limited_access
);
1973 pp_string (buffer
, "<unnamed type>");
1975 else if (TREE_CODE (node
) == INTEGER_TYPE
)
1977 append_withs ("Interfaces.C.Extensions", false);
1978 bitfield_used
= true;
1980 if (TYPE_PRECISION (node
) == 1)
1981 pp_string (buffer
, "Extensions.Unsigned_1");
1984 pp_string (buffer
, (TYPE_UNSIGNED (node
)
1985 ? "Extensions.Unsigned_"
1986 : "Extensions.Signed_"));
1987 pp_decimal_int (buffer
, TYPE_PRECISION (node
));
1991 pp_string (buffer
, "<unnamed type>");
1997 case REFERENCE_TYPE
:
1998 if (name_only
&& TYPE_NAME (node
))
1999 dump_generic_ada_node
2000 (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
, true);
2002 else if (TREE_CODE (TREE_TYPE (node
)) == FUNCTION_TYPE
)
2004 tree fnode
= TREE_TYPE (node
);
2006 bool prev_in_function
= in_function
;
2008 if (VOID_TYPE_P (TREE_TYPE (fnode
)))
2010 is_function
= false;
2011 pp_string (buffer
, "access procedure");
2016 pp_string (buffer
, "access function");
2019 in_function
= is_function
;
2020 dump_ada_function_declaration
2021 (buffer
, node
, false, false, false, spc
+ INDENT_INCR
);
2022 in_function
= prev_in_function
;
2026 pp_string (buffer
, " return ");
2027 dump_generic_ada_node
2028 (buffer
, TREE_TYPE (fnode
), type
, spc
, 0, true);
2031 /* If we are dumping the full type, it means we are part of a
2032 type definition and need also a Convention C pragma. */
2035 pp_semicolon (buffer
);
2036 newline_and_indent (buffer
, spc
);
2037 pp_string (buffer
, "pragma Convention (C, ");
2038 dump_generic_ada_node
2039 (buffer
, type
, 0, spc
, false, true);
2040 pp_right_paren (buffer
);
2045 int is_access
= false;
2046 unsigned int quals
= TYPE_QUALS (TREE_TYPE (node
));
2048 if (VOID_TYPE_P (TREE_TYPE (node
)))
2051 pp_string (buffer
, "new ");
2054 append_withs ("System", false);
2055 pp_string (buffer
, "System.Address");
2058 pp_string (buffer
, "address");
2062 if (TREE_CODE (node
) == POINTER_TYPE
2063 && TREE_CODE (TREE_TYPE (node
)) == INTEGER_TYPE
2065 (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME
2066 (TREE_TYPE (node
)))), "char"))
2069 pp_string (buffer
, "new ");
2073 pp_string (buffer
, "Interfaces.C.Strings.chars_ptr");
2074 append_withs ("Interfaces.C.Strings", false);
2077 pp_string (buffer
, "chars_ptr");
2081 /* For now, handle all access-to-access or
2082 access-to-unknown-structs as opaque system.address. */
2084 tree type_name
= TYPE_NAME (TREE_TYPE (node
));
2085 const_tree typ2
= !type
||
2086 DECL_P (type
) ? type
: TYPE_NAME (type
);
2087 const_tree underlying_type
=
2088 get_underlying_decl (TREE_TYPE (node
));
2090 if (TREE_CODE (TREE_TYPE (node
)) == POINTER_TYPE
2091 /* Pointer to pointer. */
2093 || (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node
))
2094 && (!underlying_type
2095 || !TYPE_FIELDS (TREE_TYPE (underlying_type
))))
2096 /* Pointer to opaque structure. */
2098 || underlying_type
== NULL_TREE
2100 && !TREE_VISITED (underlying_type
)
2101 && !TREE_VISITED (type_name
)
2102 && !is_tagged_type (TREE_TYPE (node
))
2103 && DECL_SOURCE_FILE (underlying_type
)
2104 == source_file_base
)
2105 || (type_name
&& typ2
2106 && DECL_P (underlying_type
)
2108 && decl_sloc (underlying_type
, true)
2109 > decl_sloc (typ2
, true)
2110 && DECL_SOURCE_FILE (underlying_type
)
2111 == DECL_SOURCE_FILE (typ2
)))
2115 append_withs ("System", false);
2117 pp_string (buffer
, "new ");
2118 pp_string (buffer
, "System.Address");
2121 pp_string (buffer
, "address");
2125 if (!package_prefix
)
2126 pp_string (buffer
, "access");
2127 else if (AGGREGATE_TYPE_P (TREE_TYPE (node
)))
2129 if (!type
|| TREE_CODE (type
) != FUNCTION_DECL
)
2131 pp_string (buffer
, "access ");
2134 if (quals
& TYPE_QUAL_CONST
)
2135 pp_string (buffer
, "constant ");
2136 else if (!name_only
)
2137 pp_string (buffer
, "all ");
2139 else if (quals
& TYPE_QUAL_CONST
)
2140 pp_string (buffer
, "in ");
2141 else if (in_function
)
2144 pp_string (buffer
, "access ");
2149 pp_string (buffer
, "access ");
2150 /* ??? should be configurable: access or in out. */
2156 pp_string (buffer
, "access ");
2159 pp_string (buffer
, "all ");
2162 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node
))
2163 && type_name
!= NULL_TREE
)
2164 dump_generic_ada_node
2166 TREE_TYPE (node
), spc
, is_access
, true);
2168 dump_generic_ada_node
2169 (buffer
, TREE_TYPE (node
), TREE_TYPE (node
),
2178 dump_generic_ada_node
2179 (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
, true);
2181 dump_ada_array_type (buffer
, node
, spc
);
2186 case QUAL_UNION_TYPE
:
2189 if (TYPE_NAME (node
))
2190 dump_generic_ada_node
2191 (buffer
, TYPE_NAME (node
), node
, spc
, limited_access
, true);
2194 pp_string (buffer
, "anon_");
2195 pp_scalar (buffer
, "%d", TYPE_UID (node
));
2199 print_ada_struct_decl (buffer
, node
, type
, spc
, true);
2203 /* We treat the upper half of the sizetype range as negative. This
2204 is consistent with the internal treatment and makes it possible
2205 to generate the (0 .. -1) range for flexible array members. */
2206 if (TREE_TYPE (node
) == sizetype
)
2207 node
= fold_convert (ssizetype
, node
);
2208 if (tree_fits_shwi_p (node
))
2209 pp_wide_integer (buffer
, tree_to_shwi (node
));
2210 else if (tree_fits_uhwi_p (node
))
2211 pp_unsigned_wide_integer (buffer
, tree_to_uhwi (node
));
2215 unsigned HOST_WIDE_INT low
= TREE_INT_CST_LOW (val
);
2216 HOST_WIDE_INT high
= TREE_INT_CST_HIGH (val
);
2218 if (tree_int_cst_sgn (val
) < 0)
2221 high
= ~high
+ !low
;
2224 sprintf (pp_buffer (buffer
)->digit_buffer
,
2225 ADA_HOST_WIDE_INT_PRINT_DOUBLE_HEX
,
2226 (unsigned HOST_WIDE_INT
) high
, low
);
2227 pp_string (buffer
, pp_buffer (buffer
)->digit_buffer
);
2240 dump_ada_decl_name (buffer
, node
, limited_access
);
2244 if (DECL_IS_BUILTIN (node
))
2246 /* Don't print the declaration of built-in types. */
2250 /* If we're in the middle of a declaration, defaults to
2254 append_withs ("System", false);
2255 pp_string (buffer
, "System.Address");
2258 pp_string (buffer
, "address");
2264 dump_ada_decl_name (buffer
, node
, limited_access
);
2267 if (is_tagged_type (TREE_TYPE (node
)))
2269 tree tmp
= TYPE_FIELDS (TREE_TYPE (node
));
2272 /* Look for ancestors. */
2273 for (; tmp
; tmp
= TREE_CHAIN (tmp
))
2275 if (!DECL_NAME (tmp
) && is_tagged_type (TREE_TYPE (tmp
)))
2279 pp_string (buffer
, "limited new ");
2283 pp_string (buffer
, " and ");
2286 (buffer
, TYPE_NAME (TREE_TYPE (tmp
)), false);
2290 pp_string (buffer
, first
? "tagged limited " : " with ");
2292 else if (has_nontrivial_methods (TREE_TYPE (node
)))
2293 pp_string (buffer
, "limited ");
2295 dump_generic_ada_node
2296 (buffer
, TREE_TYPE (node
), type
, spc
, false, false);
2303 case NAMESPACE_DECL
:
2304 dump_ada_decl_name (buffer
, node
, false);
2308 /* Ignore other nodes (e.g. expressions). */
2315 /* Dump in BUFFER NODE's methods. SPC is the indentation level. Return 1 if
2316 methods were printed, 0 otherwise. */
2319 print_ada_methods (pretty_printer
*buffer
, tree node
, int spc
)
2324 if (!has_nontrivial_methods (node
))
2327 pp_semicolon (buffer
);
2329 for (tmp
= TYPE_METHODS (node
); tmp
; tmp
= TREE_CHAIN (tmp
))
2333 pp_newline (buffer
);
2334 pp_newline (buffer
);
2336 res
= print_ada_declaration (buffer
, tmp
, node
, spc
);
2342 /* Dump in BUFFER anonymous types nested inside T's definition.
2343 PARENT is the parent node of T.
2344 FORWARD indicates whether a forward declaration of T should be generated.
2345 SPC is the indentation level. */
2348 dump_nested_types (pretty_printer
*buffer
, tree t
, tree parent
, bool forward
,
2351 tree field
, outer
, decl
;
2353 /* Avoid recursing over the same tree. */
2354 if (TREE_VISITED (t
))
2357 /* Find possible anonymous arrays/unions/structs recursively. */
2359 outer
= TREE_TYPE (t
);
2361 if (outer
== NULL_TREE
)
2366 pp_string (buffer
, "type ");
2367 dump_generic_ada_node (buffer
, t
, t
, spc
, false, true);
2368 pp_semicolon (buffer
);
2369 newline_and_indent (buffer
, spc
);
2370 TREE_VISITED (t
) = 1;
2373 field
= TYPE_FIELDS (outer
);
2376 if ((TREE_TYPE (field
) != outer
2377 || (TREE_CODE (TREE_TYPE (field
)) == POINTER_TYPE
2378 && TREE_TYPE (TREE_TYPE (field
)) != outer
))
2379 && (!TYPE_NAME (TREE_TYPE (field
))
2380 || (TREE_CODE (field
) == TYPE_DECL
2381 && DECL_NAME (field
) != DECL_NAME (t
)
2382 && TYPE_NAME (TREE_TYPE (field
)) != TYPE_NAME (outer
))))
2384 switch (TREE_CODE (TREE_TYPE (field
)))
2387 decl
= TREE_TYPE (TREE_TYPE (field
));
2389 if (TREE_CODE (decl
) == FUNCTION_TYPE
)
2390 for (decl
= TREE_TYPE (decl
);
2391 decl
&& TREE_CODE (decl
) == POINTER_TYPE
;
2392 decl
= TREE_TYPE (decl
))
2395 decl
= get_underlying_decl (decl
);
2399 && decl_sloc (decl
, true) > decl_sloc (t
, true)
2400 && DECL_SOURCE_FILE (decl
) == DECL_SOURCE_FILE (t
)
2401 && !TREE_VISITED (decl
)
2402 && !DECL_IS_BUILTIN (decl
)
2403 && (!RECORD_OR_UNION_TYPE_P (TREE_TYPE (decl
))
2404 || TYPE_FIELDS (TREE_TYPE (decl
))))
2406 /* Generate forward declaration. */
2408 pp_string (buffer
, "type ");
2409 dump_generic_ada_node (buffer
, decl
, 0, spc
, false, true);
2410 pp_semicolon (buffer
);
2411 newline_and_indent (buffer
, spc
);
2413 /* Ensure we do not generate duplicate forward
2414 declarations for this type. */
2415 TREE_VISITED (decl
) = 1;
2420 /* Special case char arrays. */
2421 if (is_char_array (field
))
2422 pp_string (buffer
, "sub");
2424 pp_string (buffer
, "type ");
2425 dump_ada_double_name (buffer
, parent
, field
, "_array is ");
2426 dump_ada_array_type (buffer
, field
, spc
);
2427 pp_semicolon (buffer
);
2428 newline_and_indent (buffer
, spc
);
2432 TREE_VISITED (t
) = 1;
2433 dump_nested_types (buffer
, field
, t
, false, spc
);
2435 pp_string (buffer
, "type ");
2437 if (TYPE_NAME (TREE_TYPE (field
)))
2439 dump_generic_ada_node
2440 (buffer
, TYPE_NAME (TREE_TYPE (field
)), 0, spc
, false,
2442 pp_string (buffer
, " (discr : unsigned := 0) is ");
2443 print_ada_struct_decl
2444 (buffer
, TREE_TYPE (field
), t
, spc
, false);
2446 pp_string (buffer
, "pragma Convention (C_Pass_By_Copy, ");
2447 dump_generic_ada_node
2448 (buffer
, TREE_TYPE (field
), 0, spc
, false, true);
2449 pp_string (buffer
, ");");
2450 newline_and_indent (buffer
, spc
);
2452 pp_string (buffer
, "pragma Unchecked_Union (");
2453 dump_generic_ada_node
2454 (buffer
, TREE_TYPE (field
), 0, spc
, false, true);
2455 pp_string (buffer
, ");");
2459 dump_ada_double_name
2460 (buffer
, parent
, field
,
2461 "_union (discr : unsigned := 0) is ");
2462 print_ada_struct_decl
2463 (buffer
, TREE_TYPE (field
), t
, spc
, false);
2464 pp_string (buffer
, "pragma Convention (C_Pass_By_Copy, ");
2465 dump_ada_double_name (buffer
, parent
, field
, "_union);");
2466 newline_and_indent (buffer
, spc
);
2468 pp_string (buffer
, "pragma Unchecked_Union (");
2469 dump_ada_double_name (buffer
, parent
, field
, "_union);");
2472 newline_and_indent (buffer
, spc
);
2476 if (TYPE_NAME (TREE_TYPE (t
)) && !TREE_VISITED (t
))
2478 pp_string (buffer
, "type ");
2479 dump_generic_ada_node
2480 (buffer
, t
, parent
, spc
, false, true);
2481 pp_semicolon (buffer
);
2482 newline_and_indent (buffer
, spc
);
2485 TREE_VISITED (t
) = 1;
2486 dump_nested_types (buffer
, field
, t
, false, spc
);
2487 pp_string (buffer
, "type ");
2489 if (TYPE_NAME (TREE_TYPE (field
)))
2491 dump_generic_ada_node
2492 (buffer
, TREE_TYPE (field
), 0, spc
, false, true);
2493 pp_string (buffer
, " is ");
2494 print_ada_struct_decl
2495 (buffer
, TREE_TYPE (field
), t
, spc
, false);
2496 pp_string (buffer
, "pragma Convention (C_Pass_By_Copy, ");
2497 dump_generic_ada_node
2498 (buffer
, TREE_TYPE (field
), 0, spc
, false, true);
2499 pp_string (buffer
, ");");
2503 dump_ada_double_name
2504 (buffer
, parent
, field
, "_struct is ");
2505 print_ada_struct_decl
2506 (buffer
, TREE_TYPE (field
), t
, spc
, false);
2507 pp_string (buffer
, "pragma Convention (C_Pass_By_Copy, ");
2508 dump_ada_double_name (buffer
, parent
, field
, "_struct);");
2511 newline_and_indent (buffer
, spc
);
2518 field
= TREE_CHAIN (field
);
2521 TREE_VISITED (t
) = 1;
2524 /* Dump in BUFFER constructor spec corresponding to T. */
2527 print_constructor (pretty_printer
*buffer
, tree t
)
2529 tree decl_name
= DECL_NAME (DECL_ORIGIN (t
));
2531 pp_string (buffer
, "New_");
2532 pp_ada_tree_identifier (buffer
, decl_name
, t
, false);
2535 /* Dump in BUFFER destructor spec corresponding to T. */
2538 print_destructor (pretty_printer
*buffer
, tree t
)
2540 tree decl_name
= DECL_NAME (DECL_ORIGIN (t
));
2541 const char *s
= IDENTIFIER_POINTER (decl_name
);
2545 for (s
+= 2; *s
!= ' '; s
++)
2546 pp_character (buffer
, *s
);
2550 pp_string (buffer
, "Delete_");
2551 pp_ada_tree_identifier (buffer
, decl_name
, t
, false);
2555 /* Return the name of type T. */
2560 tree n
= TYPE_NAME (t
);
2562 if (TREE_CODE (n
) == IDENTIFIER_NODE
)
2563 return IDENTIFIER_POINTER (n
);
2565 return IDENTIFIER_POINTER (DECL_NAME (n
));
2568 /* Print in BUFFER the declaration of a variable T of type TYPE in Ada syntax.
2569 SPC is the indentation level. Return 1 if a declaration was printed,
2573 print_ada_declaration (pretty_printer
*buffer
, tree t
, tree type
, int spc
)
2575 int is_var
= 0, need_indent
= 0;
2576 int is_class
= false;
2577 tree name
= TYPE_NAME (TREE_TYPE (t
));
2578 tree decl_name
= DECL_NAME (t
);
2579 tree orig
= NULL_TREE
;
2581 if (cpp_check
&& cpp_check (t
, IS_TEMPLATE
))
2582 return dump_ada_template (buffer
, t
, spc
);
2584 if (TREE_CODE (t
) == CONST_DECL
&& TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
)
2585 /* Skip enumeral values: will be handled as part of the type itself. */
2588 if (TREE_CODE (t
) == TYPE_DECL
)
2590 orig
= DECL_ORIGINAL_TYPE (t
);
2592 if (orig
&& TYPE_STUB_DECL (orig
))
2594 tree stub
= TYPE_STUB_DECL (orig
);
2595 tree typ
= TREE_TYPE (stub
);
2597 if (TYPE_NAME (typ
))
2599 /* If types have same representation, and same name (ignoring
2600 casing), then ignore the second type. */
2601 if (type_name (typ
) == type_name (TREE_TYPE (t
))
2602 || !strcasecmp (type_name (typ
), type_name (TREE_TYPE (t
))))
2607 if (RECORD_OR_UNION_TYPE_P (typ
) && !TYPE_FIELDS (typ
))
2609 pp_string (buffer
, "-- skipped empty struct ");
2610 dump_generic_ada_node (buffer
, t
, type
, spc
, false, true);
2614 if (!TREE_VISITED (stub
)
2615 && DECL_SOURCE_FILE (stub
) == source_file_base
)
2616 dump_nested_types (buffer
, stub
, stub
, true, spc
);
2618 pp_string (buffer
, "subtype ");
2619 dump_generic_ada_node (buffer
, t
, type
, spc
, false, true);
2620 pp_string (buffer
, " is ");
2621 dump_generic_ada_node (buffer
, typ
, type
, spc
, false, true);
2622 pp_semicolon (buffer
);
2628 /* Skip unnamed or anonymous structs/unions/enum types. */
2629 if (!orig
&& !decl_name
&& !name
)
2634 if (cpp_check
|| TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
)
2637 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
)))
2639 /* Search next items until finding a named type decl. */
2640 sloc
= decl_sloc_common (t
, true, true);
2642 for (tmp
= TREE_CHAIN (t
); tmp
; tmp
= TREE_CHAIN (tmp
))
2644 if (TREE_CODE (tmp
) == TYPE_DECL
2645 && (DECL_NAME (tmp
) || TYPE_NAME (TREE_TYPE (tmp
))))
2647 /* If same sloc, it means we can ignore the anonymous
2649 if (decl_sloc_common (tmp
, true, true) == sloc
)
2661 && TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
2663 && (*IDENTIFIER_POINTER (decl_name
) == '.'
2664 || *IDENTIFIER_POINTER (decl_name
) == '$'))
2665 /* Skip anonymous enum types (duplicates of real types). */
2670 switch (TREE_CODE (TREE_TYPE (t
)))
2674 case QUAL_UNION_TYPE
:
2675 /* Skip empty structs (typically forward references to real
2677 if (!TYPE_FIELDS (TREE_TYPE (t
)))
2679 pp_string (buffer
, "-- skipped empty struct ");
2680 dump_generic_ada_node (buffer
, t
, type
, spc
, false, true);
2685 && (*IDENTIFIER_POINTER (decl_name
) == '.'
2686 || *IDENTIFIER_POINTER (decl_name
) == '$'))
2688 pp_string (buffer
, "-- skipped anonymous struct ");
2689 dump_generic_ada_node (buffer
, t
, type
, spc
, false, true);
2690 TREE_VISITED (t
) = 1;
2694 if (orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
2695 pp_string (buffer
, "subtype ");
2698 dump_nested_types (buffer
, t
, t
, false, spc
);
2700 if (separate_class_package (t
))
2703 pp_string (buffer
, "package Class_");
2704 dump_generic_ada_node (buffer
, t
, type
, spc
, false, true);
2705 pp_string (buffer
, " is");
2707 newline_and_indent (buffer
, spc
);
2710 pp_string (buffer
, "type ");
2716 case REFERENCE_TYPE
:
2717 if ((orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
2718 || is_char_array (t
))
2719 pp_string (buffer
, "subtype ");
2721 pp_string (buffer
, "type ");
2725 pp_string (buffer
, "-- skipped function type ");
2726 dump_generic_ada_node (buffer
, t
, type
, spc
, false, true);
2731 if ((orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
2732 || !is_simple_enum (TREE_TYPE (t
)))
2733 pp_string (buffer
, "subtype ");
2735 pp_string (buffer
, "type ");
2739 pp_string (buffer
, "subtype ");
2741 TREE_VISITED (t
) = 1;
2745 if (TREE_CODE (t
) == VAR_DECL
2747 && *IDENTIFIER_POINTER (decl_name
) == '_')
2753 /* Print the type and name. */
2754 if (TREE_CODE (TREE_TYPE (t
)) == ARRAY_TYPE
)
2759 /* Print variable's name. */
2760 dump_generic_ada_node (buffer
, t
, type
, spc
, false, true);
2762 if (TREE_CODE (t
) == TYPE_DECL
)
2764 pp_string (buffer
, " is ");
2766 if (orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
2767 dump_generic_ada_node
2768 (buffer
, TYPE_NAME (orig
), type
, spc
, false, true);
2770 dump_ada_array_type (buffer
, t
, spc
);
2774 tree tmp
= TYPE_NAME (TREE_TYPE (t
));
2776 if (spc
== INDENT_INCR
|| TREE_STATIC (t
))
2779 pp_string (buffer
, " : ");
2783 if (TREE_CODE (TREE_TYPE (tmp
)) != POINTER_TYPE
2784 && TREE_CODE (tmp
) != INTEGER_TYPE
)
2785 pp_string (buffer
, "aliased ");
2787 dump_generic_ada_node (buffer
, tmp
, type
, spc
, false, true);
2791 pp_string (buffer
, "aliased ");
2794 dump_ada_array_type (buffer
, t
, spc
);
2796 dump_ada_double_name (buffer
, type
, t
, "_array");
2800 else if (TREE_CODE (t
) == FUNCTION_DECL
)
2802 bool is_function
, is_abstract_class
= false;
2803 bool is_method
= TREE_CODE (TREE_TYPE (t
)) == METHOD_TYPE
;
2804 tree decl_name
= DECL_NAME (t
);
2805 int prev_in_function
= in_function
;
2806 bool is_abstract
= false;
2807 bool is_constructor
= false;
2808 bool is_destructor
= false;
2809 bool is_copy_constructor
= false;
2816 is_abstract
= cpp_check (t
, IS_ABSTRACT
);
2817 is_constructor
= cpp_check (t
, IS_CONSTRUCTOR
);
2818 is_destructor
= cpp_check (t
, IS_DESTRUCTOR
);
2819 is_copy_constructor
= cpp_check (t
, IS_COPY_CONSTRUCTOR
);
2822 /* Skip copy constructors: some are internal only, and those that are
2823 not cannot be called easily from Ada anyway. */
2824 if (is_copy_constructor
)
2827 if (is_constructor
|| is_destructor
)
2829 /* Only consider constructors/destructors for complete objects. */
2830 if (strncmp (IDENTIFIER_POINTER (decl_name
), "__comp", 6) != 0)
2834 /* If this function has an entry in the vtable, we cannot omit it. */
2835 else if (!DECL_VINDEX (t
) && *IDENTIFIER_POINTER (decl_name
) == '_')
2838 pp_string (buffer
, "-- skipped func ");
2839 pp_string (buffer
, IDENTIFIER_POINTER (decl_name
));
2846 if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t
))) && !is_constructor
)
2848 pp_string (buffer
, "procedure ");
2849 is_function
= false;
2853 pp_string (buffer
, "function ");
2857 in_function
= is_function
;
2860 print_constructor (buffer
, t
);
2861 else if (is_destructor
)
2862 print_destructor (buffer
, t
);
2864 dump_ada_decl_name (buffer
, t
, false);
2866 dump_ada_function_declaration
2867 (buffer
, t
, is_method
, is_constructor
, is_destructor
, spc
);
2868 in_function
= prev_in_function
;
2872 pp_string (buffer
, " return ");
2874 = is_constructor
? DECL_CONTEXT (t
) : TREE_TYPE (TREE_TYPE (t
));
2875 dump_generic_ada_node (buffer
, ret_type
, type
, spc
, false, true);
2879 && RECORD_OR_UNION_TYPE_P (type
)
2880 && TYPE_METHODS (type
))
2884 for (tmp
= TYPE_METHODS (type
); tmp
; tmp
= TREE_CHAIN (tmp
))
2885 if (cpp_check (tmp
, IS_ABSTRACT
))
2887 is_abstract_class
= true;
2892 if (is_abstract
|| is_abstract_class
)
2893 pp_string (buffer
, " is abstract");
2895 pp_semicolon (buffer
);
2896 pp_string (buffer
, " -- ");
2897 dump_sloc (buffer
, t
);
2899 if (is_abstract
|| !DECL_ASSEMBLER_NAME (t
))
2902 newline_and_indent (buffer
, spc
);
2906 pp_string (buffer
, "pragma CPP_Constructor (");
2907 print_constructor (buffer
, t
);
2908 pp_string (buffer
, ", \"");
2909 pp_asm_name (buffer
, t
);
2910 pp_string (buffer
, "\");");
2912 else if (is_destructor
)
2914 pp_string (buffer
, "pragma Import (CPP, ");
2915 print_destructor (buffer
, t
);
2916 pp_string (buffer
, ", \"");
2917 pp_asm_name (buffer
, t
);
2918 pp_string (buffer
, "\");");
2922 dump_ada_import (buffer
, t
);
2927 else if (TREE_CODE (t
) == TYPE_DECL
&& !DECL_ORIGINAL_TYPE (t
))
2929 int is_interface
= 0;
2930 int is_abstract_record
= 0;
2935 /* Anonymous structs/unions */
2936 dump_generic_ada_node (buffer
, TREE_TYPE (t
), t
, spc
, false, true);
2938 if (TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
2939 || TREE_CODE (TREE_TYPE (t
)) == QUAL_UNION_TYPE
)
2941 pp_string (buffer
, " (discr : unsigned := 0)");
2944 pp_string (buffer
, " is ");
2946 /* Check whether we have an Ada interface compatible class. */
2948 && RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
))
2949 && TYPE_METHODS (TREE_TYPE (t
)))
2954 /* Check that there are no fields other than the virtual table. */
2955 for (tmp
= TYPE_FIELDS (TREE_TYPE (t
)); tmp
; tmp
= TREE_CHAIN (tmp
))
2957 if (TREE_CODE (tmp
) == TYPE_DECL
)
2962 if (num_fields
== 1)
2965 /* Also check that there are only virtual methods. */
2966 for (tmp
= TYPE_METHODS (TREE_TYPE (t
)); tmp
; tmp
= TREE_CHAIN (tmp
))
2968 if (cpp_check (tmp
, IS_ABSTRACT
))
2969 is_abstract_record
= 1;
2975 TREE_VISITED (t
) = 1;
2978 pp_string (buffer
, "limited interface; -- ");
2979 dump_sloc (buffer
, t
);
2980 newline_and_indent (buffer
, spc
);
2981 pp_string (buffer
, "pragma Import (CPP, ");
2982 dump_generic_ada_node
2983 (buffer
, TYPE_NAME (TREE_TYPE (t
)), type
, spc
, false, true);
2984 pp_right_paren (buffer
);
2986 print_ada_methods (buffer
, TREE_TYPE (t
), spc
);
2990 if (is_abstract_record
)
2991 pp_string (buffer
, "abstract ");
2992 dump_generic_ada_node (buffer
, t
, t
, spc
, false, false);
3000 if (TREE_CODE (t
) == FIELD_DECL
&& DECL_NAME (t
))
3001 check_name (buffer
, t
);
3003 /* Print variable/type's name. */
3004 dump_generic_ada_node (buffer
, t
, t
, spc
, false, true);
3006 if (TREE_CODE (t
) == TYPE_DECL
)
3008 tree orig
= DECL_ORIGINAL_TYPE (t
);
3009 int is_subtype
= orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
);
3012 && (TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
3013 || TREE_CODE (TREE_TYPE (t
)) == QUAL_UNION_TYPE
))
3014 pp_string (buffer
, " (discr : unsigned := 0)");
3016 pp_string (buffer
, " is ");
3018 dump_generic_ada_node (buffer
, orig
, t
, spc
, false, is_subtype
);
3022 if (spc
== INDENT_INCR
|| TREE_STATIC (t
))
3025 pp_string (buffer
, " : ");
3027 /* Print type declaration. */
3029 if (TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
3030 && !TYPE_NAME (TREE_TYPE (t
)))
3032 dump_ada_double_name (buffer
, type
, t
, "_union");
3034 else if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
)))
3036 if (TREE_CODE (TREE_TYPE (t
)) == RECORD_TYPE
)
3037 pp_string (buffer
, "aliased ");
3039 dump_generic_ada_node
3040 (buffer
, TREE_TYPE (t
), t
, spc
, false, true);
3044 if (TREE_CODE (TREE_TYPE (t
)) != POINTER_TYPE
3045 && (TYPE_NAME (TREE_TYPE (t
))
3046 || TREE_CODE (TREE_TYPE (t
)) != INTEGER_TYPE
))
3047 pp_string (buffer
, "aliased ");
3049 dump_generic_ada_node
3050 (buffer
, TREE_TYPE (t
), TREE_TYPE (t
), spc
, false, true);
3058 newline_and_indent (buffer
, spc
);
3059 pp_string (buffer
, "end;");
3060 newline_and_indent (buffer
, spc
);
3061 pp_string (buffer
, "use Class_");
3062 dump_generic_ada_node (buffer
, t
, type
, spc
, false, true);
3063 pp_semicolon (buffer
);
3064 pp_newline (buffer
);
3066 /* All needed indentation/newline performed already, so return 0. */
3071 pp_string (buffer
, "; -- ");
3072 dump_sloc (buffer
, t
);
3077 newline_and_indent (buffer
, spc
);
3078 dump_ada_import (buffer
, t
);
3084 /* Prints in BUFFER a structure NODE of type TYPE: name, fields, and methods
3085 with Ada syntax. SPC is the indentation level. If DISPLAY_CONVENTION is
3086 true, also print the pragma Convention for NODE. */
3089 print_ada_struct_decl (pretty_printer
*buffer
, tree node
, tree type
, int spc
,
3090 bool display_convention
)
3094 = TREE_CODE (node
) == UNION_TYPE
|| TREE_CODE (node
) == QUAL_UNION_TYPE
;
3097 int field_spc
= spc
+ INDENT_INCR
;
3100 bitfield_used
= false;
3102 if (!TYPE_FIELDS (node
))
3103 pp_string (buffer
, "null record;");
3106 pp_string (buffer
, "record");
3108 /* Print the contents of the structure. */
3112 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
3113 pp_string (buffer
, "case discr is");
3114 field_spc
= spc
+ INDENT_INCR
* 3;
3117 pp_newline (buffer
);
3119 /* Print the non-static fields of the structure. */
3120 for (tmp
= TYPE_FIELDS (node
); tmp
; tmp
= TREE_CHAIN (tmp
))
3122 /* Add parent field if needed. */
3123 if (!DECL_NAME (tmp
))
3125 if (!is_tagged_type (TREE_TYPE (tmp
)))
3127 if (!TYPE_NAME (TREE_TYPE (tmp
)))
3128 print_ada_declaration (buffer
, tmp
, type
, field_spc
);
3134 pp_string (buffer
, "parent : aliased ");
3137 sprintf (buf
, "field_%d : aliased ", field_num
+ 1);
3138 pp_string (buffer
, buf
);
3141 (buffer
, TYPE_NAME (TREE_TYPE (tmp
)), false);
3142 pp_semicolon (buffer
);
3144 pp_newline (buffer
);
3148 /* Avoid printing the structure recursively. */
3149 else if ((TREE_TYPE (tmp
) != node
3150 || (TREE_CODE (TREE_TYPE (tmp
)) == POINTER_TYPE
3151 && TREE_TYPE (TREE_TYPE (tmp
)) != node
))
3152 && TREE_CODE (tmp
) != TYPE_DECL
3153 && !TREE_STATIC (tmp
))
3155 /* Skip internal virtual table field. */
3156 if (strncmp (IDENTIFIER_POINTER (DECL_NAME (tmp
)), "_vptr", 5))
3160 if (TREE_CHAIN (tmp
)
3161 && TREE_TYPE (TREE_CHAIN (tmp
)) != node
3162 && TREE_CODE (TREE_CHAIN (tmp
)) != TYPE_DECL
)
3163 sprintf (buf
, "when %d =>", field_num
);
3165 sprintf (buf
, "when others =>");
3167 INDENT (spc
+ INDENT_INCR
* 2);
3168 pp_string (buffer
, buf
);
3169 pp_newline (buffer
);
3172 if (print_ada_declaration (buffer
, tmp
, type
, field_spc
))
3174 pp_newline (buffer
);
3183 INDENT (spc
+ INDENT_INCR
);
3184 pp_string (buffer
, "end case;");
3185 pp_newline (buffer
);
3190 INDENT (spc
+ INDENT_INCR
);
3191 pp_string (buffer
, "null;");
3192 pp_newline (buffer
);
3196 pp_string (buffer
, "end record;");
3199 newline_and_indent (buffer
, spc
);
3201 if (!display_convention
)
3204 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (type
)))
3206 if (has_nontrivial_methods (TREE_TYPE (type
)))
3207 pp_string (buffer
, "pragma Import (CPP, ");
3209 pp_string (buffer
, "pragma Convention (C_Pass_By_Copy, ");
3212 pp_string (buffer
, "pragma Convention (C, ");
3214 package_prefix
= false;
3215 dump_generic_ada_node (buffer
, TREE_TYPE (type
), type
, spc
, false, true);
3216 package_prefix
= true;
3217 pp_right_paren (buffer
);
3221 pp_semicolon (buffer
);
3222 newline_and_indent (buffer
, spc
);
3223 pp_string (buffer
, "pragma Unchecked_Union (");
3225 dump_generic_ada_node (buffer
, TREE_TYPE (type
), type
, spc
, false, true);
3226 pp_right_paren (buffer
);
3231 pp_semicolon (buffer
);
3232 newline_and_indent (buffer
, spc
);
3233 pp_string (buffer
, "pragma Pack (");
3234 dump_generic_ada_node
3235 (buffer
, TREE_TYPE (type
), type
, spc
, false, true);
3236 pp_right_paren (buffer
);
3237 bitfield_used
= false;
3240 need_semicolon
= !print_ada_methods (buffer
, node
, spc
);
3242 /* Print the static fields of the structure, if any. */
3243 for (tmp
= TYPE_FIELDS (node
); tmp
; tmp
= TREE_CHAIN (tmp
))
3245 if (DECL_NAME (tmp
) && TREE_STATIC (tmp
))
3249 need_semicolon
= false;
3250 pp_semicolon (buffer
);
3252 pp_newline (buffer
);
3253 pp_newline (buffer
);
3254 print_ada_declaration (buffer
, tmp
, type
, spc
);
3259 /* Dump all the declarations in SOURCE_FILE to an Ada spec.
3260 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3261 nodes for SOURCE_FILE. CHECK is used to perform C++ queries on nodes. */
3264 dump_ads (const char *source_file
,
3265 void (*collect_all_refs
)(const char *),
3266 int (*check
)(tree
, cpp_operation
))
3273 pkg_name
= get_ada_package (source_file
);
3275 /* Construct the .ads filename and package name. */
3276 ads_name
= xstrdup (pkg_name
);
3278 for (s
= ads_name
; *s
; s
++)
3284 ads_name
= reconcat (ads_name
, ads_name
, ".ads", NULL
);
3286 /* Write out the .ads file. */
3287 f
= fopen (ads_name
, "w");
3292 pp_needs_newline (&pp
) = true;
3293 pp
.buffer
->stream
= f
;
3295 /* Dump all relevant macros. */
3296 dump_ada_macros (&pp
, source_file
);
3298 /* Reset the table of withs for this file. */
3301 (*collect_all_refs
) (source_file
);
3303 /* Dump all references. */
3305 dump_ada_nodes (&pp
, source_file
);
3307 /* Requires Ada 2005 syntax, so generate corresponding pragma.
3308 Also, disable style checks since this file is auto-generated. */
3309 fprintf (f
, "pragma Ada_2005;\npragma Style_Checks (Off);\n\n");
3314 fprintf (f
, "\npackage %s is\n\n", pkg_name
);
3315 pp_write_text_to_stream (&pp
);
3316 /* ??? need to free pp */
3317 fprintf (f
, "end %s;\n", pkg_name
);
3325 static const char **source_refs
= NULL
;
3326 static int source_refs_used
= 0;
3327 static int source_refs_allocd
= 0;
3329 /* Add an entry for FILENAME to the table SOURCE_REFS. */
3332 collect_source_ref (const char *filename
)
3339 if (source_refs_allocd
== 0)
3341 source_refs_allocd
= 1024;
3342 source_refs
= XNEWVEC (const char *, source_refs_allocd
);
3345 for (i
= 0; i
< source_refs_used
; i
++)
3346 if (filename
== source_refs
[i
])
3349 if (source_refs_used
== source_refs_allocd
)
3351 source_refs_allocd
*= 2;
3352 source_refs
= XRESIZEVEC (const char *, source_refs
, source_refs_allocd
);
3355 source_refs
[source_refs_used
++] = filename
;
3358 /* Main entry point: dump all Ada specs corresponding to SOURCE_REFS
3359 using callbacks COLLECT_ALL_REFS and CHECK.
3360 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3361 nodes for a given source file.
3362 CHECK is used to perform C++ queries on nodes, or NULL for the C
3366 dump_ada_specs (void (*collect_all_refs
)(const char *),
3367 int (*check
)(tree
, cpp_operation
))
3371 /* Iterate over the list of files to dump specs for */
3372 for (i
= 0; i
< source_refs_used
; i
++)
3373 dump_ads (source_refs
[i
], collect_all_refs
, check
);
3375 /* Free files table. */