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 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 "tree-pass.h" /* For TDI_ada and friends. */
29 #include "c-ada-spec.h"
32 #include "cpp-id-data.h"
34 /* Local functions, macros and variables. */
35 static int dump_generic_ada_node (pretty_printer
*, tree
, tree
,
36 int (*)(tree
, cpp_operation
), int, int, bool);
37 static int print_ada_declaration (pretty_printer
*, tree
, tree
,
38 int (*cpp_check
)(tree
, cpp_operation
), int);
39 static void print_ada_struct_decl (pretty_printer
*, tree
, tree
,
40 int (*cpp_check
)(tree
, cpp_operation
), int,
42 static void dump_sloc (pretty_printer
*buffer
, tree node
);
43 static void print_comment (pretty_printer
*, const char *);
44 static void print_generic_ada_decl (pretty_printer
*, tree
,
45 int (*)(tree
, cpp_operation
), const char *);
46 static char *get_ada_package (const char *);
47 static void dump_ada_nodes (pretty_printer
*, const char *,
48 int (*)(tree
, cpp_operation
));
49 static void reset_ada_withs (void);
50 static void dump_ada_withs (FILE *);
51 static void dump_ads (const char *, void (*)(const char *),
52 int (*)(tree
, cpp_operation
));
53 static char *to_ada_name (const char *, int *);
55 #define LOCATION_COL(LOC) ((expand_location (LOC)).column)
57 #define INDENT(SPACE) do { \
58 int i; for (i = 0; i<SPACE; i++) pp_space (buffer); } while (0)
62 /* Given a cpp MACRO, compute the max length BUFFER_LEN of the macro, as well
63 as max length PARAM_LEN of arguments for fun_like macros, and also set
64 SUPPORTED to 0 if the macro cannot be mapped to an Ada construct. */
67 macro_length (const cpp_macro
*macro
, int *supported
, int *buffer_len
,
80 for (i
= 0; i
< macro
->paramc
; i
++)
82 cpp_hashnode
*param
= macro
->params
[i
];
84 *param_len
+= NODE_LEN (param
);
86 if (i
+ 1 < macro
->paramc
)
88 *param_len
+= 2; /* ", " */
90 else if (macro
->variadic
)
96 *param_len
+= 2; /* ")\0" */
99 for (j
= 0; j
< macro
->count
; j
++)
101 cpp_token
*token
= ¯o
->exp
.tokens
[j
];
103 if (token
->flags
& PREV_WHITE
)
106 if (token
->flags
& STRINGIFY_ARG
|| token
->flags
& PASTE_LEFT
)
112 if (token
->type
== CPP_MACRO_ARG
)
114 NODE_LEN (macro
->params
[token
->val
.macro_arg
.arg_no
- 1]);
116 /* Include enough extra space to handle e.g. special characters. */
117 *buffer_len
+= (cpp_token_len (token
) + 1) * 8;
123 /* Dump into PP a set of MAX_ADA_MACROS MACROS (C/C++) as Ada constants when
127 print_ada_macros (pretty_printer
*pp
, cpp_hashnode
**macros
, int max_ada_macros
)
129 int j
, num_macros
= 0, prev_line
= -1;
131 for (j
= 0; j
< max_ada_macros
; j
++)
133 cpp_hashnode
*node
= macros
[j
];
134 const cpp_macro
*macro
= node
->value
.macro
;
136 int supported
= 1, prev_is_one
= 0, buffer_len
, param_len
;
137 int is_string
= 0, is_char
= 0;
139 unsigned char *s
, *params
, *buffer
, *buf_param
, *char_one
= NULL
;
141 macro_length (macro
, &supported
, &buffer_len
, ¶m_len
);
142 s
= buffer
= XALLOCAVEC (unsigned char, buffer_len
);
143 params
= buf_param
= XALLOCAVEC (unsigned char, param_len
);
150 for (i
= 0; i
< macro
->paramc
; i
++)
152 cpp_hashnode
*param
= macro
->params
[i
];
154 memcpy (buf_param
, NODE_NAME (param
), NODE_LEN (param
));
155 buf_param
+= NODE_LEN (param
);
157 if (i
+ 1 < macro
->paramc
)
162 else if (macro
->variadic
)
172 for (i
= 0; supported
&& i
< macro
->count
; i
++)
174 cpp_token
*token
= ¯o
->exp
.tokens
[i
];
177 if (token
->flags
& PREV_WHITE
)
180 if (token
->flags
& STRINGIFY_ARG
|| token
->flags
& PASTE_LEFT
)
190 cpp_hashnode
*param
=
191 macro
->params
[token
->val
.macro_arg
.arg_no
- 1];
192 memcpy (buffer
, NODE_NAME (param
), NODE_LEN (param
));
193 buffer
+= NODE_LEN (param
);
197 case CPP_EQ_EQ
: *buffer
++ = '='; break;
198 case CPP_GREATER
: *buffer
++ = '>'; break;
199 case CPP_LESS
: *buffer
++ = '<'; break;
200 case CPP_PLUS
: *buffer
++ = '+'; break;
201 case CPP_MINUS
: *buffer
++ = '-'; break;
202 case CPP_MULT
: *buffer
++ = '*'; break;
203 case CPP_DIV
: *buffer
++ = '/'; break;
204 case CPP_COMMA
: *buffer
++ = ','; break;
205 case CPP_OPEN_SQUARE
:
206 case CPP_OPEN_PAREN
: *buffer
++ = '('; break;
207 case CPP_CLOSE_SQUARE
: /* fallthrough */
208 case CPP_CLOSE_PAREN
: *buffer
++ = ')'; break;
209 case CPP_DEREF
: /* fallthrough */
210 case CPP_SCOPE
: /* fallthrough */
211 case CPP_DOT
: *buffer
++ = '.'; break;
213 case CPP_EQ
: *buffer
++ = ':'; *buffer
++ = '='; break;
214 case CPP_NOT_EQ
: *buffer
++ = '/'; *buffer
++ = '='; break;
215 case CPP_GREATER_EQ
: *buffer
++ = '>'; *buffer
++ = '='; break;
216 case CPP_LESS_EQ
: *buffer
++ = '<'; *buffer
++ = '='; break;
219 *buffer
++ = 'n'; *buffer
++ = 'o'; *buffer
++ = 't'; break;
221 *buffer
++ = 'm'; *buffer
++ = 'o'; *buffer
++ = 'd'; break;
223 *buffer
++ = 'a'; *buffer
++ = 'n'; *buffer
++ = 'd'; break;
225 *buffer
++ = 'o'; *buffer
++ = 'r'; break;
227 *buffer
++ = 'x'; *buffer
++ = 'o'; *buffer
++ = 'r'; break;
229 strcpy ((char *) buffer
, " and then ");
233 strcpy ((char *) buffer
, " or else ");
239 is_one
= prev_is_one
;
242 case CPP_COMMENT
: break;
254 if (!macro
->fun_like
)
257 buffer
= cpp_spell_token (parse_in
, token
, buffer
, false);
267 c
= cpp_interpret_charconst (parse_in
, token
,
268 &chars_seen
, &ignored
);
269 if (c
>= 32 && c
<= 126)
272 *buffer
++ = (char) c
;
278 ((char *) buffer
, "Character'Val (%d)", (int) c
);
279 buffer
+= chars_seen
;
287 /* Replace "1 << N" by "2 ** N" */
314 case CPP_CLOSE_BRACE
:
318 case CPP_MINUS_MINUS
:
322 case CPP_HEADER_NAME
:
325 case CPP_OBJC_STRING
:
327 if (!macro
->fun_like
)
330 buffer
= cpp_spell_token (parse_in
, token
, buffer
, false);
334 prev_is_one
= is_one
;
341 if (macro
->fun_like
&& supported
)
343 char *start
= (char *) s
;
346 pp_string (pp
, " -- arg-macro: ");
348 if (*start
== '(' && buffer
[-1] == ')')
353 pp_string (pp
, "function ");
357 pp_string (pp
, "procedure ");
360 pp_string (pp
, (const char *) NODE_NAME (node
));
362 pp_string (pp
, (char *) params
);
364 pp_string (pp
, " -- ");
368 pp_string (pp
, "return ");
369 pp_string (pp
, start
);
373 pp_string (pp
, start
);
379 expanded_location sloc
= expand_location (macro
->line
);
381 if (sloc
.line
!= prev_line
+ 1)
385 prev_line
= sloc
.line
;
388 ada_name
= to_ada_name ((const char *) NODE_NAME (node
), NULL
);
389 pp_string (pp
, ada_name
);
391 pp_string (pp
, " : ");
394 pp_string (pp
, "aliased constant String");
396 pp_string (pp
, "aliased constant Character");
398 pp_string (pp
, "constant");
400 pp_string (pp
, " := ");
401 pp_string (pp
, (char *) s
);
404 pp_string (pp
, " & ASCII.NUL");
406 pp_string (pp
, "; -- ");
407 pp_string (pp
, sloc
.file
);
408 pp_character (pp
, ':');
409 pp_scalar (pp
, "%d", sloc
.line
);
414 pp_string (pp
, " -- unsupported macro: ");
415 pp_string (pp
, (const char *) cpp_macro_definition (parse_in
, node
));
424 static const char *source_file
;
425 static int max_ada_macros
;
427 /* Callback used to count the number of relevant macros from
428 cpp_forall_identifiers. PFILE and V are not used. NODE is the current macro
432 count_ada_macro (cpp_reader
*pfile ATTRIBUTE_UNUSED
, cpp_hashnode
*node
,
433 void *v ATTRIBUTE_UNUSED
)
435 const cpp_macro
*macro
= node
->value
.macro
;
437 if (node
->type
== NT_MACRO
&& !(node
->flags
& NODE_BUILTIN
)
439 && *NODE_NAME (node
) != '_'
440 && LOCATION_FILE (macro
->line
) == source_file
)
446 static int store_ada_macro_index
;
448 /* Callback used to store relevant macros from cpp_forall_identifiers.
449 PFILE is not used. NODE is the current macro to store if relevant.
450 MACROS is an array of cpp_hashnode* used to store NODE. */
453 store_ada_macro (cpp_reader
*pfile ATTRIBUTE_UNUSED
,
454 cpp_hashnode
*node
, void *macros
)
456 const cpp_macro
*macro
= node
->value
.macro
;
458 if (node
->type
== NT_MACRO
&& !(node
->flags
& NODE_BUILTIN
)
460 && *NODE_NAME (node
) != '_'
461 && LOCATION_FILE (macro
->line
) == source_file
)
462 ((cpp_hashnode
**) macros
)[store_ada_macro_index
++] = node
;
467 /* Callback used to compare (during qsort) macros. NODE1 and NODE2 are the
468 two macro nodes to compare. */
471 compare_macro (const void *node1
, const void *node2
)
473 typedef const cpp_hashnode
*const_hnode
;
475 const_hnode n1
= *(const const_hnode
*) node1
;
476 const_hnode n2
= *(const const_hnode
*) node2
;
478 return n1
->value
.macro
->line
- n2
->value
.macro
->line
;
481 /* Dump in PP all relevant macros appearing in FILE. */
484 dump_ada_macros (pretty_printer
*pp
, const char* file
)
486 cpp_hashnode
**macros
;
488 /* Initialize file-scope variables. */
490 store_ada_macro_index
= 0;
493 /* Count all potentially relevant macros, and then sort them by sloc. */
494 cpp_forall_identifiers (parse_in
, count_ada_macro
, NULL
);
495 macros
= XALLOCAVEC (cpp_hashnode
*, max_ada_macros
);
496 cpp_forall_identifiers (parse_in
, store_ada_macro
, macros
);
497 qsort (macros
, max_ada_macros
, sizeof (cpp_hashnode
*), compare_macro
);
499 print_ada_macros (pp
, macros
, max_ada_macros
);
502 /* Current source file being handled. */
504 static const char *source_file_base
;
506 /* Compare the declaration (DECL) of struct-like types based on the sloc of
507 their last field (if LAST is true), so that more nested types collate before
509 If ORIG_TYPE is true, also consider struct with a DECL_ORIGINAL_TYPE. */
512 decl_sloc_common (const_tree decl
, bool last
, bool orig_type
)
514 tree type
= TREE_TYPE (decl
);
516 if (TREE_CODE (decl
) == TYPE_DECL
517 && (orig_type
|| !DECL_ORIGINAL_TYPE (decl
))
518 && RECORD_OR_UNION_TYPE_P (type
)
519 && TYPE_FIELDS (type
))
521 tree f
= TYPE_FIELDS (type
);
524 while (TREE_CHAIN (f
))
527 return DECL_SOURCE_LOCATION (f
);
530 return DECL_SOURCE_LOCATION (decl
);
533 /* Return sloc of DECL, using sloc of last field if LAST is true. */
536 decl_sloc (const_tree decl
, bool last
)
538 return decl_sloc_common (decl
, last
, false);
541 /* Compare two declarations (LP and RP) by their source location. */
544 compare_node (const void *lp
, const void *rp
)
546 const_tree lhs
= *((const tree
*) lp
);
547 const_tree rhs
= *((const tree
*) rp
);
549 return decl_sloc (lhs
, true) - decl_sloc (rhs
, true);
552 /* Compare two comments (LP and RP) by their source location. */
555 compare_comment (const void *lp
, const void *rp
)
557 const cpp_comment
*lhs
= (const cpp_comment
*) lp
;
558 const cpp_comment
*rhs
= (const cpp_comment
*) rp
;
560 if (LOCATION_FILE (lhs
->sloc
) != LOCATION_FILE (rhs
->sloc
))
561 return strcmp (LOCATION_FILE (lhs
->sloc
), LOCATION_FILE (rhs
->sloc
));
563 if (LOCATION_LINE (lhs
->sloc
) != LOCATION_LINE (rhs
->sloc
))
564 return LOCATION_LINE (lhs
->sloc
) - LOCATION_LINE (rhs
->sloc
);
566 if (LOCATION_COL (lhs
->sloc
) != LOCATION_COL (rhs
->sloc
))
567 return LOCATION_COL (lhs
->sloc
) - LOCATION_COL (rhs
->sloc
);
572 static tree
*to_dump
= NULL
;
573 static int to_dump_count
= 0;
575 /* Collect a list of declarations from T relevant to SOURCE_FILE to be dumped
576 by a subsequent call to dump_ada_nodes. */
579 collect_ada_nodes (tree t
, const char *source_file
)
582 int i
= to_dump_count
;
584 /* Count the likely relevant nodes. */
585 for (n
= t
; n
; n
= TREE_CHAIN (n
))
586 if (!DECL_IS_BUILTIN (n
)
587 && LOCATION_FILE (decl_sloc (n
, false)) == source_file
)
590 /* Allocate sufficient storage for all nodes. */
591 to_dump
= XRESIZEVEC (tree
, to_dump
, to_dump_count
);
593 /* Store the relevant nodes. */
594 for (n
= t
; n
; n
= TREE_CHAIN (n
))
595 if (!DECL_IS_BUILTIN (n
)
596 && LOCATION_FILE (decl_sloc (n
, false)) == source_file
)
600 /* Call back for walk_tree to clear the TREE_VISITED flag of TP. */
603 unmark_visited_r (tree
*tp
, int *walk_subtrees ATTRIBUTE_UNUSED
,
604 void *data ATTRIBUTE_UNUSED
)
606 if (TREE_VISITED (*tp
))
607 TREE_VISITED (*tp
) = 0;
614 /* Dump nodes into PP relevant to SOURCE_FILE, as collected by previous calls
615 to collect_ada_nodes. CPP_CHECK is used to perform C++ queries on nodes. */
618 dump_ada_nodes (pretty_printer
*pp
, const char *source_file
,
619 int (*cpp_check
)(tree
, cpp_operation
))
622 cpp_comment_table
*comments
;
624 /* Sort the table of declarations to dump by sloc. */
625 qsort (to_dump
, to_dump_count
, sizeof (tree
), compare_node
);
627 /* Fetch the table of comments. */
628 comments
= cpp_get_comments (parse_in
);
630 /* Sort the comments table by sloc. */
631 qsort (comments
->entries
, comments
->count
, sizeof (cpp_comment
),
634 /* Interleave comments and declarations in line number order. */
638 /* Advance j until comment j is in this file. */
639 while (j
!= comments
->count
640 && LOCATION_FILE (comments
->entries
[j
].sloc
) != source_file
)
643 /* Advance j until comment j is not a duplicate. */
644 while (j
< comments
->count
- 1
645 && !compare_comment (&comments
->entries
[j
],
646 &comments
->entries
[j
+ 1]))
649 /* Write decls until decl i collates after comment j. */
650 while (i
!= to_dump_count
)
652 if (j
== comments
->count
653 || LOCATION_LINE (decl_sloc (to_dump
[i
], false))
654 < LOCATION_LINE (comments
->entries
[j
].sloc
))
655 print_generic_ada_decl (pp
, to_dump
[i
++], cpp_check
, source_file
);
660 /* Write comment j, if there is one. */
661 if (j
!= comments
->count
)
662 print_comment (pp
, comments
->entries
[j
++].comment
);
664 } while (i
!= to_dump_count
|| j
!= comments
->count
);
666 /* Clear the TREE_VISITED flag over each subtree we've dumped. */
667 for (i
= 0; i
< to_dump_count
; i
++)
668 walk_tree (&to_dump
[i
], unmark_visited_r
, NULL
, NULL
);
670 /* Finalize the to_dump table. */
679 /* Print a COMMENT to the output stream PP. */
682 print_comment (pretty_printer
*pp
, const char *comment
)
684 int len
= strlen (comment
);
685 char *str
= XALLOCAVEC (char, len
+ 1);
687 bool extra_newline
= false;
689 memcpy (str
, comment
, len
+ 1);
691 /* Trim C/C++ comment indicators. */
692 if (str
[len
- 2] == '*' && str
[len
- 1] == '/')
699 tok
= strtok (str
, "\n");
701 pp_string (pp
, " --");
704 tok
= strtok (NULL
, "\n");
706 /* Leave a blank line after multi-line comments. */
708 extra_newline
= true;
715 /* Prints declaration DECL to PP in Ada syntax. The current source file being
716 handled is SOURCE_FILE, and CPP_CHECK is used to perform C++ queries on
720 print_generic_ada_decl (pretty_printer
*pp
, tree decl
,
721 int (*cpp_check
)(tree
, cpp_operation
),
722 const char* source_file
)
724 source_file_base
= source_file
;
726 if (print_ada_declaration (pp
, decl
, 0, cpp_check
, INDENT_INCR
))
733 /* Dump a newline and indent BUFFER by SPC chars. */
736 newline_and_indent (pretty_printer
*buffer
, int spc
)
742 struct with
{ char *s
; const char *in_file
; int limited
; };
743 static struct with
*withs
= NULL
;
744 static int withs_max
= 4096;
745 static int with_len
= 0;
747 /* Record a "with" clause on package S (a limited with if LIMITED_ACCESS is
748 true), if not already done. */
751 append_withs (const char *s
, int limited_access
)
756 withs
= XNEWVEC (struct with
, withs_max
);
758 if (with_len
== withs_max
)
761 withs
= XRESIZEVEC (struct with
, withs
, withs_max
);
764 for (i
= 0; i
< with_len
; i
++)
765 if (!strcmp (s
, withs
[i
].s
)
766 && source_file_base
== withs
[i
].in_file
)
768 withs
[i
].limited
&= limited_access
;
772 withs
[with_len
].s
= xstrdup (s
);
773 withs
[with_len
].in_file
= source_file_base
;
774 withs
[with_len
].limited
= limited_access
;
778 /* Reset "with" clauses. */
781 reset_ada_withs (void)
788 for (i
= 0; i
< with_len
; i
++)
796 /* Dump "with" clauses in F. */
799 dump_ada_withs (FILE *f
)
803 fprintf (f
, "with Interfaces.C; use Interfaces.C;\n");
805 for (i
= 0; i
< with_len
; i
++)
807 (f
, "%swith %s;\n", withs
[i
].limited
? "limited " : "", withs
[i
].s
);
810 /* Return suitable Ada package name from FILE. */
813 get_ada_package (const char *file
)
820 s
= strstr (file
, "/include/");
824 base
= lbasename (file
);
825 res
= XNEWVEC (char, strlen (base
) + 1);
827 for (i
= 0; *base
; base
++, i
++)
839 res
[i
] = (i
== 0 || res
[i
- 1] == '_') ? 'u' : '_';
851 static const char *ada_reserved
[] = {
852 "abort", "abs", "abstract", "accept", "access", "aliased", "all", "and",
853 "array", "at", "begin", "body", "case", "constant", "declare", "delay",
854 "delta", "digits", "do", "else", "elsif", "end", "entry", "exception",
855 "exit", "for", "function", "generic", "goto", "if", "in", "interface", "is",
856 "limited", "loop", "mod", "new", "not", "null", "others", "out", "of", "or",
857 "overriding", "package", "pragma", "private", "procedure", "protected",
858 "raise", "range", "record", "rem", "renames", "requeue", "return", "reverse",
859 "select", "separate", "subtype", "synchronized", "tagged", "task",
860 "terminate", "then", "type", "until", "use", "when", "while", "with", "xor",
863 /* ??? would be nice to specify this list via a config file, so that users
864 can create their own dictionary of conflicts. */
865 static const char *c_duplicates
[] = {
866 /* system will cause troubles with System.Address. */
869 /* The following values have other definitions with same name/other
875 "rl_readline_version",
881 /* Return a declaration tree corresponding to TYPE. */
884 get_underlying_decl (tree type
)
886 tree decl
= NULL_TREE
;
888 if (type
== NULL_TREE
)
891 /* type is a declaration. */
895 /* type is a typedef. */
896 if (TYPE_P (type
) && TYPE_NAME (type
) && DECL_P (TYPE_NAME (type
)))
897 decl
= TYPE_NAME (type
);
899 /* TYPE_STUB_DECL has been set for type. */
900 if (TYPE_P (type
) && TYPE_STUB_DECL (type
) &&
901 DECL_P (TYPE_STUB_DECL (type
)))
902 decl
= TYPE_STUB_DECL (type
);
907 /* Return whether TYPE has static fields. */
910 has_static_fields (const_tree type
)
914 for (tmp
= TYPE_FIELDS (type
); tmp
; tmp
= TREE_CHAIN (tmp
))
916 if (DECL_NAME (tmp
) && TREE_STATIC (tmp
))
922 /* Return whether TYPE corresponds to an Ada tagged type (has a dispatch
926 is_tagged_type (const_tree type
)
930 if (!type
|| !RECORD_OR_UNION_TYPE_P (type
))
933 for (tmp
= TYPE_METHODS (type
); tmp
; tmp
= TREE_CHAIN (tmp
))
934 if (DECL_VINDEX (tmp
))
940 /* Generate a legal Ada name from a C NAME, returning a malloc'd string.
941 SPACE_FOUND, if not NULL, is used to indicate whether a space was found in
945 to_ada_name (const char *name
, int *space_found
)
948 int len
= strlen (name
);
951 char *s
= XNEWVEC (char, len
* 2 + 5);
955 *space_found
= false;
957 /* Add trailing "c_" if name is an Ada reserved word. */
958 for (names
= ada_reserved
; *names
; names
++)
959 if (!strcasecmp (name
, *names
))
968 /* Add trailing "c_" if name is an potential case sensitive duplicate. */
969 for (names
= c_duplicates
; *names
; names
++)
970 if (!strcmp (name
, *names
))
978 for (j
= 0; name
[j
] == '_'; j
++)
983 else if (*name
== '.' || *name
== '$')
993 /* Replace unsuitable characters for Ada identifiers. */
1000 *space_found
= true;
1004 /* ??? missing some C++ operators. */
1008 if (name
[j
+ 1] == '=')
1023 if (name
[j
+ 1] == '=')
1041 s
[len2
++] = name
[j
] == '&' ? 'a' : name
[j
] == '|' ? 'o' : 'x';
1043 if (name
[j
+ 1] == '=')
1056 if (s
[len2
- 1] != '_')
1059 switch (name
[j
+ 1]) {
1062 switch (name
[j
- 1]) {
1063 case '+': s
[len2
++] = 'p'; break; /* + */
1064 case '-': s
[len2
++] = 'm'; break; /* - */
1065 case '*': s
[len2
++] = 't'; break; /* * */
1066 case '/': s
[len2
++] = 'd'; break; /* / */
1072 switch (name
[j
- 1]) {
1073 case '+': s
[len2
++] = 'p'; break; /* += */
1074 case '-': s
[len2
++] = 'm'; break; /* -= */
1075 case '*': s
[len2
++] = 't'; break; /* *= */
1076 case '/': s
[len2
++] = 'd'; break; /* /= */
1110 c
= name
[j
] == '<' ? 'l' : 'g';
1113 switch (name
[j
+ 1]) {
1139 if (len2
&& s
[len2
- 1] == '_')
1144 s
[len2
++] = name
[j
];
1147 if (s
[len2
- 1] == '_')
1155 static bool package_prefix
= true;
1157 /* Dump in BUFFER the name of an identifier NODE of type TYPE, following Ada
1158 syntax. LIMITED_ACCESS indicates whether NODE can be accessed via a limited
1159 'with' clause rather than a regular 'with' clause. */
1162 pp_ada_tree_identifier (pretty_printer
*buffer
, tree node
, tree type
,
1165 const char *name
= IDENTIFIER_POINTER (node
);
1166 int space_found
= false;
1167 char *s
= to_ada_name (name
, &space_found
);
1170 /* If the entity is a type and comes from another file, generate "package"
1173 decl
= get_underlying_decl (type
);
1177 expanded_location xloc
= expand_location (decl_sloc (decl
, false));
1179 if (xloc
.file
&& xloc
.line
)
1181 if (xloc
.file
!= source_file_base
)
1183 switch (TREE_CODE (type
))
1188 case FIXED_POINT_TYPE
:
1190 case REFERENCE_TYPE
:
1195 case QUAL_UNION_TYPE
:
1198 char *s1
= get_ada_package (xloc
.file
);
1202 append_withs (s1
, limited_access
);
1203 pp_string (buffer
, s1
);
1204 pp_character (buffer
, '.');
1217 if (!strcmp (s
, "short_int"))
1218 pp_string (buffer
, "short");
1219 else if (!strcmp (s
, "short_unsigned_int"))
1220 pp_string (buffer
, "unsigned_short");
1221 else if (!strcmp (s
, "unsigned_int"))
1222 pp_string (buffer
, "unsigned");
1223 else if (!strcmp (s
, "long_int"))
1224 pp_string (buffer
, "long");
1225 else if (!strcmp (s
, "long_unsigned_int"))
1226 pp_string (buffer
, "unsigned_long");
1227 else if (!strcmp (s
, "long_long_int"))
1228 pp_string (buffer
, "Long_Long_Integer");
1229 else if (!strcmp (s
, "long_long_unsigned_int"))
1233 append_withs ("Interfaces.C.Extensions", false);
1234 pp_string (buffer
, "Extensions.unsigned_long_long");
1237 pp_string (buffer
, "unsigned_long_long");
1240 pp_string(buffer
, s
);
1242 if (!strcmp (s
, "bool"))
1246 append_withs ("Interfaces.C.Extensions", false);
1247 pp_string (buffer
, "Extensions.bool");
1250 pp_string (buffer
, "bool");
1253 pp_string(buffer
, s
);
1258 /* Dump in BUFFER the assembly name of T. */
1261 pp_asm_name (pretty_printer
*buffer
, tree t
)
1263 tree name
= DECL_ASSEMBLER_NAME (t
);
1264 char *ada_name
= XALLOCAVEC (char, IDENTIFIER_LENGTH (name
) + 1), *s
;
1265 const char *ident
= IDENTIFIER_POINTER (name
);
1267 for (s
= ada_name
; *ident
; ident
++)
1271 else if (*ident
!= '*')
1276 pp_string (buffer
, ada_name
);
1279 /* Dump in BUFFER the name of a DECL node if set, following Ada syntax.
1280 LIMITED_ACCESS indicates whether NODE can be accessed via a limited
1281 'with' clause rather than a regular 'with' clause. */
1284 dump_ada_decl_name (pretty_printer
*buffer
, tree decl
, int limited_access
)
1286 if (DECL_NAME (decl
))
1287 pp_ada_tree_identifier (buffer
, DECL_NAME (decl
), decl
, limited_access
);
1290 tree type_name
= TYPE_NAME (TREE_TYPE (decl
));
1294 pp_string (buffer
, "anon");
1295 if (TREE_CODE (decl
) == FIELD_DECL
)
1296 pp_scalar (buffer
, "%d", DECL_UID (decl
));
1298 pp_scalar (buffer
, "%d", TYPE_UID (TREE_TYPE (decl
)));
1300 else if (TREE_CODE (type_name
) == IDENTIFIER_NODE
)
1301 pp_ada_tree_identifier (buffer
, type_name
, decl
, limited_access
);
1305 /* Dump in BUFFER a name based on both T1 and T2, followed by S. */
1308 dump_ada_double_name (pretty_printer
*buffer
, tree t1
, tree t2
, const char *s
)
1311 pp_ada_tree_identifier (buffer
, DECL_NAME (t1
), t1
, false);
1314 pp_string (buffer
, "anon");
1315 pp_scalar (buffer
, "%d", TYPE_UID (TREE_TYPE (t1
)));
1318 pp_character (buffer
, '_');
1321 pp_ada_tree_identifier (buffer
, DECL_NAME (t2
), t2
, false);
1324 pp_string (buffer
, "anon");
1325 pp_scalar (buffer
, "%d", TYPE_UID (TREE_TYPE (t2
)));
1328 pp_string (buffer
, s
);
1331 /* Dump in BUFFER pragma Import C/CPP on a given node T. */
1334 dump_ada_import (pretty_printer
*buffer
, tree t
)
1336 const char *name
= IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (t
));
1337 int is_stdcall
= TREE_CODE (t
) == FUNCTION_DECL
&&
1338 lookup_attribute ("stdcall", TYPE_ATTRIBUTES (TREE_TYPE (t
)));
1341 pp_string (buffer
, "pragma Import (Stdcall, ");
1342 else if (name
[0] == '_' && name
[1] == 'Z')
1343 pp_string (buffer
, "pragma Import (CPP, ");
1345 pp_string (buffer
, "pragma Import (C, ");
1347 dump_ada_decl_name (buffer
, t
, false);
1348 pp_string (buffer
, ", \"");
1351 pp_string (buffer
, IDENTIFIER_POINTER (DECL_NAME (t
)));
1353 pp_asm_name (buffer
, t
);
1355 pp_string (buffer
, "\");");
1358 /* Check whether T and its type have different names, and append "the_"
1359 otherwise in BUFFER. */
1362 check_name (pretty_printer
*buffer
, tree t
)
1365 tree tmp
= TREE_TYPE (t
);
1367 while (TREE_CODE (tmp
) == POINTER_TYPE
&& !TYPE_NAME (tmp
))
1368 tmp
= TREE_TYPE (tmp
);
1370 if (TREE_CODE (tmp
) != FUNCTION_TYPE
)
1372 if (TREE_CODE (tmp
) == IDENTIFIER_NODE
)
1373 s
= IDENTIFIER_POINTER (tmp
);
1374 else if (!TYPE_NAME (tmp
))
1376 else if (TREE_CODE (TYPE_NAME (tmp
)) == IDENTIFIER_NODE
)
1377 s
= IDENTIFIER_POINTER (TYPE_NAME (tmp
));
1379 s
= IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp
)));
1381 if (!strcasecmp (IDENTIFIER_POINTER (DECL_NAME (t
)), s
))
1382 pp_string (buffer
, "the_");
1386 /* Dump in BUFFER a function declaration FUNC with Ada syntax.
1387 IS_METHOD indicates whether FUNC is a C++ method.
1388 IS_CONSTRUCTOR whether FUNC is a C++ constructor.
1389 IS_DESTRUCTOR whether FUNC is a C++ destructor.
1390 SPC is the current indentation level. */
1393 dump_ada_function_declaration (pretty_printer
*buffer
, tree func
,
1394 int is_method
, int is_constructor
,
1395 int is_destructor
, int spc
)
1398 const tree node
= TREE_TYPE (func
);
1400 int num
= 0, num_args
= 0, have_args
= true, have_ellipsis
= false;
1402 /* Compute number of arguments. */
1403 arg
= TYPE_ARG_TYPES (node
);
1407 while (TREE_CHAIN (arg
) && arg
!= error_mark_node
)
1410 arg
= TREE_CHAIN (arg
);
1413 if (TREE_CODE (TREE_VALUE (arg
)) != VOID_TYPE
)
1416 have_ellipsis
= true;
1427 newline_and_indent (buffer
, spc
+ 1);
1432 pp_character (buffer
, '(');
1435 if (TREE_CODE (func
) == FUNCTION_DECL
)
1436 arg
= DECL_ARGUMENTS (func
);
1440 if (arg
== NULL_TREE
)
1443 arg
= TYPE_ARG_TYPES (node
);
1445 if (arg
&& TREE_CODE (TREE_VALUE (arg
)) == VOID_TYPE
)
1450 arg
= TREE_CHAIN (arg
);
1452 /* Print the argument names (if available) & types. */
1454 for (num
= 1; num
<= num_args
; num
++)
1458 if (DECL_NAME (arg
))
1460 check_name (buffer
, arg
);
1461 pp_ada_tree_identifier (buffer
, DECL_NAME (arg
), 0, false);
1462 pp_string (buffer
, " : ");
1466 sprintf (buf
, "arg%d : ", num
);
1467 pp_string (buffer
, buf
);
1470 dump_generic_ada_node
1471 (buffer
, TREE_TYPE (arg
), node
, NULL
, spc
, 0, true);
1475 sprintf (buf
, "arg%d : ", num
);
1476 pp_string (buffer
, buf
);
1477 dump_generic_ada_node
1478 (buffer
, TREE_VALUE (arg
), node
, NULL
, spc
, 0, true);
1481 if (TREE_TYPE (arg
) && TREE_TYPE (TREE_TYPE (arg
))
1482 && is_tagged_type (TREE_TYPE (TREE_TYPE (arg
))))
1485 || (num
!= 1 || (!DECL_VINDEX (func
) && !is_constructor
)))
1486 pp_string (buffer
, "'Class");
1489 arg
= TREE_CHAIN (arg
);
1493 pp_character (buffer
, ';');
1496 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
1504 pp_string (buffer
, " -- , ...");
1505 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
1509 pp_character (buffer
, ')');
1513 /* Dump in BUFFER all the domains associated with an array NODE,
1514 using Ada syntax. SPC is the current indentation level. */
1517 dump_ada_array_domains (pretty_printer
*buffer
, tree node
, int spc
)
1520 pp_character (buffer
, '(');
1522 for (; TREE_CODE (node
) == ARRAY_TYPE
; node
= TREE_TYPE (node
))
1524 tree domain
= TYPE_DOMAIN (node
);
1528 tree min
= TYPE_MIN_VALUE (domain
);
1529 tree max
= TYPE_MAX_VALUE (domain
);
1532 pp_string (buffer
, ", ");
1536 dump_generic_ada_node (buffer
, min
, NULL_TREE
, NULL
, spc
, 0, true);
1537 pp_string (buffer
, " .. ");
1539 /* If the upper bound is zero, gcc may generate a NULL_TREE
1540 for TYPE_MAX_VALUE rather than an integer_cst. */
1542 dump_generic_ada_node (buffer
, max
, NULL_TREE
, NULL
, spc
, 0, true);
1544 pp_string (buffer
, "0");
1547 pp_string (buffer
, "size_t");
1549 pp_character (buffer
, ')');
1552 /* Dump in BUFFER file:line information related to NODE. */
1555 dump_sloc (pretty_printer
*buffer
, tree node
)
1557 expanded_location xloc
;
1561 if (TREE_CODE_CLASS (TREE_CODE (node
)) == tcc_declaration
)
1562 xloc
= expand_location (DECL_SOURCE_LOCATION (node
));
1563 else if (EXPR_HAS_LOCATION (node
))
1564 xloc
= expand_location (EXPR_LOCATION (node
));
1568 pp_string (buffer
, xloc
.file
);
1569 pp_string (buffer
, ":");
1570 pp_decimal_int (buffer
, xloc
.line
);
1574 /* Return true if T designates a one dimension array of "char". */
1577 is_char_array (tree t
)
1582 /* Retrieve array's type. */
1584 while (TREE_CODE (TREE_TYPE (tmp
)) == ARRAY_TYPE
)
1587 tmp
= TREE_TYPE (tmp
);
1590 tmp
= TREE_TYPE (tmp
);
1591 return num_dim
== 1 && TREE_CODE (tmp
) == INTEGER_TYPE
1592 && !strcmp (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (tmp
))), "char");
1595 /* Dump in BUFFER an array type T in Ada syntax. Assume that the "type"
1596 keyword and name have already been printed. SPC is the indentation
1600 dump_ada_array_type (pretty_printer
*buffer
, tree t
, int spc
)
1603 bool char_array
= is_char_array (t
);
1605 /* Special case char arrays. */
1608 pp_string (buffer
, "Interfaces.C.char_array ");
1611 pp_string (buffer
, "array ");
1613 /* Print the dimensions. */
1614 dump_ada_array_domains (buffer
, TREE_TYPE (t
), spc
);
1616 /* Retrieve array's type. */
1617 tmp
= TREE_TYPE (t
);
1618 while (TREE_CODE (TREE_TYPE (tmp
)) == ARRAY_TYPE
)
1619 tmp
= TREE_TYPE (tmp
);
1621 /* Print array's type. */
1624 pp_string (buffer
, " of ");
1626 if (TREE_CODE (TREE_TYPE (tmp
)) != POINTER_TYPE
)
1627 pp_string (buffer
, "aliased ");
1629 dump_generic_ada_node
1630 (buffer
, TREE_TYPE (tmp
), TREE_TYPE (t
), NULL
, spc
, false, true);
1634 /* Dump in BUFFER type names associated with a template, each prepended with
1635 '_'. TYPES is the TREE_PURPOSE of a DECL_TEMPLATE_INSTANTIATIONS.
1636 CPP_CHECK is used to perform C++ queries on nodes.
1637 SPC is the indentation level. */
1640 dump_template_types (pretty_printer
*buffer
, tree types
,
1641 int (*cpp_check
)(tree
, cpp_operation
), int spc
)
1644 size_t len
= TREE_VEC_LENGTH (types
);
1646 for (i
= 0; i
< len
; i
++)
1648 tree elem
= TREE_VEC_ELT (types
, i
);
1649 pp_character (buffer
, '_');
1650 if (!dump_generic_ada_node (buffer
, elem
, 0, cpp_check
, spc
, false, true))
1652 pp_string (buffer
, "unknown");
1653 pp_scalar (buffer
, "%lu", (unsigned long) TREE_HASH (elem
));
1658 /* Dump in BUFFER the contents of all instantiations associated with a given
1659 template T. CPP_CHECK is used to perform C++ queries on nodes.
1660 SPC is the indentation level. */
1663 dump_ada_template (pretty_printer
*buffer
, tree t
,
1664 int (*cpp_check
)(tree
, cpp_operation
), int spc
)
1666 tree inst
= DECL_VINDEX (t
);
1667 /* DECL_VINDEX is DECL_TEMPLATE_INSTANTIATIONS in this context. */
1670 while (inst
&& inst
!= error_mark_node
)
1672 tree types
= TREE_PURPOSE (inst
);
1673 tree instance
= TREE_VALUE (inst
);
1675 if (TREE_VEC_LENGTH (types
) == 0)
1678 if (!TYPE_METHODS (instance
))
1683 pp_string (buffer
, "package ");
1684 package_prefix
= false;
1685 dump_generic_ada_node (buffer
, instance
, t
, cpp_check
, spc
, false, true);
1686 dump_template_types (buffer
, types
, cpp_check
, spc
);
1687 pp_string (buffer
, " is");
1689 newline_and_indent (buffer
, spc
);
1691 TREE_VISITED (get_underlying_decl (instance
)) = 1;
1692 pp_string (buffer
, "type ");
1693 dump_generic_ada_node (buffer
, instance
, t
, cpp_check
, spc
, false, true);
1694 package_prefix
= true;
1696 if (is_tagged_type (instance
))
1697 pp_string (buffer
, " is tagged limited ");
1699 pp_string (buffer
, " is limited ");
1701 dump_generic_ada_node (buffer
, instance
, t
, cpp_check
, spc
, false, false);
1702 pp_newline (buffer
);
1704 newline_and_indent (buffer
, spc
);
1706 pp_string (buffer
, "end;");
1707 newline_and_indent (buffer
, spc
);
1708 pp_string (buffer
, "use ");
1709 package_prefix
= false;
1710 dump_generic_ada_node (buffer
, instance
, t
, cpp_check
, spc
, false, true);
1711 dump_template_types (buffer
, types
, cpp_check
, spc
);
1712 package_prefix
= true;
1713 pp_semicolon (buffer
);
1714 pp_newline (buffer
);
1715 pp_newline (buffer
);
1717 inst
= TREE_CHAIN (inst
);
1720 return num_inst
> 0;
1723 /* Return true if NODE is a simple enum types, that can be mapped to an
1724 Ada enum type directly. */
1727 is_simple_enum (tree node
)
1729 unsigned HOST_WIDE_INT count
= 0;
1732 for (value
= TYPE_VALUES (node
); value
; value
= TREE_CHAIN (value
))
1734 tree int_val
= TREE_VALUE (value
);
1736 if (TREE_CODE (int_val
) != INTEGER_CST
)
1737 int_val
= DECL_INITIAL (int_val
);
1739 if (!host_integerp (int_val
, 0))
1741 else if (TREE_INT_CST_LOW (int_val
) != count
)
1750 static bool in_function
= true;
1751 static bool bitfield_used
= false;
1753 /* Recursively dump in BUFFER Ada declarations corresponding to NODE of type
1754 TYPE. CPP_CHECK is used to perform C++ queries on nodes. SPC is the
1755 indentation level. LIMITED_ACCESS indicates whether NODE can be referenced
1756 via a "limited with" clause. NAME_ONLY indicates whether we should only
1757 dump the name of NODE, instead of its full declaration. */
1760 dump_generic_ada_node (pretty_printer
*buffer
, tree node
, tree type
,
1761 int (*cpp_check
)(tree
, cpp_operation
), int spc
,
1762 int limited_access
, bool name_only
)
1764 if (node
== NULL_TREE
)
1767 switch (TREE_CODE (node
))
1770 pp_string (buffer
, "<<< error >>>");
1773 case IDENTIFIER_NODE
:
1774 pp_ada_tree_identifier (buffer
, node
, type
, limited_access
);
1778 pp_string (buffer
, "--- unexpected node: TREE_LIST");
1782 dump_generic_ada_node
1783 (buffer
, BINFO_TYPE (node
), type
, cpp_check
,
1784 spc
, limited_access
, name_only
);
1787 pp_string (buffer
, "--- unexpected node: TREE_VEC");
1793 append_withs ("System", false);
1794 pp_string (buffer
, "System.Address");
1797 pp_string (buffer
, "address");
1801 pp_string (buffer
, "<vector>");
1805 pp_string (buffer
, "<complex>");
1810 dump_generic_ada_node
1811 (buffer
, TYPE_NAME (node
), node
, cpp_check
, spc
, 0, true);
1814 tree value
= TYPE_VALUES (node
);
1816 if (is_simple_enum (node
))
1820 newline_and_indent (buffer
, spc
- 1);
1821 pp_string (buffer
, "(");
1822 for (; value
; value
= TREE_CHAIN (value
))
1828 pp_string (buffer
, ",");
1829 newline_and_indent (buffer
, spc
);
1832 pp_ada_tree_identifier
1833 (buffer
, TREE_PURPOSE (value
), node
, false);
1835 pp_string (buffer
, ");");
1837 newline_and_indent (buffer
, spc
);
1838 pp_string (buffer
, "pragma Convention (C, ");
1839 dump_generic_ada_node
1840 (buffer
, DECL_NAME (type
) ? type
: TYPE_NAME (node
), type
,
1841 cpp_check
, spc
, 0, true);
1842 pp_string (buffer
, ")");
1846 pp_string (buffer
, "unsigned");
1847 for (; value
; value
= TREE_CHAIN (value
))
1849 pp_semicolon (buffer
);
1850 newline_and_indent (buffer
, spc
);
1852 pp_ada_tree_identifier
1853 (buffer
, TREE_PURPOSE (value
), node
, false);
1854 pp_string (buffer
, " : constant ");
1856 dump_generic_ada_node
1857 (buffer
, DECL_NAME (type
) ? type
: TYPE_NAME (node
), type
,
1858 cpp_check
, spc
, 0, true);
1860 pp_string (buffer
, " := ");
1861 dump_generic_ada_node
1863 TREE_CODE (TREE_VALUE (value
)) == INTEGER_CST
?
1864 TREE_VALUE (value
) : DECL_INITIAL (TREE_VALUE (value
)),
1865 node
, cpp_check
, spc
, false, true);
1873 case FIXED_POINT_TYPE
:
1876 enum tree_code_class tclass
;
1878 tclass
= TREE_CODE_CLASS (TREE_CODE (node
));
1880 if (tclass
== tcc_declaration
)
1882 if (DECL_NAME (node
))
1883 pp_ada_tree_identifier
1884 (buffer
, DECL_NAME (node
), 0, limited_access
);
1886 pp_string (buffer
, "<unnamed type decl>");
1888 else if (tclass
== tcc_type
)
1890 if (TYPE_NAME (node
))
1892 if (TREE_CODE (TYPE_NAME (node
)) == IDENTIFIER_NODE
)
1893 pp_ada_tree_identifier (buffer
, TYPE_NAME (node
),
1894 node
, limited_access
);
1895 else if (TREE_CODE (TYPE_NAME (node
)) == TYPE_DECL
1896 && DECL_NAME (TYPE_NAME (node
)))
1897 dump_ada_decl_name (buffer
, TYPE_NAME (node
), limited_access
);
1899 pp_string (buffer
, "<unnamed type>");
1901 else if (TREE_CODE (node
) == INTEGER_TYPE
)
1903 append_withs ("Interfaces.C.Extensions", false);
1904 bitfield_used
= true;
1906 if (TYPE_PRECISION (node
) == 1)
1907 pp_string (buffer
, "Extensions.Unsigned_1");
1910 pp_string (buffer
, (TYPE_UNSIGNED (node
)
1911 ? "Extensions.Unsigned_"
1912 : "Extensions.Signed_"));
1913 pp_decimal_int (buffer
, TYPE_PRECISION (node
));
1917 pp_string (buffer
, "<unnamed type>");
1923 case REFERENCE_TYPE
:
1924 if (TREE_CODE (TREE_TYPE (node
)) == FUNCTION_TYPE
)
1926 tree fnode
= TREE_TYPE (node
);
1928 bool prev_in_function
= in_function
;
1930 if (VOID_TYPE_P (TREE_TYPE (fnode
)))
1932 is_function
= false;
1933 pp_string (buffer
, "access procedure");
1938 pp_string (buffer
, "access function");
1941 in_function
= is_function
;
1942 dump_ada_function_declaration
1943 (buffer
, node
, false, false, false, spc
+ INDENT_INCR
);
1944 in_function
= prev_in_function
;
1948 pp_string (buffer
, " return ");
1949 dump_generic_ada_node
1950 (buffer
, TREE_TYPE (fnode
), type
, cpp_check
, spc
, 0, true);
1955 int is_access
= false;
1956 unsigned int quals
= TYPE_QUALS (TREE_TYPE (node
));
1958 if (name_only
&& TYPE_NAME (node
))
1959 dump_generic_ada_node
1960 (buffer
, TYPE_NAME (node
), node
, cpp_check
,
1961 spc
, limited_access
, true);
1962 else if (VOID_TYPE_P (TREE_TYPE (node
)))
1965 pp_string (buffer
, "new ");
1968 append_withs ("System", false);
1969 pp_string (buffer
, "System.Address");
1972 pp_string (buffer
, "address");
1976 if (TREE_CODE (node
) == POINTER_TYPE
1977 && TREE_CODE (TREE_TYPE (node
)) == INTEGER_TYPE
1979 (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME
1980 (TREE_TYPE (node
)))), "char"))
1983 pp_string (buffer
, "new ");
1987 pp_string (buffer
, "Interfaces.C.Strings.chars_ptr");
1988 append_withs ("Interfaces.C.Strings", false);
1991 pp_string (buffer
, "chars_ptr");
1995 /* For now, handle all access-to-access or
1996 access-to-unknown-structs as opaque system.address. */
1998 tree type_name
= TYPE_NAME (TREE_TYPE (node
));
1999 const_tree typ2
= !type
||
2000 DECL_P (type
) ? type
: TYPE_NAME (type
);
2001 const_tree underlying_type
=
2002 get_underlying_decl (TREE_TYPE (node
));
2004 if (TREE_CODE (TREE_TYPE (node
)) == POINTER_TYPE
2005 /* Pointer to pointer. */
2007 || (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node
))
2008 && (!underlying_type
2009 || !TYPE_FIELDS (TREE_TYPE (underlying_type
))))
2010 /* Pointer to opaque structure. */
2013 && !TREE_VISITED (underlying_type
)
2014 && !TREE_VISITED (type_name
)
2015 && !is_tagged_type (TREE_TYPE (node
))
2016 && DECL_SOURCE_FILE (underlying_type
)
2017 == source_file_base
)
2018 || (type_name
&& typ2
2019 && DECL_P (underlying_type
)
2021 && decl_sloc (underlying_type
, true)
2022 > decl_sloc (typ2
, true)
2023 && DECL_SOURCE_FILE (underlying_type
)
2024 == DECL_SOURCE_FILE (typ2
)))
2028 append_withs ("System", false);
2030 pp_string (buffer
, "new ");
2031 pp_string (buffer
, "System.Address");
2034 pp_string (buffer
, "address");
2038 if (!package_prefix
)
2039 pp_string (buffer
, "access");
2040 else if (AGGREGATE_TYPE_P (TREE_TYPE (node
)))
2042 if (!type
|| TREE_CODE (type
) != FUNCTION_DECL
)
2044 pp_string (buffer
, "access ");
2047 if (quals
& TYPE_QUAL_CONST
)
2048 pp_string (buffer
, "constant ");
2049 else if (!name_only
)
2050 pp_string (buffer
, "all ");
2052 else if (quals
& TYPE_QUAL_CONST
)
2053 pp_string (buffer
, "in ");
2054 else if (in_function
)
2057 pp_string (buffer
, "access ");
2062 pp_string (buffer
, "access ");
2063 /* ??? should be configurable: access or in out. */
2069 pp_string (buffer
, "access ");
2072 pp_string (buffer
, "all ");
2075 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node
))
2076 && type_name
!= NULL_TREE
)
2077 dump_generic_ada_node
2079 TREE_TYPE (node
), cpp_check
, spc
, is_access
, true);
2081 dump_generic_ada_node
2082 (buffer
, TREE_TYPE (node
), TREE_TYPE (node
),
2083 cpp_check
, spc
, 0, true);
2091 dump_generic_ada_node
2092 (buffer
, TYPE_NAME (node
), node
, cpp_check
,
2093 spc
, limited_access
, true);
2095 dump_ada_array_type (buffer
, node
, spc
);
2100 case QUAL_UNION_TYPE
:
2103 if (TYPE_NAME (node
))
2104 dump_generic_ada_node
2105 (buffer
, TYPE_NAME (node
), node
, cpp_check
,
2106 spc
, limited_access
, true);
2109 pp_string (buffer
, "anon_");
2110 pp_scalar (buffer
, "%d", TYPE_UID (node
));
2114 print_ada_struct_decl
2115 (buffer
, node
, type
, cpp_check
, spc
, true);
2119 if (TREE_CODE (TREE_TYPE (node
)) == POINTER_TYPE
)
2121 pp_wide_integer (buffer
, TREE_INT_CST_LOW (node
));
2122 pp_string (buffer
, "B"); /* pseudo-unit */
2124 else if (!host_integerp (node
, 0))
2127 unsigned HOST_WIDE_INT low
= TREE_INT_CST_LOW (val
);
2128 HOST_WIDE_INT high
= TREE_INT_CST_HIGH (val
);
2130 if (tree_int_cst_sgn (val
) < 0)
2132 pp_character (buffer
, '-');
2133 high
= ~high
+ !low
;
2136 sprintf (pp_buffer (buffer
)->digit_buffer
,
2137 HOST_WIDE_INT_PRINT_DOUBLE_HEX
,
2138 (unsigned HOST_WIDE_INT
) high
, low
);
2139 pp_string (buffer
, pp_buffer (buffer
)->digit_buffer
);
2142 pp_wide_integer (buffer
, TREE_INT_CST_LOW (node
));
2154 dump_ada_decl_name (buffer
, node
, limited_access
);
2158 if (DECL_IS_BUILTIN (node
))
2160 /* Don't print the declaration of built-in types. */
2164 /* If we're in the middle of a declaration, defaults to
2168 append_withs ("System", false);
2169 pp_string (buffer
, "System.Address");
2172 pp_string (buffer
, "address");
2178 dump_ada_decl_name (buffer
, node
, limited_access
);
2181 if (is_tagged_type (TREE_TYPE (node
)))
2183 tree tmp
= TYPE_FIELDS (TREE_TYPE (node
));
2186 /* Look for ancestors. */
2187 for (; tmp
; tmp
= TREE_CHAIN (tmp
))
2189 if (!DECL_NAME (tmp
) && is_tagged_type (TREE_TYPE (tmp
)))
2193 pp_string (buffer
, "limited new ");
2197 pp_string (buffer
, " and ");
2200 (buffer
, TYPE_NAME (TREE_TYPE (tmp
)), false);
2204 pp_string (buffer
, first
? "tagged limited " : " with ");
2206 else if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node
))
2207 && TYPE_METHODS (TREE_TYPE (node
)))
2208 pp_string (buffer
, "limited ");
2210 dump_generic_ada_node
2211 (buffer
, TREE_TYPE (node
), type
, cpp_check
, spc
, false, false);
2218 case NAMESPACE_DECL
:
2219 dump_ada_decl_name (buffer
, node
, false);
2223 /* Ignore other nodes (e.g. expressions). */
2230 /* Dump in BUFFER NODE's methods. CPP_CHECK is used to perform C++ queries on
2231 nodes. SPC is the indentation level. */
2234 print_ada_methods (pretty_printer
*buffer
, tree node
,
2235 int (*cpp_check
)(tree
, cpp_operation
), int spc
)
2237 tree tmp
= TYPE_METHODS (node
);
2242 pp_semicolon (buffer
);
2244 for (; tmp
; tmp
= TREE_CHAIN (tmp
))
2248 pp_newline (buffer
);
2249 pp_newline (buffer
);
2251 res
= print_ada_declaration (buffer
, tmp
, node
, cpp_check
, spc
);
2256 /* Dump in BUFFER anonymous types nested inside T's definition.
2257 PARENT is the parent node of T.
2258 FORWARD indicates whether a forward declaration of T should be generated.
2259 CPP_CHECK is used to perform C++ queries on
2260 nodes. SPC is the indentation level. */
2263 dump_nested_types (pretty_printer
*buffer
, tree t
, tree parent
, bool forward
,
2264 int (*cpp_check
)(tree
, cpp_operation
), int spc
)
2266 tree field
, outer
, decl
;
2268 /* Avoid recursing over the same tree. */
2269 if (TREE_VISITED (t
))
2272 /* Find possible anonymous arrays/unions/structs recursively. */
2274 outer
= TREE_TYPE (t
);
2276 if (outer
== NULL_TREE
)
2281 pp_string (buffer
, "type ");
2282 dump_generic_ada_node
2283 (buffer
, t
, t
, cpp_check
, spc
, false, true);
2284 pp_semicolon (buffer
);
2285 newline_and_indent (buffer
, spc
);
2286 TREE_VISITED (t
) = 1;
2289 field
= TYPE_FIELDS (outer
);
2292 if ((TREE_TYPE (field
) != outer
2293 || (TREE_CODE (TREE_TYPE (field
)) == POINTER_TYPE
2294 && TREE_TYPE (TREE_TYPE (field
)) != outer
))
2295 && (!TYPE_NAME (TREE_TYPE (field
))
2296 || (TREE_CODE (field
) == TYPE_DECL
2297 && DECL_NAME (field
) != DECL_NAME (t
)
2298 && TYPE_NAME (TREE_TYPE (field
)) != TYPE_NAME (outer
))))
2300 switch (TREE_CODE (TREE_TYPE (field
)))
2303 decl
= TREE_TYPE (TREE_TYPE (field
));
2305 if (TREE_CODE (decl
) == FUNCTION_TYPE
)
2306 for (decl
= TREE_TYPE (decl
);
2307 decl
&& TREE_CODE (decl
) == POINTER_TYPE
;
2308 decl
= TREE_TYPE (decl
));
2310 decl
= get_underlying_decl (decl
);
2314 && decl_sloc (decl
, true) > decl_sloc (t
, true)
2315 && DECL_SOURCE_FILE (decl
) == DECL_SOURCE_FILE (t
)
2316 && !TREE_VISITED (decl
)
2317 && !DECL_IS_BUILTIN (decl
)
2318 && (!RECORD_OR_UNION_TYPE_P (TREE_TYPE (decl
))
2319 || TYPE_FIELDS (TREE_TYPE (decl
))))
2321 /* Generate forward declaration. */
2323 pp_string (buffer
, "type ");
2324 dump_generic_ada_node
2325 (buffer
, decl
, 0, cpp_check
, spc
, false, true);
2326 pp_semicolon (buffer
);
2327 newline_and_indent (buffer
, spc
);
2329 /* Ensure we do not generate duplicate forward
2330 declarations for this type. */
2331 TREE_VISITED (decl
) = 1;
2336 /* Special case char arrays. */
2337 if (is_char_array (field
))
2338 pp_string (buffer
, "sub");
2340 pp_string (buffer
, "type ");
2341 dump_ada_double_name (buffer
, parent
, field
, "_array is ");
2342 dump_ada_array_type (buffer
, field
, spc
);
2343 pp_semicolon (buffer
);
2344 newline_and_indent (buffer
, spc
);
2348 TREE_VISITED (t
) = 1;
2349 dump_nested_types (buffer
, field
, t
, false, cpp_check
, spc
);
2351 pp_string (buffer
, "type ");
2353 if (TYPE_NAME (TREE_TYPE (field
)))
2355 dump_generic_ada_node
2356 (buffer
, TYPE_NAME (TREE_TYPE (field
)), 0, cpp_check
,
2358 pp_string (buffer
, " (discr : unsigned := 0) is ");
2359 print_ada_struct_decl
2360 (buffer
, TREE_TYPE (field
), t
, cpp_check
, spc
, false);
2362 pp_string (buffer
, "pragma Convention (C_Pass_By_Copy, ");
2363 dump_generic_ada_node
2364 (buffer
, TREE_TYPE (field
), 0, cpp_check
,
2366 pp_string (buffer
, ");");
2367 newline_and_indent (buffer
, spc
);
2369 pp_string (buffer
, "pragma Unchecked_Union (");
2370 dump_generic_ada_node
2371 (buffer
, TREE_TYPE (field
), 0, cpp_check
,
2373 pp_string (buffer
, ");");
2377 dump_ada_double_name
2378 (buffer
, parent
, field
,
2379 "_union (discr : unsigned := 0) is ");
2380 print_ada_struct_decl
2381 (buffer
, TREE_TYPE (field
), t
, cpp_check
, spc
, false);
2382 pp_string (buffer
, "pragma Convention (C_Pass_By_Copy, ");
2383 dump_ada_double_name (buffer
, parent
, field
, "_union);");
2384 newline_and_indent (buffer
, spc
);
2386 pp_string (buffer
, "pragma Unchecked_Union (");
2387 dump_ada_double_name (buffer
, parent
, field
, "_union);");
2390 newline_and_indent (buffer
, spc
);
2394 if (TYPE_NAME (TREE_TYPE (t
)) && !TREE_VISITED (t
))
2396 pp_string (buffer
, "type ");
2397 dump_generic_ada_node
2398 (buffer
, t
, parent
, 0, spc
, false, true);
2399 pp_semicolon (buffer
);
2400 newline_and_indent (buffer
, spc
);
2403 TREE_VISITED (t
) = 1;
2404 dump_nested_types (buffer
, field
, t
, false, cpp_check
, spc
);
2405 pp_string (buffer
, "type ");
2407 if (TYPE_NAME (TREE_TYPE (field
)))
2409 dump_generic_ada_node
2410 (buffer
, TREE_TYPE (field
), 0, cpp_check
,
2412 pp_string (buffer
, " is ");
2413 print_ada_struct_decl
2414 (buffer
, TREE_TYPE (field
), t
, cpp_check
, spc
, false);
2415 pp_string (buffer
, "pragma Convention (C_Pass_By_Copy, ");
2416 dump_generic_ada_node
2417 (buffer
, TREE_TYPE (field
), 0, cpp_check
,
2419 pp_string (buffer
, ");");
2423 dump_ada_double_name
2424 (buffer
, parent
, field
, "_struct is ");
2425 print_ada_struct_decl
2426 (buffer
, TREE_TYPE (field
), t
, cpp_check
, spc
, false);
2427 pp_string (buffer
, "pragma Convention (C_Pass_By_Copy, ");
2428 dump_ada_double_name (buffer
, parent
, field
, "_struct);");
2431 newline_and_indent (buffer
, spc
);
2438 field
= TREE_CHAIN (field
);
2441 TREE_VISITED (t
) = 1;
2444 /* Dump in BUFFER destructor spec corresponding to T. */
2447 print_destructor (pretty_printer
*buffer
, tree t
)
2449 const char *s
= IDENTIFIER_POINTER (DECL_NAME (t
));
2452 for (s
+= 2; *s
!= ' '; s
++)
2453 pp_character (buffer
, *s
);
2456 pp_string (buffer
, "Delete_");
2457 pp_ada_tree_identifier (buffer
, DECL_NAME (t
), t
, false);
2461 /* Return the name of type T. */
2466 tree n
= TYPE_NAME (t
);
2468 if (TREE_CODE (n
) == IDENTIFIER_NODE
)
2469 return IDENTIFIER_POINTER (n
);
2471 return IDENTIFIER_POINTER (DECL_NAME (n
));
2474 /* Print in BUFFER the declaration of a variable T of type TYPE in Ada syntax.
2475 CPP_CHECK is used to perform C++ queries on nodes. SPC is the indentation
2476 level. Return 1 if a declaration was printed, 0 otherwise. */
2479 print_ada_declaration (pretty_printer
*buffer
, tree t
, tree type
,
2480 int (*cpp_check
)(tree
, cpp_operation
), int spc
)
2482 int is_var
= 0, need_indent
= 0;
2483 int is_class
= false;
2484 tree name
= TYPE_NAME (TREE_TYPE (t
));
2485 tree decl_name
= DECL_NAME (t
);
2486 bool dump_internal
= get_dump_file_info (TDI_ada
)->flags
& TDF_RAW
;
2487 tree orig
= NULL_TREE
;
2489 if (cpp_check
&& cpp_check (t
, IS_TEMPLATE
))
2490 return dump_ada_template (buffer
, t
, cpp_check
, spc
);
2492 if (TREE_CODE (t
) == CONST_DECL
&& TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
)
2493 /* Skip enumeral values: will be handled as part of the type itself. */
2496 if (TREE_CODE (t
) == TYPE_DECL
)
2498 orig
= DECL_ORIGINAL_TYPE (t
);
2500 if (orig
&& TYPE_STUB_DECL (orig
))
2502 tree stub
= TYPE_STUB_DECL (orig
);
2503 tree typ
= TREE_TYPE (stub
);
2505 if (TYPE_NAME (typ
))
2507 /* If types have same representation, and same name (ignoring
2508 casing), then ignore the second type. */
2509 if (type_name (typ
) == type_name (TREE_TYPE (t
))
2510 || !strcasecmp (type_name (typ
), type_name (TREE_TYPE (t
))))
2515 if (RECORD_OR_UNION_TYPE_P (typ
) && !TYPE_FIELDS (typ
))
2517 pp_string (buffer
, "-- skipped empty struct ");
2518 dump_generic_ada_node (buffer
, t
, type
, 0, spc
, false, true);
2522 if (!TREE_VISITED (stub
)
2523 && DECL_SOURCE_FILE (stub
) == source_file_base
)
2525 (buffer
, stub
, stub
, true, cpp_check
, spc
);
2527 pp_string (buffer
, "subtype ");
2528 dump_generic_ada_node (buffer
, t
, type
, 0, spc
, false, true);
2529 pp_string (buffer
, " is ");
2530 dump_generic_ada_node
2531 (buffer
, typ
, type
, 0, spc
, false, true);
2532 pp_semicolon (buffer
);
2538 /* Skip unnamed or anonymous structs/unions/enum types. */
2539 if (!orig
&& !decl_name
&& !name
)
2544 if (cpp_check
|| TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
)
2547 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
)))
2549 /* Search next items until finding a named type decl. */
2550 sloc
= decl_sloc_common (t
, true, true);
2552 for (tmp
= TREE_CHAIN (t
); tmp
; tmp
= TREE_CHAIN (tmp
))
2554 if (TREE_CODE (tmp
) == TYPE_DECL
2555 && (DECL_NAME (tmp
) || TYPE_NAME (TREE_TYPE (tmp
))))
2557 /* If same sloc, it means we can ignore the anonymous
2559 if (decl_sloc_common (tmp
, true, true) == sloc
)
2571 && TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
2573 && (*IDENTIFIER_POINTER (decl_name
) == '.'
2574 || *IDENTIFIER_POINTER (decl_name
) == '$'))
2575 /* Skip anonymous enum types (duplicates of real types). */
2580 switch (TREE_CODE (TREE_TYPE (t
)))
2584 case QUAL_UNION_TYPE
:
2585 /* Skip empty structs (typically forward references to real
2587 if (!TYPE_FIELDS (TREE_TYPE (t
)))
2589 pp_string (buffer
, "-- skipped empty struct ");
2590 dump_generic_ada_node (buffer
, t
, type
, 0, spc
, false, true);
2595 && (*IDENTIFIER_POINTER (decl_name
) == '.'
2596 || *IDENTIFIER_POINTER (decl_name
) == '$'))
2598 pp_string (buffer
, "-- skipped anonymous struct ");
2599 dump_generic_ada_node (buffer
, t
, type
, 0, spc
, false, true);
2600 TREE_VISITED (t
) = 1;
2604 if (orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
2605 pp_string (buffer
, "subtype ");
2608 dump_nested_types (buffer
, t
, t
, false, cpp_check
, spc
);
2610 if (TYPE_METHODS (TREE_TYPE (t
))
2611 || has_static_fields (TREE_TYPE (t
)))
2614 pp_string (buffer
, "package Class_");
2615 dump_generic_ada_node
2616 (buffer
, t
, type
, 0, spc
, false, true);
2617 pp_string (buffer
, " is");
2619 newline_and_indent (buffer
, spc
);
2622 pp_string (buffer
, "type ");
2628 case REFERENCE_TYPE
:
2629 if ((orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
2630 || is_char_array (t
))
2631 pp_string (buffer
, "subtype ");
2633 pp_string (buffer
, "type ");
2637 pp_string (buffer
, "-- skipped function type ");
2638 dump_generic_ada_node (buffer
, t
, type
, 0, spc
, false, true);
2643 if ((orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
2644 || !is_simple_enum (TREE_TYPE (t
)))
2645 pp_string (buffer
, "subtype ");
2647 pp_string (buffer
, "type ");
2651 pp_string (buffer
, "subtype ");
2653 TREE_VISITED (t
) = 1;
2658 && TREE_CODE (t
) == VAR_DECL
2660 && *IDENTIFIER_POINTER (decl_name
) == '_')
2666 /* Print the type and name. */
2667 if (TREE_CODE (TREE_TYPE (t
)) == ARRAY_TYPE
)
2672 /* Print variable's name. */
2673 dump_generic_ada_node (buffer
, t
, type
, cpp_check
, spc
, false, true);
2675 if (TREE_CODE (t
) == TYPE_DECL
)
2677 pp_string (buffer
, " is ");
2679 if (orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
2680 dump_generic_ada_node
2681 (buffer
, TYPE_NAME (orig
), type
,
2682 cpp_check
, spc
, false, true);
2684 dump_ada_array_type (buffer
, t
, spc
);
2688 tree tmp
= TYPE_NAME (TREE_TYPE (t
));
2690 if (spc
== INDENT_INCR
|| TREE_STATIC (t
))
2693 pp_string (buffer
, " : ");
2697 if (TREE_CODE (TREE_TYPE (tmp
)) != POINTER_TYPE
2698 && TREE_CODE (tmp
) != INTEGER_TYPE
)
2699 pp_string (buffer
, "aliased ");
2701 dump_generic_ada_node (buffer
, tmp
, type
, 0, spc
, false, true);
2705 pp_string (buffer
, "aliased ");
2708 dump_ada_array_type (buffer
, t
, spc
);
2710 dump_ada_double_name (buffer
, type
, t
, "_array");
2714 else if (TREE_CODE (t
) == FUNCTION_DECL
)
2716 bool is_function
= true, is_method
, is_abstract_class
= false;
2717 tree decl_name
= DECL_NAME (t
);
2718 int prev_in_function
= in_function
;
2719 bool is_abstract
= false;
2720 bool is_constructor
= false;
2721 bool is_destructor
= false;
2722 bool is_copy_constructor
= false;
2729 is_abstract
= cpp_check (t
, IS_ABSTRACT
);
2730 is_constructor
= cpp_check (t
, IS_CONSTRUCTOR
);
2731 is_destructor
= cpp_check (t
, IS_DESTRUCTOR
);
2732 is_copy_constructor
= cpp_check (t
, IS_COPY_CONSTRUCTOR
);
2735 /* Skip __comp_dtor destructor which is redundant with the '~class()'
2738 && !strncmp (IDENTIFIER_POINTER (decl_name
), "__comp", 6))
2741 /* Skip copy constructors: some are internal only, and those that are
2742 not cannot be called easily from Ada anyway. */
2743 if (is_copy_constructor
)
2746 /* If this function has an entry in the dispatch table, we cannot
2748 if (!dump_internal
&& !DECL_VINDEX (t
)
2749 && *IDENTIFIER_POINTER (decl_name
) == '_')
2751 if (IDENTIFIER_POINTER (decl_name
)[1] == '_')
2755 pp_string (buffer
, "-- skipped func ");
2756 pp_string (buffer
, IDENTIFIER_POINTER (decl_name
));
2764 pp_string (buffer
, "function New_");
2765 else if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t
))))
2767 is_function
= false;
2768 pp_string (buffer
, "procedure ");
2771 pp_string (buffer
, "function ");
2773 in_function
= is_function
;
2774 is_method
= TREE_CODE (TREE_TYPE (t
)) == METHOD_TYPE
;
2777 print_destructor (buffer
, t
);
2779 dump_ada_decl_name (buffer
, t
, false);
2781 dump_ada_function_declaration
2782 (buffer
, t
, is_method
, is_constructor
, is_destructor
, spc
);
2783 in_function
= prev_in_function
;
2787 pp_string (buffer
, " return ");
2791 dump_ada_decl_name (buffer
, t
, false);
2795 dump_generic_ada_node
2796 (buffer
, TREE_TYPE (TREE_TYPE (t
)), type
, cpp_check
,
2801 if (is_constructor
&& cpp_check
&& type
2802 && AGGREGATE_TYPE_P (type
)
2803 && TYPE_METHODS (type
))
2805 tree tmp
= TYPE_METHODS (type
);
2807 for (; tmp
; tmp
= TREE_CHAIN (tmp
))
2808 if (cpp_check (tmp
, IS_ABSTRACT
))
2810 is_abstract_class
= 1;
2815 if (is_abstract
|| is_abstract_class
)
2816 pp_string (buffer
, " is abstract");
2818 pp_semicolon (buffer
);
2819 pp_string (buffer
, " -- ");
2820 dump_sloc (buffer
, t
);
2825 newline_and_indent (buffer
, spc
);
2829 pp_string (buffer
, "pragma CPP_Constructor (New_");
2830 dump_ada_decl_name (buffer
, t
, false);
2831 pp_string (buffer
, ", \"");
2832 pp_asm_name (buffer
, t
);
2833 pp_string (buffer
, "\");");
2835 else if (is_destructor
)
2837 pp_string (buffer
, "pragma Import (CPP, ");
2838 print_destructor (buffer
, t
);
2839 pp_string (buffer
, ", \"");
2840 pp_asm_name (buffer
, t
);
2841 pp_string (buffer
, "\");");
2845 dump_ada_import (buffer
, t
);
2850 else if (TREE_CODE (t
) == TYPE_DECL
&& !DECL_ORIGINAL_TYPE (t
))
2852 int is_interface
= 0;
2853 int is_abstract_record
= 0;
2858 /* Anonymous structs/unions */
2859 dump_generic_ada_node
2860 (buffer
, TREE_TYPE (t
), t
, cpp_check
, spc
, false, true);
2862 if (TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
2863 || TREE_CODE (TREE_TYPE (t
)) == QUAL_UNION_TYPE
)
2865 pp_string (buffer
, " (discr : unsigned := 0)");
2868 pp_string (buffer
, " is ");
2870 /* Check whether we have an Ada interface compatible class. */
2871 if (cpp_check
&& AGGREGATE_TYPE_P (TREE_TYPE (t
))
2872 && TYPE_METHODS (TREE_TYPE (t
)))
2875 tree tmp
= TYPE_FIELDS (TREE_TYPE (t
));
2877 /* Check that there are no fields other than the virtual table. */
2878 for (; tmp
; tmp
= TREE_CHAIN (tmp
))
2880 if (TREE_CODE (tmp
) == TYPE_DECL
)
2885 if (num_fields
== 1)
2888 /* Also check that there are only virtual methods. */
2889 for (tmp
= TYPE_METHODS (TREE_TYPE (t
)); tmp
; tmp
= TREE_CHAIN (tmp
))
2891 if (cpp_check (tmp
, IS_ABSTRACT
))
2892 is_abstract_record
= 1;
2898 TREE_VISITED (t
) = 1;
2901 pp_string (buffer
, "limited interface; -- ");
2902 dump_sloc (buffer
, t
);
2903 newline_and_indent (buffer
, spc
);
2904 pp_string (buffer
, "pragma Import (CPP, ");
2905 dump_generic_ada_node
2906 (buffer
, TYPE_NAME (TREE_TYPE (t
)), type
, cpp_check
,
2908 pp_character (buffer
, ')');
2910 print_ada_methods (buffer
, TREE_TYPE (t
), cpp_check
, spc
);
2914 if (is_abstract_record
)
2915 pp_string (buffer
, "abstract ");
2916 dump_generic_ada_node (buffer
, t
, t
, cpp_check
, spc
, false, false);
2924 if (TREE_CODE (t
) == FIELD_DECL
&& DECL_NAME (t
))
2925 check_name (buffer
, t
);
2927 /* Print variable/type's name. */
2928 dump_generic_ada_node (buffer
, t
, t
, cpp_check
, spc
, false, true);
2930 if (TREE_CODE (t
) == TYPE_DECL
)
2932 tree orig
= DECL_ORIGINAL_TYPE (t
);
2933 int is_subtype
= orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
);
2936 && (TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
2937 || TREE_CODE (TREE_TYPE (t
)) == QUAL_UNION_TYPE
))
2938 pp_string (buffer
, " (discr : unsigned := 0)");
2940 pp_string (buffer
, " is ");
2942 dump_generic_ada_node
2943 (buffer
, orig
, t
, cpp_check
, spc
, false, is_subtype
);
2947 if (spc
== INDENT_INCR
|| TREE_STATIC (t
))
2950 pp_string (buffer
, " : ");
2952 /* Print type declaration. */
2954 if (TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
2955 && !TYPE_NAME (TREE_TYPE (t
)))
2957 dump_ada_double_name (buffer
, type
, t
, "_union");
2959 else if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
)))
2961 if (TREE_CODE (TREE_TYPE (t
)) == RECORD_TYPE
)
2962 pp_string (buffer
, "aliased ");
2964 dump_generic_ada_node
2965 (buffer
, TREE_TYPE (t
), t
, cpp_check
, spc
, false, true);
2969 if (TREE_CODE (TREE_TYPE (t
)) != POINTER_TYPE
2970 && (TYPE_NAME (TREE_TYPE (t
))
2971 || TREE_CODE (TREE_TYPE (t
)) != INTEGER_TYPE
))
2972 pp_string (buffer
, "aliased ");
2974 dump_generic_ada_node
2975 (buffer
, TREE_TYPE (t
), TREE_TYPE (t
), cpp_check
,
2984 newline_and_indent (buffer
, spc
);
2985 pp_string (buffer
, "end;");
2986 newline_and_indent (buffer
, spc
);
2987 pp_string (buffer
, "use Class_");
2988 dump_generic_ada_node (buffer
, t
, type
, 0, spc
, false, true);
2989 pp_semicolon (buffer
);
2990 pp_newline (buffer
);
2992 /* All needed indentation/newline performed already, so return 0. */
2997 pp_string (buffer
, "; -- ");
2998 dump_sloc (buffer
, t
);
3003 newline_and_indent (buffer
, spc
);
3004 dump_ada_import (buffer
, t
);
3010 /* Prints in BUFFER a structure NODE of type TYPE: name, fields, and methods
3011 with Ada syntax. CPP_CHECK is used to perform C++ queries on nodes. SPC
3012 is the indentation level. If DISPLAY_CONVENTION is true, also print the
3013 pragma Convention for NODE. */
3016 print_ada_struct_decl (pretty_printer
*buffer
, tree node
, tree type
,
3017 int (*cpp_check
)(tree
, cpp_operation
), int spc
,
3018 bool display_convention
)
3022 TREE_CODE (node
) == UNION_TYPE
|| TREE_CODE (node
) == QUAL_UNION_TYPE
;
3025 int field_spc
= spc
+ INDENT_INCR
;
3028 bitfield_used
= false;
3030 if (!TYPE_FIELDS (node
))
3031 pp_string (buffer
, "null record;");
3034 pp_string (buffer
, "record");
3036 /* Print the contents of the structure. */
3040 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
3041 pp_string (buffer
, "case discr is");
3042 field_spc
= spc
+ INDENT_INCR
* 3;
3045 pp_newline (buffer
);
3047 /* Print the non-static fields of the structure. */
3048 for (tmp
= TYPE_FIELDS (node
); tmp
; tmp
= TREE_CHAIN (tmp
))
3050 /* Add parent field if needed. */
3051 if (!DECL_NAME (tmp
))
3053 if (!is_tagged_type (TREE_TYPE (tmp
)))
3055 if (!TYPE_NAME (TREE_TYPE (tmp
)))
3056 print_ada_declaration
3057 (buffer
, tmp
, type
, cpp_check
, field_spc
);
3063 pp_string (buffer
, "parent : ");
3066 sprintf (buf
, "field_%d : ", field_num
+ 1);
3067 pp_string (buffer
, buf
);
3070 (buffer
, TYPE_NAME (TREE_TYPE (tmp
)), false);
3071 pp_semicolon (buffer
);
3073 pp_newline (buffer
);
3077 /* Avoid printing the structure recursively. */
3078 else if ((TREE_TYPE (tmp
) != node
3079 || (TREE_CODE (TREE_TYPE (tmp
)) == POINTER_TYPE
3080 && TREE_TYPE (TREE_TYPE (tmp
)) != node
))
3081 && TREE_CODE (tmp
) != TYPE_DECL
3082 && !TREE_STATIC (tmp
))
3084 /* Skip internal virtual table field. */
3085 if (strncmp (IDENTIFIER_POINTER (DECL_NAME (tmp
)), "_vptr", 5))
3089 if (TREE_CHAIN (tmp
)
3090 && TREE_TYPE (TREE_CHAIN (tmp
)) != node
3091 && TREE_CODE (TREE_CHAIN (tmp
)) != TYPE_DECL
)
3092 sprintf (buf
, "when %d =>", field_num
);
3094 sprintf (buf
, "when others =>");
3096 INDENT (spc
+ INDENT_INCR
* 2);
3097 pp_string (buffer
, buf
);
3098 pp_newline (buffer
);
3101 if (print_ada_declaration (buffer
,
3102 tmp
, type
, cpp_check
, field_spc
))
3104 pp_newline (buffer
);
3113 INDENT (spc
+ INDENT_INCR
);
3114 pp_string (buffer
, "end case;");
3115 pp_newline (buffer
);
3120 INDENT (spc
+ INDENT_INCR
);
3121 pp_string (buffer
, "null;");
3122 pp_newline (buffer
);
3126 pp_string (buffer
, "end record;");
3129 newline_and_indent (buffer
, spc
);
3131 if (!display_convention
)
3134 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (type
)))
3136 if (TYPE_METHODS (TREE_TYPE (type
)))
3137 pp_string (buffer
, "pragma Import (CPP, ");
3139 pp_string (buffer
, "pragma Convention (C_Pass_By_Copy, ");
3142 pp_string (buffer
, "pragma Convention (C, ");
3144 package_prefix
= false;
3145 dump_generic_ada_node
3146 (buffer
, TREE_TYPE (type
), type
, cpp_check
, spc
, false, true);
3147 package_prefix
= true;
3148 pp_character (buffer
, ')');
3152 pp_semicolon (buffer
);
3153 newline_and_indent (buffer
, spc
);
3154 pp_string (buffer
, "pragma Unchecked_Union (");
3156 dump_generic_ada_node
3157 (buffer
, TREE_TYPE (type
), type
, cpp_check
, spc
, false, true);
3158 pp_character (buffer
, ')');
3163 pp_semicolon (buffer
);
3164 newline_and_indent (buffer
, spc
);
3165 pp_string (buffer
, "pragma Pack (");
3166 dump_generic_ada_node
3167 (buffer
, TREE_TYPE (type
), type
, cpp_check
, spc
, false, true);
3168 pp_character (buffer
, ')');
3169 bitfield_used
= false;
3172 print_ada_methods (buffer
, node
, cpp_check
, spc
);
3174 /* Print the static fields of the structure, if any. */
3175 need_semicolon
= TYPE_METHODS (node
) == NULL_TREE
;
3176 for (tmp
= TYPE_FIELDS (node
); tmp
; tmp
= TREE_CHAIN (tmp
))
3178 if (DECL_NAME (tmp
) && TREE_STATIC (tmp
))
3182 need_semicolon
= false;
3183 pp_semicolon (buffer
);
3185 pp_newline (buffer
);
3186 pp_newline (buffer
);
3187 print_ada_declaration (buffer
, tmp
, type
, cpp_check
, spc
);
3192 /* Dump all the declarations in SOURCE_FILE to an Ada spec.
3193 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3194 nodes for SOURCE_FILE. CPP_CHECK is used to perform C++ queries on
3198 dump_ads (const char *source_file
,
3199 void (*collect_all_refs
)(const char *),
3200 int (*cpp_check
)(tree
, cpp_operation
))
3207 pkg_name
= get_ada_package (source_file
);
3209 /* Construct the the .ads filename and package name. */
3210 ads_name
= xstrdup (pkg_name
);
3212 for (s
= ads_name
; *s
; s
++)
3215 ads_name
= reconcat (ads_name
, ads_name
, ".ads", NULL
);
3217 /* Write out the .ads file. */
3218 f
= fopen (ads_name
, "w");
3223 pp_construct (&pp
, NULL
, 0);
3224 pp_needs_newline (&pp
) = true;
3225 pp
.buffer
->stream
= f
;
3227 /* Dump all relevant macros. */
3228 dump_ada_macros (&pp
, source_file
);
3230 /* Reset the table of withs for this file. */
3233 (*collect_all_refs
) (source_file
);
3235 /* Dump all references. */
3236 dump_ada_nodes (&pp
, source_file
, cpp_check
);
3241 fprintf (f
, "\npackage %s is\n\n", pkg_name
);
3242 pp_write_text_to_stream (&pp
);
3243 /* ??? need to free pp */
3244 fprintf (f
, "end %s;\n", pkg_name
);
3252 static const char **source_refs
= NULL
;
3253 static int source_refs_used
= 0;
3254 static int source_refs_allocd
= 0;
3256 /* Add an entry for FILENAME to the table SOURCE_REFS. */
3259 collect_source_ref (const char *filename
)
3266 if (source_refs_allocd
== 0)
3268 source_refs_allocd
= 1024;
3269 source_refs
= XNEWVEC (const char *, source_refs_allocd
);
3272 for (i
= 0; i
< source_refs_used
; i
++)
3273 if (filename
== source_refs
[i
])
3276 if (source_refs_used
== source_refs_allocd
)
3278 source_refs_allocd
*= 2;
3279 source_refs
= XRESIZEVEC (const char *, source_refs
, source_refs_allocd
);
3282 source_refs
[source_refs_used
++] = filename
;
3285 /* Main entry point: dump all Ada specs corresponding to SOURCE_REFS
3286 using callbacks COLLECT_ALL_REFS and CPP_CHECK.
3287 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3288 nodes for a given source file.
3289 CPP_CHECK is used to perform C++ queries on nodes, or NULL for the C
3293 dump_ada_specs (void (*collect_all_refs
)(const char *),
3294 int (*cpp_check
)(tree
, cpp_operation
))
3298 /* Iterate over the list of files to dump specs for */
3299 for (i
= 0; i
< source_refs_used
; i
++)
3300 dump_ads (source_refs
[i
], collect_all_refs
, cpp_check
);
3302 /* Free files table. */