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 pp_string (buffer
, "type ");
1692 dump_generic_ada_node (buffer
, instance
, t
, cpp_check
, spc
, false, true);
1693 package_prefix
= true;
1695 if (is_tagged_type (instance
))
1696 pp_string (buffer
, " is tagged limited ");
1698 pp_string (buffer
, " is limited ");
1700 dump_generic_ada_node (buffer
, instance
, t
, cpp_check
, spc
, false, false);
1701 pp_newline (buffer
);
1703 newline_and_indent (buffer
, spc
);
1705 pp_string (buffer
, "end;");
1706 newline_and_indent (buffer
, spc
);
1707 pp_string (buffer
, "use ");
1708 package_prefix
= false;
1709 dump_generic_ada_node (buffer
, instance
, t
, cpp_check
, spc
, false, true);
1710 dump_template_types (buffer
, types
, cpp_check
, spc
);
1711 package_prefix
= true;
1712 pp_semicolon (buffer
);
1713 pp_newline (buffer
);
1714 pp_newline (buffer
);
1716 inst
= TREE_CHAIN (inst
);
1719 return num_inst
> 0;
1722 /* Return true if NODE is a simple enum types, that can be mapped to an
1723 Ada enum type directly. */
1726 is_simple_enum (tree node
)
1728 unsigned HOST_WIDE_INT count
= 0;
1731 for (value
= TYPE_VALUES (node
); value
; value
= TREE_CHAIN (value
))
1733 tree int_val
= TREE_VALUE (value
);
1735 if (TREE_CODE (int_val
) != INTEGER_CST
)
1736 int_val
= DECL_INITIAL (int_val
);
1738 if (!host_integerp (int_val
, 0))
1740 else if (TREE_INT_CST_LOW (int_val
) != count
)
1749 static bool in_function
= true;
1750 static bool bitfield_used
= false;
1752 /* Recursively dump in BUFFER Ada declarations corresponding to NODE of type
1753 TYPE. CPP_CHECK is used to perform C++ queries on nodes. SPC is the
1754 indentation level. LIMITED_ACCESS indicates whether NODE can be referenced
1755 via a "limited with" clause. NAME_ONLY indicates whether we should only
1756 dump the name of NODE, instead of its full declaration. */
1759 dump_generic_ada_node (pretty_printer
*buffer
, tree node
, tree type
,
1760 int (*cpp_check
)(tree
, cpp_operation
), int spc
,
1761 int limited_access
, bool name_only
)
1763 if (node
== NULL_TREE
)
1766 switch (TREE_CODE (node
))
1769 pp_string (buffer
, "<<< error >>>");
1772 case IDENTIFIER_NODE
:
1773 pp_ada_tree_identifier (buffer
, node
, type
, limited_access
);
1777 pp_string (buffer
, "--- unexpected node: TREE_LIST");
1781 dump_generic_ada_node
1782 (buffer
, BINFO_TYPE (node
), type
, cpp_check
,
1783 spc
, limited_access
, name_only
);
1786 pp_string (buffer
, "--- unexpected node: TREE_VEC");
1792 append_withs ("System", false);
1793 pp_string (buffer
, "System.Address");
1796 pp_string (buffer
, "address");
1800 pp_string (buffer
, "<vector>");
1804 pp_string (buffer
, "<complex>");
1809 dump_generic_ada_node
1810 (buffer
, TYPE_NAME (node
), node
, cpp_check
, spc
, 0, true);
1813 tree value
= TYPE_VALUES (node
);
1815 if (is_simple_enum (node
))
1819 newline_and_indent (buffer
, spc
- 1);
1820 pp_string (buffer
, "(");
1821 for (; value
; value
= TREE_CHAIN (value
))
1827 pp_string (buffer
, ",");
1828 newline_and_indent (buffer
, spc
);
1831 pp_ada_tree_identifier
1832 (buffer
, TREE_PURPOSE (value
), node
, false);
1834 pp_string (buffer
, ");");
1836 newline_and_indent (buffer
, spc
);
1837 pp_string (buffer
, "pragma Convention (C, ");
1838 dump_generic_ada_node
1839 (buffer
, DECL_NAME (type
) ? type
: TYPE_NAME (node
), type
,
1840 cpp_check
, spc
, 0, true);
1841 pp_string (buffer
, ")");
1845 pp_string (buffer
, "unsigned");
1846 for (; value
; value
= TREE_CHAIN (value
))
1848 pp_semicolon (buffer
);
1849 newline_and_indent (buffer
, spc
);
1851 pp_ada_tree_identifier
1852 (buffer
, TREE_PURPOSE (value
), node
, false);
1853 pp_string (buffer
, " : constant ");
1855 dump_generic_ada_node
1856 (buffer
, DECL_NAME (type
) ? type
: TYPE_NAME (node
), type
,
1857 cpp_check
, spc
, 0, true);
1859 pp_string (buffer
, " := ");
1860 dump_generic_ada_node
1862 TREE_CODE (TREE_VALUE (value
)) == INTEGER_CST
?
1863 TREE_VALUE (value
) : DECL_INITIAL (TREE_VALUE (value
)),
1864 node
, cpp_check
, spc
, false, true);
1872 case FIXED_POINT_TYPE
:
1875 enum tree_code_class tclass
;
1877 tclass
= TREE_CODE_CLASS (TREE_CODE (node
));
1879 if (tclass
== tcc_declaration
)
1881 if (DECL_NAME (node
))
1882 pp_ada_tree_identifier
1883 (buffer
, DECL_NAME (node
), 0, limited_access
);
1885 pp_string (buffer
, "<unnamed type decl>");
1887 else if (tclass
== tcc_type
)
1889 if (TYPE_NAME (node
))
1891 if (TREE_CODE (TYPE_NAME (node
)) == IDENTIFIER_NODE
)
1892 pp_ada_tree_identifier (buffer
, TYPE_NAME (node
),
1893 node
, limited_access
);
1894 else if (TREE_CODE (TYPE_NAME (node
)) == TYPE_DECL
1895 && DECL_NAME (TYPE_NAME (node
)))
1896 dump_ada_decl_name (buffer
, TYPE_NAME (node
), limited_access
);
1898 pp_string (buffer
, "<unnamed type>");
1900 else if (TREE_CODE (node
) == INTEGER_TYPE
)
1902 append_withs ("Interfaces.C.Extensions", false);
1903 bitfield_used
= true;
1905 if (TYPE_PRECISION (node
) == 1)
1906 pp_string (buffer
, "Extensions.Unsigned_1");
1909 pp_string (buffer
, (TYPE_UNSIGNED (node
)
1910 ? "Extensions.Unsigned_"
1911 : "Extensions.Signed_"));
1912 pp_decimal_int (buffer
, TYPE_PRECISION (node
));
1916 pp_string (buffer
, "<unnamed type>");
1922 case REFERENCE_TYPE
:
1923 if (TREE_CODE (TREE_TYPE (node
)) == FUNCTION_TYPE
)
1925 tree fnode
= TREE_TYPE (node
);
1927 bool prev_in_function
= in_function
;
1929 if (VOID_TYPE_P (TREE_TYPE (fnode
)))
1931 is_function
= false;
1932 pp_string (buffer
, "access procedure");
1937 pp_string (buffer
, "access function");
1940 in_function
= is_function
;
1941 dump_ada_function_declaration
1942 (buffer
, node
, false, false, false, spc
+ INDENT_INCR
);
1943 in_function
= prev_in_function
;
1947 pp_string (buffer
, " return ");
1948 dump_generic_ada_node
1949 (buffer
, TREE_TYPE (fnode
), type
, cpp_check
, spc
, 0, true);
1954 int is_access
= false;
1955 unsigned int quals
= TYPE_QUALS (TREE_TYPE (node
));
1957 if (name_only
&& TYPE_NAME (node
))
1958 dump_generic_ada_node
1959 (buffer
, TYPE_NAME (node
), node
, cpp_check
,
1960 spc
, limited_access
, true);
1961 else if (VOID_TYPE_P (TREE_TYPE (node
)))
1964 pp_string (buffer
, "new ");
1967 append_withs ("System", false);
1968 pp_string (buffer
, "System.Address");
1971 pp_string (buffer
, "address");
1975 if (TREE_CODE (node
) == POINTER_TYPE
1976 && TREE_CODE (TREE_TYPE (node
)) == INTEGER_TYPE
1978 (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME
1979 (TREE_TYPE (node
)))), "char"))
1982 pp_string (buffer
, "new ");
1986 pp_string (buffer
, "Interfaces.C.Strings.chars_ptr");
1987 append_withs ("Interfaces.C.Strings", false);
1990 pp_string (buffer
, "chars_ptr");
1994 /* For now, handle all access-to-access or
1995 access-to-unknown-structs as opaque system.address. */
1997 tree typ
= TYPE_NAME (TREE_TYPE (node
));
1998 const_tree typ2
= !type
||
1999 DECL_P (type
) ? type
: TYPE_NAME (type
);
2000 const_tree underlying_type
=
2001 get_underlying_decl (TREE_TYPE (node
));
2003 if (TREE_CODE (TREE_TYPE (node
)) == POINTER_TYPE
2004 /* Pointer to pointer. */
2006 || (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node
))
2007 && (!underlying_type
2008 || !TYPE_FIELDS (TREE_TYPE (underlying_type
))))
2009 /* Pointer to opaque structure. */
2012 && DECL_P (underlying_type
)
2014 && decl_sloc (underlying_type
, true)
2015 > decl_sloc (typ2
, true)
2016 && DECL_SOURCE_FILE (underlying_type
)
2017 == DECL_SOURCE_FILE (typ2
)))
2021 append_withs ("System", false);
2023 pp_string (buffer
, "new ");
2024 pp_string (buffer
, "System.Address");
2027 pp_string (buffer
, "address");
2031 if (!package_prefix
)
2032 pp_string (buffer
, "access");
2033 else if (AGGREGATE_TYPE_P (TREE_TYPE (node
)))
2035 if (!type
|| TREE_CODE (type
) != FUNCTION_DECL
)
2037 pp_string (buffer
, "access ");
2040 if (quals
& TYPE_QUAL_CONST
)
2041 pp_string (buffer
, "constant ");
2042 else if (!name_only
)
2043 pp_string (buffer
, "all ");
2045 else if (quals
& TYPE_QUAL_CONST
)
2046 pp_string (buffer
, "in ");
2047 else if (in_function
)
2050 pp_string (buffer
, "access ");
2055 pp_string (buffer
, "access ");
2056 /* ??? should be configurable: access or in out. */
2062 pp_string (buffer
, "access ");
2065 pp_string (buffer
, "all ");
2068 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node
))
2069 && TYPE_NAME (TREE_TYPE (node
)))
2071 tree name
= TYPE_NAME (TREE_TYPE (node
));
2074 if (TREE_CODE (name
) == TYPE_DECL
2075 && DECL_ORIGINAL_TYPE (name
)
2076 && TYPE_STUB_DECL (DECL_ORIGINAL_TYPE (name
)))
2078 tmp
= TYPE_NAME (TREE_TYPE (TYPE_STUB_DECL
2079 (DECL_ORIGINAL_TYPE (name
))));
2081 if (tmp
== NULL_TREE
)
2082 tmp
= TYPE_NAME (TREE_TYPE (node
));
2085 tmp
= TYPE_NAME (TREE_TYPE (node
));
2087 dump_generic_ada_node
2089 TREE_TYPE (node
), cpp_check
, spc
, is_access
, true);
2092 dump_generic_ada_node
2093 (buffer
, TREE_TYPE (node
), TREE_TYPE (node
),
2094 cpp_check
, spc
, 0, true);
2102 dump_generic_ada_node
2103 (buffer
, TYPE_NAME (node
), node
, cpp_check
,
2104 spc
, limited_access
, true);
2106 dump_ada_array_type (buffer
, node
, spc
);
2111 case QUAL_UNION_TYPE
:
2114 if (TYPE_NAME (node
))
2115 dump_generic_ada_node
2116 (buffer
, TYPE_NAME (node
), node
, cpp_check
,
2117 spc
, limited_access
, true);
2120 pp_string (buffer
, "anon_");
2121 pp_scalar (buffer
, "%d", TYPE_UID (node
));
2125 print_ada_struct_decl
2126 (buffer
, node
, type
, cpp_check
, spc
, true);
2130 if (TREE_CODE (TREE_TYPE (node
)) == POINTER_TYPE
)
2132 pp_wide_integer (buffer
, TREE_INT_CST_LOW (node
));
2133 pp_string (buffer
, "B"); /* pseudo-unit */
2135 else if (!host_integerp (node
, 0))
2138 unsigned HOST_WIDE_INT low
= TREE_INT_CST_LOW (val
);
2139 HOST_WIDE_INT high
= TREE_INT_CST_HIGH (val
);
2141 if (tree_int_cst_sgn (val
) < 0)
2143 pp_character (buffer
, '-');
2144 high
= ~high
+ !low
;
2147 sprintf (pp_buffer (buffer
)->digit_buffer
,
2148 HOST_WIDE_INT_PRINT_DOUBLE_HEX
,
2149 (unsigned HOST_WIDE_INT
) high
, low
);
2150 pp_string (buffer
, pp_buffer (buffer
)->digit_buffer
);
2153 pp_wide_integer (buffer
, TREE_INT_CST_LOW (node
));
2165 dump_ada_decl_name (buffer
, node
, limited_access
);
2169 if (DECL_IS_BUILTIN (node
))
2171 /* Don't print the declaration of built-in types. */
2175 /* If we're in the middle of a declaration, defaults to
2179 append_withs ("System", false);
2180 pp_string (buffer
, "System.Address");
2183 pp_string (buffer
, "address");
2189 dump_ada_decl_name (buffer
, node
, limited_access
);
2192 if (is_tagged_type (TREE_TYPE (node
)))
2194 tree tmp
= TYPE_FIELDS (TREE_TYPE (node
));
2197 /* Look for ancestors. */
2198 for (; tmp
; tmp
= TREE_CHAIN (tmp
))
2200 if (!DECL_NAME (tmp
) && is_tagged_type (TREE_TYPE (tmp
)))
2204 pp_string (buffer
, "limited new ");
2208 pp_string (buffer
, " and ");
2211 (buffer
, TYPE_NAME (TREE_TYPE (tmp
)), false);
2215 pp_string (buffer
, first
? "tagged limited " : " with ");
2217 else if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (node
))
2218 && TYPE_METHODS (TREE_TYPE (node
)))
2219 pp_string (buffer
, "limited ");
2221 dump_generic_ada_node
2222 (buffer
, TREE_TYPE (node
), type
, cpp_check
, spc
, false, false);
2229 case NAMESPACE_DECL
:
2230 dump_ada_decl_name (buffer
, node
, false);
2234 /* Ignore other nodes (e.g. expressions). */
2241 /* Dump in BUFFER NODE's methods. CPP_CHECK is used to perform C++ queries on
2242 nodes. SPC is the indentation level. */
2245 print_ada_methods (pretty_printer
*buffer
, tree node
,
2246 int (*cpp_check
)(tree
, cpp_operation
), int spc
)
2248 tree tmp
= TYPE_METHODS (node
);
2253 pp_semicolon (buffer
);
2255 for (; tmp
; tmp
= TREE_CHAIN (tmp
))
2259 pp_newline (buffer
);
2260 pp_newline (buffer
);
2262 res
= print_ada_declaration (buffer
, tmp
, node
, cpp_check
, spc
);
2267 /* Dump in BUFFER anonymous types nested inside T's definition.
2268 PARENT is the parent node of T. CPP_CHECK is used to perform C++ queries on
2269 nodes. SPC is the indentation level. */
2272 dump_nested_types (pretty_printer
*buffer
, tree t
, tree parent
,
2273 int (*cpp_check
)(tree
, cpp_operation
), int spc
)
2275 tree field
, outer
, decl
;
2277 /* Avoid recursing over the same tree. */
2278 if (TREE_VISITED (t
))
2281 /* Find possible anonymous arrays/unions/structs recursively. */
2283 outer
= TREE_TYPE (t
);
2285 if (outer
== NULL_TREE
)
2288 field
= TYPE_FIELDS (outer
);
2291 if ((TREE_TYPE (field
) != outer
2292 || (TREE_CODE (TREE_TYPE (field
)) == POINTER_TYPE
2293 && TREE_TYPE (TREE_TYPE (field
)) != outer
))
2294 && (!TYPE_NAME (TREE_TYPE (field
))
2295 || (TREE_CODE (field
) == TYPE_DECL
2296 && DECL_NAME (field
) != DECL_NAME (t
)
2297 && TYPE_NAME (TREE_TYPE (field
)) != TYPE_NAME (outer
))))
2299 switch (TREE_CODE (TREE_TYPE (field
)))
2302 decl
= TREE_TYPE (TREE_TYPE (field
));
2304 if (TREE_CODE (decl
) == FUNCTION_TYPE
)
2305 for (decl
= TREE_TYPE (decl
);
2306 decl
&& TREE_CODE (decl
) == POINTER_TYPE
;
2307 decl
= TREE_TYPE (decl
));
2309 decl
= get_underlying_decl (decl
);
2313 && decl_sloc (decl
, true) > decl_sloc (t
, true)
2314 && DECL_SOURCE_FILE (decl
) == DECL_SOURCE_FILE (t
)
2315 && !TREE_VISITED (decl
)
2316 && !DECL_IS_BUILTIN (decl
)
2317 && (!RECORD_OR_UNION_TYPE_P (TREE_TYPE (decl
))
2318 || TYPE_FIELDS (TREE_TYPE (decl
))))
2320 /* Generate forward declaration. */
2322 pp_string (buffer
, "type ");
2323 dump_generic_ada_node
2324 (buffer
, decl
, 0, cpp_check
, spc
, false, true);
2325 pp_semicolon (buffer
);
2326 newline_and_indent (buffer
, spc
);
2328 /* Ensure we do not generate duplicate forward
2329 declarations for this type. */
2330 TREE_VISITED (decl
) = 1;
2335 /* Special case char arrays. */
2336 if (is_char_array (field
))
2337 pp_string (buffer
, "sub");
2339 pp_string (buffer
, "type ");
2340 dump_ada_double_name (buffer
, parent
, field
, "_array is ");
2341 dump_ada_array_type (buffer
, field
, spc
);
2342 pp_semicolon (buffer
);
2343 newline_and_indent (buffer
, spc
);
2347 TREE_VISITED (t
) = 1;
2348 dump_nested_types (buffer
, field
, t
, cpp_check
, spc
);
2350 pp_string (buffer
, "type ");
2352 if (TYPE_NAME (TREE_TYPE (field
)))
2354 dump_generic_ada_node
2355 (buffer
, TYPE_NAME (TREE_TYPE (field
)), 0, cpp_check
,
2357 pp_string (buffer
, " (discr : unsigned := 0) is ");
2358 print_ada_struct_decl
2359 (buffer
, TREE_TYPE (field
), t
, cpp_check
, spc
, false);
2361 pp_string (buffer
, "pragma Convention (C_Pass_By_Copy, ");
2362 dump_generic_ada_node
2363 (buffer
, TREE_TYPE (field
), 0, cpp_check
,
2365 pp_string (buffer
, ");");
2366 newline_and_indent (buffer
, spc
);
2368 pp_string (buffer
, "pragma Unchecked_Union (");
2369 dump_generic_ada_node
2370 (buffer
, TREE_TYPE (field
), 0, cpp_check
,
2372 pp_string (buffer
, ");");
2376 dump_ada_double_name
2377 (buffer
, parent
, field
,
2378 "_union (discr : unsigned := 0) is ");
2379 print_ada_struct_decl
2380 (buffer
, TREE_TYPE (field
), t
, cpp_check
, spc
, false);
2381 pp_string (buffer
, "pragma Convention (C_Pass_By_Copy, ");
2382 dump_ada_double_name (buffer
, parent
, field
, "_union);");
2383 newline_and_indent (buffer
, spc
);
2385 pp_string (buffer
, "pragma Unchecked_Union (");
2386 dump_ada_double_name (buffer
, parent
, field
, "_union);");
2389 newline_and_indent (buffer
, spc
);
2393 if (TYPE_NAME (TREE_TYPE (t
)) && !TREE_VISITED (t
))
2395 pp_string (buffer
, "type ");
2396 dump_generic_ada_node
2397 (buffer
, t
, parent
, 0, spc
, false, true);
2398 pp_semicolon (buffer
);
2399 newline_and_indent (buffer
, spc
);
2402 TREE_VISITED (t
) = 1;
2403 dump_nested_types (buffer
, field
, t
, cpp_check
, spc
);
2404 pp_string (buffer
, "type ");
2406 if (TYPE_NAME (TREE_TYPE (field
)))
2408 dump_generic_ada_node
2409 (buffer
, TREE_TYPE (field
), 0, cpp_check
,
2411 pp_string (buffer
, " is ");
2412 print_ada_struct_decl
2413 (buffer
, TREE_TYPE (field
), t
, cpp_check
, spc
, false);
2414 pp_string (buffer
, "pragma Convention (C_Pass_By_Copy, ");
2415 dump_generic_ada_node
2416 (buffer
, TREE_TYPE (field
), 0, cpp_check
,
2418 pp_string (buffer
, ");");
2422 dump_ada_double_name
2423 (buffer
, parent
, field
, "_struct is ");
2424 print_ada_struct_decl
2425 (buffer
, TREE_TYPE (field
), t
, cpp_check
, spc
, false);
2426 pp_string (buffer
, "pragma Convention (C_Pass_By_Copy, ");
2427 dump_ada_double_name (buffer
, parent
, field
, "_struct);");
2430 newline_and_indent (buffer
, spc
);
2437 field
= TREE_CHAIN (field
);
2441 /* Dump in BUFFER destructor spec corresponding to T. */
2444 print_destructor (pretty_printer
*buffer
, tree t
)
2446 const char *s
= IDENTIFIER_POINTER (DECL_NAME (t
));
2449 for (s
+= 2; *s
!= ' '; s
++)
2450 pp_character (buffer
, *s
);
2453 pp_string (buffer
, "Delete_");
2454 pp_ada_tree_identifier (buffer
, DECL_NAME (t
), t
, false);
2458 /* Return the name of type T. */
2463 tree n
= TYPE_NAME (t
);
2465 if (TREE_CODE (n
) == IDENTIFIER_NODE
)
2466 return IDENTIFIER_POINTER (n
);
2468 return IDENTIFIER_POINTER (DECL_NAME (n
));
2471 /* Print in BUFFER the declaration of a variable T of type TYPE in Ada syntax.
2472 CPP_CHECK is used to perform C++ queries on nodes. SPC is the indentation
2473 level. Return 1 if a declaration was printed, 0 otherwise. */
2476 print_ada_declaration (pretty_printer
*buffer
, tree t
, tree type
,
2477 int (*cpp_check
)(tree
, cpp_operation
), int spc
)
2479 int is_var
= 0, need_indent
= 0;
2480 int is_class
= false;
2481 tree name
= TYPE_NAME (TREE_TYPE (t
));
2482 tree decl_name
= DECL_NAME (t
);
2483 bool dump_internal
= get_dump_file_info (TDI_ada
)->flags
& TDF_RAW
;
2484 tree orig
= NULL_TREE
;
2486 if (cpp_check
&& cpp_check (t
, IS_TEMPLATE
))
2487 return dump_ada_template (buffer
, t
, cpp_check
, spc
);
2489 if (TREE_CODE (t
) == CONST_DECL
&& TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
)
2490 /* Skip enumeral values: will be handled as part of the type itself. */
2493 if (TREE_CODE (t
) == TYPE_DECL
)
2495 orig
= DECL_ORIGINAL_TYPE (t
);
2497 if (orig
&& TYPE_STUB_DECL (orig
))
2499 tree typ
= TREE_TYPE (TYPE_STUB_DECL (orig
));
2501 if (TYPE_NAME (typ
))
2503 /* If types have same representation, and same name (ignoring
2504 casing), then ignore the second type. */
2505 if (type_name (typ
) == type_name (TREE_TYPE (t
))
2506 || !strcasecmp (type_name (typ
), type_name (TREE_TYPE (t
))))
2511 if (RECORD_OR_UNION_TYPE_P (typ
) && !TYPE_FIELDS (typ
))
2513 pp_string (buffer
, "-- skipped empty struct ");
2514 dump_generic_ada_node (buffer
, t
, type
, 0, spc
, false, true);
2518 pp_string (buffer
, "subtype ");
2519 dump_generic_ada_node (buffer
, t
, type
, 0, spc
, false, true);
2520 pp_string (buffer
, " is ");
2521 dump_generic_ada_node
2522 (buffer
, typ
, type
, 0, spc
, false, true);
2523 pp_semicolon (buffer
);
2529 /* Skip unnamed or anonymous structs/unions/enum types. */
2530 if (!orig
&& !decl_name
&& !name
)
2535 if (cpp_check
|| TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
)
2538 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
)))
2540 /* Search next items until finding a named type decl. */
2541 sloc
= decl_sloc_common (t
, true, true);
2543 for (tmp
= TREE_CHAIN (t
); tmp
; tmp
= TREE_CHAIN (tmp
))
2545 if (TREE_CODE (tmp
) == TYPE_DECL
2546 && (DECL_NAME (tmp
) || TYPE_NAME (TREE_TYPE (tmp
))))
2548 /* If same sloc, it means we can ignore the anonymous
2550 if (decl_sloc_common (tmp
, true, true) == sloc
)
2562 && TREE_CODE (TREE_TYPE (t
)) == ENUMERAL_TYPE
2564 && (*IDENTIFIER_POINTER (decl_name
) == '.'
2565 || *IDENTIFIER_POINTER (decl_name
) == '$'))
2566 /* Skip anonymous enum types (duplicates of real types). */
2571 switch (TREE_CODE (TREE_TYPE (t
)))
2575 case QUAL_UNION_TYPE
:
2576 /* Skip empty structs (typically forward references to real
2578 if (!TYPE_FIELDS (TREE_TYPE (t
)))
2580 pp_string (buffer
, "-- skipped empty struct ");
2581 dump_generic_ada_node (buffer
, t
, type
, 0, spc
, false, true);
2586 && (*IDENTIFIER_POINTER (decl_name
) == '.'
2587 || *IDENTIFIER_POINTER (decl_name
) == '$'))
2589 pp_string (buffer
, "-- skipped anonymous struct ");
2590 dump_generic_ada_node (buffer
, t
, type
, 0, spc
, false, true);
2594 if (orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
2595 pp_string (buffer
, "subtype ");
2598 dump_nested_types (buffer
, t
, t
, cpp_check
, spc
);
2600 if (TYPE_METHODS (TREE_TYPE (t
))
2601 || has_static_fields (TREE_TYPE (t
)))
2604 pp_string (buffer
, "package Class_");
2605 dump_generic_ada_node
2606 (buffer
, t
, type
, 0, spc
, false, true);
2607 pp_string (buffer
, " is");
2609 newline_and_indent (buffer
, spc
);
2612 pp_string (buffer
, "type ");
2618 case REFERENCE_TYPE
:
2619 if ((orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
2620 || is_char_array (t
))
2621 pp_string (buffer
, "subtype ");
2623 pp_string (buffer
, "type ");
2627 pp_string (buffer
, "-- skipped function type ");
2628 dump_generic_ada_node (buffer
, t
, type
, 0, spc
, false, true);
2633 if ((orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
2634 || !is_simple_enum (TREE_TYPE (t
)))
2635 pp_string (buffer
, "subtype ");
2637 pp_string (buffer
, "type ");
2641 pp_string (buffer
, "subtype ");
2647 && TREE_CODE (t
) == VAR_DECL
2649 && *IDENTIFIER_POINTER (decl_name
) == '_')
2655 /* Print the type and name. */
2656 if (TREE_CODE (TREE_TYPE (t
)) == ARRAY_TYPE
)
2661 /* Print variable's name. */
2662 dump_generic_ada_node (buffer
, t
, type
, cpp_check
, spc
, false, true);
2664 if (TREE_CODE (t
) == TYPE_DECL
)
2666 pp_string (buffer
, " is ");
2668 if (orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
))
2669 dump_generic_ada_node
2670 (buffer
, TYPE_NAME (orig
), type
,
2671 cpp_check
, spc
, false, true);
2673 dump_ada_array_type (buffer
, t
, spc
);
2677 tree tmp
= TYPE_NAME (TREE_TYPE (t
));
2679 if (spc
== INDENT_INCR
|| TREE_STATIC (t
))
2682 pp_string (buffer
, " : ");
2686 if (TREE_CODE (TREE_TYPE (tmp
)) != POINTER_TYPE
2687 && TREE_CODE (tmp
) != INTEGER_TYPE
)
2688 pp_string (buffer
, "aliased ");
2690 dump_generic_ada_node (buffer
, tmp
, type
, 0, spc
, false, true);
2694 pp_string (buffer
, "aliased ");
2697 dump_ada_array_type (buffer
, t
, spc
);
2699 dump_ada_double_name (buffer
, type
, t
, "_array");
2703 else if (TREE_CODE (t
) == FUNCTION_DECL
)
2705 bool is_function
= true, is_method
, is_abstract_class
= false;
2706 tree decl_name
= DECL_NAME (t
);
2707 int prev_in_function
= in_function
;
2708 bool is_abstract
= false;
2709 bool is_constructor
= false;
2710 bool is_destructor
= false;
2711 bool is_copy_constructor
= false;
2718 is_abstract
= cpp_check (t
, IS_ABSTRACT
);
2719 is_constructor
= cpp_check (t
, IS_CONSTRUCTOR
);
2720 is_destructor
= cpp_check (t
, IS_DESTRUCTOR
);
2721 is_copy_constructor
= cpp_check (t
, IS_COPY_CONSTRUCTOR
);
2724 /* Skip __comp_dtor destructor which is redundant with the '~class()'
2727 && !strncmp (IDENTIFIER_POINTER (decl_name
), "__comp", 6))
2730 /* Skip copy constructors: some are internal only, and those that are
2731 not cannot be called easily from Ada anyway. */
2732 if (is_copy_constructor
)
2735 /* If this function has an entry in the dispatch table, we cannot
2737 if (!dump_internal
&& !DECL_VINDEX (t
)
2738 && *IDENTIFIER_POINTER (decl_name
) == '_')
2740 if (IDENTIFIER_POINTER (decl_name
)[1] == '_')
2744 pp_string (buffer
, "-- skipped func ");
2745 pp_string (buffer
, IDENTIFIER_POINTER (decl_name
));
2753 pp_string (buffer
, "function New_");
2754 else if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t
))))
2756 is_function
= false;
2757 pp_string (buffer
, "procedure ");
2760 pp_string (buffer
, "function ");
2762 in_function
= is_function
;
2763 is_method
= TREE_CODE (TREE_TYPE (t
)) == METHOD_TYPE
;
2766 print_destructor (buffer
, t
);
2768 dump_ada_decl_name (buffer
, t
, false);
2770 dump_ada_function_declaration
2771 (buffer
, t
, is_method
, is_constructor
, is_destructor
, spc
);
2772 in_function
= prev_in_function
;
2776 pp_string (buffer
, " return ");
2780 dump_ada_decl_name (buffer
, t
, false);
2784 dump_generic_ada_node
2785 (buffer
, TREE_TYPE (TREE_TYPE (t
)), type
, cpp_check
,
2790 if (is_constructor
&& cpp_check
&& type
2791 && AGGREGATE_TYPE_P (type
)
2792 && TYPE_METHODS (type
))
2794 tree tmp
= TYPE_METHODS (type
);
2796 for (; tmp
; tmp
= TREE_CHAIN (tmp
))
2797 if (cpp_check (tmp
, IS_ABSTRACT
))
2799 is_abstract_class
= 1;
2804 if (is_abstract
|| is_abstract_class
)
2805 pp_string (buffer
, " is abstract");
2807 pp_semicolon (buffer
);
2808 pp_string (buffer
, " -- ");
2809 dump_sloc (buffer
, t
);
2814 newline_and_indent (buffer
, spc
);
2818 pp_string (buffer
, "pragma CPP_Constructor (New_");
2819 dump_ada_decl_name (buffer
, t
, false);
2820 pp_string (buffer
, ", \"");
2821 pp_asm_name (buffer
, t
);
2822 pp_string (buffer
, "\");");
2824 else if (is_destructor
)
2826 pp_string (buffer
, "pragma Import (CPP, ");
2827 print_destructor (buffer
, t
);
2828 pp_string (buffer
, ", \"");
2829 pp_asm_name (buffer
, t
);
2830 pp_string (buffer
, "\");");
2834 dump_ada_import (buffer
, t
);
2839 else if (TREE_CODE (t
) == TYPE_DECL
&& !DECL_ORIGINAL_TYPE (t
))
2841 int is_interface
= 0;
2842 int is_abstract_record
= 0;
2847 /* Anonymous structs/unions */
2848 dump_generic_ada_node
2849 (buffer
, TREE_TYPE (t
), t
, cpp_check
, spc
, false, true);
2851 if (TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
2852 || TREE_CODE (TREE_TYPE (t
)) == QUAL_UNION_TYPE
)
2854 pp_string (buffer
, " (discr : unsigned := 0)");
2857 pp_string (buffer
, " is ");
2859 /* Check whether we have an Ada interface compatible class. */
2860 if (cpp_check
&& AGGREGATE_TYPE_P (TREE_TYPE (t
))
2861 && TYPE_METHODS (TREE_TYPE (t
)))
2864 tree tmp
= TYPE_FIELDS (TREE_TYPE (t
));
2866 /* Check that there are no fields other than the virtual table. */
2867 for (; tmp
; tmp
= TREE_CHAIN (tmp
))
2869 if (TREE_CODE (tmp
) == TYPE_DECL
)
2874 if (num_fields
== 1)
2877 /* Also check that there are only virtual methods. */
2878 for (tmp
= TYPE_METHODS (TREE_TYPE (t
)); tmp
; tmp
= TREE_CHAIN (tmp
))
2880 if (cpp_check (tmp
, IS_ABSTRACT
))
2881 is_abstract_record
= 1;
2889 pp_string (buffer
, "limited interface; -- ");
2890 dump_sloc (buffer
, t
);
2891 newline_and_indent (buffer
, spc
);
2892 pp_string (buffer
, "pragma Import (CPP, ");
2893 dump_generic_ada_node
2894 (buffer
, TYPE_NAME (TREE_TYPE (t
)), type
, cpp_check
,
2896 pp_character (buffer
, ')');
2898 print_ada_methods (buffer
, TREE_TYPE (t
), cpp_check
, spc
);
2902 if (is_abstract_record
)
2903 pp_string (buffer
, "abstract ");
2904 dump_generic_ada_node (buffer
, t
, t
, cpp_check
, spc
, false, false);
2912 if (TREE_CODE (t
) == FIELD_DECL
&& DECL_NAME (t
))
2913 check_name (buffer
, t
);
2915 /* Print variable/type's name. */
2916 dump_generic_ada_node (buffer
, t
, t
, cpp_check
, spc
, false, true);
2918 if (TREE_CODE (t
) == TYPE_DECL
)
2920 tree orig
= DECL_ORIGINAL_TYPE (t
);
2921 int is_subtype
= orig
&& TYPE_NAME (orig
) && orig
!= TREE_TYPE (t
);
2924 && (TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
2925 || TREE_CODE (TREE_TYPE (t
)) == QUAL_UNION_TYPE
))
2926 pp_string (buffer
, " (discr : unsigned := 0)");
2928 pp_string (buffer
, " is ");
2930 dump_generic_ada_node
2931 (buffer
, orig
, t
, cpp_check
, spc
, false, is_subtype
);
2935 if (spc
== INDENT_INCR
|| TREE_STATIC (t
))
2938 pp_string (buffer
, " : ");
2940 /* Print type declaration. */
2942 if (TREE_CODE (TREE_TYPE (t
)) == UNION_TYPE
2943 && !TYPE_NAME (TREE_TYPE (t
)))
2945 dump_ada_double_name (buffer
, type
, t
, "_union");
2947 else if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (t
)))
2949 if (TREE_CODE (TREE_TYPE (t
)) == RECORD_TYPE
)
2950 pp_string (buffer
, "aliased ");
2952 dump_generic_ada_node
2953 (buffer
, TREE_TYPE (t
), t
, cpp_check
, spc
, false, true);
2957 if (TREE_CODE (TREE_TYPE (t
)) != POINTER_TYPE
2958 && (TYPE_NAME (TREE_TYPE (t
))
2959 || TREE_CODE (TREE_TYPE (t
)) != INTEGER_TYPE
))
2960 pp_string (buffer
, "aliased ");
2962 dump_generic_ada_node
2963 (buffer
, TREE_TYPE (t
), TREE_TYPE (t
), cpp_check
,
2972 newline_and_indent (buffer
, spc
);
2973 pp_string (buffer
, "end;");
2974 newline_and_indent (buffer
, spc
);
2975 pp_string (buffer
, "use Class_");
2976 dump_generic_ada_node (buffer
, t
, type
, 0, spc
, false, true);
2977 pp_semicolon (buffer
);
2978 pp_newline (buffer
);
2980 /* All needed indentation/newline performed already, so return 0. */
2985 pp_string (buffer
, "; -- ");
2986 dump_sloc (buffer
, t
);
2991 newline_and_indent (buffer
, spc
);
2992 dump_ada_import (buffer
, t
);
2998 /* Prints in BUFFER a structure NODE of type TYPE: name, fields, and methods
2999 with Ada syntax. CPP_CHECK is used to perform C++ queries on nodes. SPC
3000 is the indentation level. If DISPLAY_CONVENTION is true, also print the
3001 pragma Convention for NODE. */
3004 print_ada_struct_decl (pretty_printer
*buffer
, tree node
, tree type
,
3005 int (*cpp_check
)(tree
, cpp_operation
), int spc
,
3006 bool display_convention
)
3010 TREE_CODE (node
) == UNION_TYPE
|| TREE_CODE (node
) == QUAL_UNION_TYPE
;
3013 int field_spc
= spc
+ INDENT_INCR
;
3016 bitfield_used
= false;
3018 if (!TYPE_FIELDS (node
))
3019 pp_string (buffer
, "null record;");
3022 pp_string (buffer
, "record");
3024 /* Print the contents of the structure. */
3028 newline_and_indent (buffer
, spc
+ INDENT_INCR
);
3029 pp_string (buffer
, "case discr is");
3030 field_spc
= spc
+ INDENT_INCR
* 3;
3033 pp_newline (buffer
);
3035 /* Print the non-static fields of the structure. */
3036 for (tmp
= TYPE_FIELDS (node
); tmp
; tmp
= TREE_CHAIN (tmp
))
3038 /* Add parent field if needed. */
3039 if (!DECL_NAME (tmp
))
3041 if (!is_tagged_type (TREE_TYPE (tmp
)))
3043 if (!TYPE_NAME (TREE_TYPE (tmp
)))
3044 print_ada_declaration
3045 (buffer
, tmp
, type
, cpp_check
, field_spc
);
3051 pp_string (buffer
, "parent : ");
3054 sprintf (buf
, "field_%d : ", field_num
+ 1);
3055 pp_string (buffer
, buf
);
3058 (buffer
, TYPE_NAME (TREE_TYPE (tmp
)), false);
3059 pp_semicolon (buffer
);
3061 pp_newline (buffer
);
3065 /* Avoid printing the structure recursively. */
3066 else if ((TREE_TYPE (tmp
) != node
3067 || (TREE_CODE (TREE_TYPE (tmp
)) == POINTER_TYPE
3068 && TREE_TYPE (TREE_TYPE (tmp
)) != node
))
3069 && TREE_CODE (tmp
) != TYPE_DECL
3070 && !TREE_STATIC (tmp
))
3072 /* Skip internal virtual table field. */
3073 if (strncmp (IDENTIFIER_POINTER (DECL_NAME (tmp
)), "_vptr", 5))
3077 if (TREE_CHAIN (tmp
)
3078 && TREE_TYPE (TREE_CHAIN (tmp
)) != node
3079 && TREE_CODE (TREE_CHAIN (tmp
)) != TYPE_DECL
)
3080 sprintf (buf
, "when %d =>", field_num
);
3082 sprintf (buf
, "when others =>");
3084 INDENT (spc
+ INDENT_INCR
* 2);
3085 pp_string (buffer
, buf
);
3086 pp_newline (buffer
);
3089 if (print_ada_declaration (buffer
,
3090 tmp
, type
, cpp_check
, field_spc
))
3092 pp_newline (buffer
);
3101 INDENT (spc
+ INDENT_INCR
);
3102 pp_string (buffer
, "end case;");
3103 pp_newline (buffer
);
3108 INDENT (spc
+ INDENT_INCR
);
3109 pp_string (buffer
, "null;");
3110 pp_newline (buffer
);
3114 pp_string (buffer
, "end record;");
3117 newline_and_indent (buffer
, spc
);
3119 if (!display_convention
)
3122 if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (type
)))
3124 if (TYPE_METHODS (TREE_TYPE (type
)))
3125 pp_string (buffer
, "pragma Import (CPP, ");
3127 pp_string (buffer
, "pragma Convention (C_Pass_By_Copy, ");
3130 pp_string (buffer
, "pragma Convention (C, ");
3132 package_prefix
= false;
3133 dump_generic_ada_node
3134 (buffer
, TREE_TYPE (type
), type
, cpp_check
, spc
, false, true);
3135 package_prefix
= true;
3136 pp_character (buffer
, ')');
3140 pp_semicolon (buffer
);
3141 newline_and_indent (buffer
, spc
);
3142 pp_string (buffer
, "pragma Unchecked_Union (");
3144 dump_generic_ada_node
3145 (buffer
, TREE_TYPE (type
), type
, cpp_check
, spc
, false, true);
3146 pp_character (buffer
, ')');
3151 pp_semicolon (buffer
);
3152 newline_and_indent (buffer
, spc
);
3153 pp_string (buffer
, "pragma Pack (");
3154 dump_generic_ada_node
3155 (buffer
, TREE_TYPE (type
), type
, cpp_check
, spc
, false, true);
3156 pp_character (buffer
, ')');
3157 bitfield_used
= false;
3160 print_ada_methods (buffer
, node
, cpp_check
, spc
);
3162 /* Print the static fields of the structure, if any. */
3163 need_semicolon
= TYPE_METHODS (node
) == NULL_TREE
;
3164 for (tmp
= TYPE_FIELDS (node
); tmp
; tmp
= TREE_CHAIN (tmp
))
3166 if (DECL_NAME (tmp
) && TREE_STATIC (tmp
))
3170 need_semicolon
= false;
3171 pp_semicolon (buffer
);
3173 pp_newline (buffer
);
3174 pp_newline (buffer
);
3175 print_ada_declaration (buffer
, tmp
, type
, cpp_check
, spc
);
3180 /* Dump all the declarations in SOURCE_FILE to an Ada spec.
3181 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3182 nodes for SOURCE_FILE. CPP_CHECK is used to perform C++ queries on
3186 dump_ads (const char *source_file
,
3187 void (*collect_all_refs
)(const char *),
3188 int (*cpp_check
)(tree
, cpp_operation
))
3195 pkg_name
= get_ada_package (source_file
);
3197 /* Construct the the .ads filename and package name. */
3198 ads_name
= xstrdup (pkg_name
);
3200 for (s
= ads_name
; *s
; s
++)
3203 ads_name
= reconcat (ads_name
, ads_name
, ".ads", NULL
);
3205 /* Write out the .ads file. */
3206 f
= fopen (ads_name
, "w");
3211 pp_construct (&pp
, NULL
, 0);
3212 pp_needs_newline (&pp
) = true;
3213 pp
.buffer
->stream
= f
;
3215 /* Dump all relevant macros. */
3216 dump_ada_macros (&pp
, source_file
);
3218 /* Reset the table of withs for this file. */
3221 (*collect_all_refs
) (source_file
);
3223 /* Dump all references. */
3224 dump_ada_nodes (&pp
, source_file
, cpp_check
);
3229 fprintf (f
, "\npackage %s is\n\n", pkg_name
);
3230 pp_write_text_to_stream (&pp
);
3231 /* ??? need to free pp */
3232 fprintf (f
, "end %s;\n", pkg_name
);
3240 static const char **source_refs
= NULL
;
3241 static int source_refs_used
= 0;
3242 static int source_refs_allocd
= 0;
3244 /* Add an entry for FILENAME to the table SOURCE_REFS. */
3247 collect_source_ref (const char *filename
)
3254 if (source_refs_allocd
== 0)
3256 source_refs_allocd
= 1024;
3257 source_refs
= XNEWVEC (const char *, source_refs_allocd
);
3260 for (i
= 0; i
< source_refs_used
; i
++)
3261 if (filename
== source_refs
[i
])
3264 if (source_refs_used
== source_refs_allocd
)
3266 source_refs_allocd
*= 2;
3267 source_refs
= XRESIZEVEC (const char *, source_refs
, source_refs_allocd
);
3270 source_refs
[source_refs_used
++] = filename
;
3273 /* Main entry point: dump all Ada specs corresponding to SOURCE_REFS
3274 using callbacks COLLECT_ALL_REFS and CPP_CHECK.
3275 COLLECT_ALL_REFS is a front-end callback used to collect all relevant
3276 nodes for a given source file.
3277 CPP_CHECK is used to perform C++ queries on nodes, or NULL for the C
3281 dump_ada_specs (void (*collect_all_refs
)(const char *),
3282 int (*cpp_check
)(tree
, cpp_operation
))
3286 /* Iterate over the list of files to dump specs for */
3287 for (i
= 0; i
< source_refs_used
; i
++)
3288 dump_ads (source_refs
[i
], collect_all_refs
, cpp_check
);
3290 /* Free files table. */