#include "config.h"
#include "system.h"
#include "tree.h"
#include "rtl.h"
#include "errors.h"
#include "diagnostic.h"
#include "expr.h"
#include "libfuncs.h"
#include "ggc.h"
#include "flags.h"
#include "debug.h"
#include "insn-codes.h"
#include "insn-flags.h"
#include "insn-config.h"
#include "optabs.h"
#include "recog.h"
#include "toplev.h"
#include "output.h"
#include "except.h"
#include "tm_p.h"
#include "langhooks.h"
#include "langhooks-def.h"
#include "ada.h"
#include "types.h"
#include "atree.h"
#include "elists.h"
#include "namet.h"
#include "nlists.h"
#include "stringt.h"
#include "uintp.h"
#include "fe.h"
#include "sinfo.h"
#include "einfo.h"
#include "ada-tree.h"
#include "gigi.h"
#include "adadecode.h"
extern FILE *asm_out_file;
extern int save_argc;
extern char **save_argv;
static const char *gnat_init PARAMS ((const char *));
static void gnat_init_options PARAMS ((void));
static int gnat_decode_option PARAMS ((int, char **));
static HOST_WIDE_INT gnat_get_alias_set PARAMS ((tree));
static void gnat_print_decl PARAMS ((FILE *, tree, int));
static void gnat_print_type PARAMS ((FILE *, tree, int));
static const char *gnat_printable_name PARAMS ((tree, int));
static tree gnat_eh_runtime_type PARAMS ((tree));
static int gnat_eh_type_covers PARAMS ((tree, tree));
static void gnat_parse_file PARAMS ((int));
static rtx gnat_expand_expr PARAMS ((tree, rtx, enum machine_mode,
int));
#undef LANG_HOOKS_NAME
#define LANG_HOOKS_NAME "GNU Ada"
#undef LANG_HOOKS_IDENTIFIER_SIZE
#define LANG_HOOKS_IDENTIFIER_SIZE sizeof (struct tree_identifier)
#undef LANG_HOOKS_INIT
#define LANG_HOOKS_INIT gnat_init
#undef LANG_HOOKS_INIT_OPTIONS
#define LANG_HOOKS_INIT_OPTIONS gnat_init_options
#undef LANG_HOOKS_DECODE_OPTION
#define LANG_HOOKS_DECODE_OPTION gnat_decode_option
#undef LANG_HOOKS_PARSE_FILE
#define LANG_HOOKS_PARSE_FILE gnat_parse_file
#undef LANG_HOOKS_HONOR_READONLY
#define LANG_HOOKS_HONOR_READONLY 1
#undef LANG_HOOKS_FINISH_INCOMPLETE_DECL
#define LANG_HOOKS_FINISH_INCOMPLETE_DECL gnat_finish_incomplete_decl
#undef LANG_HOOKS_GET_ALIAS_SET
#define LANG_HOOKS_GET_ALIAS_SET gnat_get_alias_set
#undef LANG_HOOKS_EXPAND_EXPR
#define LANG_HOOKS_EXPAND_EXPR gnat_expand_expr
#undef LANG_HOOKS_MARK_ADDRESSABLE
#define LANG_HOOKS_MARK_ADDRESSABLE gnat_mark_addressable
#undef LANG_HOOKS_TRUTHVALUE_CONVERSION
#define LANG_HOOKS_TRUTHVALUE_CONVERSION gnat_truthvalue_conversion
#undef LANG_HOOKS_PRINT_DECL
#define LANG_HOOKS_PRINT_DECL gnat_print_decl
#undef LANG_HOOKS_PRINT_TYPE
#define LANG_HOOKS_PRINT_TYPE gnat_print_type
#undef LANG_HOOKS_DECL_PRINTABLE_NAME
#define LANG_HOOKS_DECL_PRINTABLE_NAME gnat_printable_name
#undef LANG_HOOKS_TYPE_FOR_MODE
#define LANG_HOOKS_TYPE_FOR_MODE gnat_type_for_mode
#undef LANG_HOOKS_TYPE_FOR_SIZE
#define LANG_HOOKS_TYPE_FOR_SIZE gnat_type_for_size
#undef LANG_HOOKS_SIGNED_TYPE
#define LANG_HOOKS_SIGNED_TYPE gnat_signed_type
#undef LANG_HOOKS_UNSIGNED_TYPE
#define LANG_HOOKS_UNSIGNED_TYPE gnat_unsigned_type
#undef LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE
#define LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE gnat_signed_or_unsigned_type
const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
const char tree_code_type[] = {
#include "tree.def"
'x',
#include "ada-tree.def"
};
#undef DEFTREECODE
#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH,
const unsigned char tree_code_length[] = {
#include "tree.def"
0,
#include "ada-tree.def"
};
#undef DEFTREECODE
#define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME,
const char *const tree_code_name[] = {
#include "tree.def"
"@@dummy",
#include "ada-tree.def"
};
#undef DEFTREECODE
extern int gnat_argc;
extern char **gnat_argv;
static void internal_error_function PARAMS ((const char *, va_list *));
static void gnat_adjust_rli PARAMS ((record_layout_info));
extern void __gnat_initialize PARAMS((void));
extern void adainit PARAMS((void));
extern void _ada_gnat1drv PARAMS((void));
static void
gnat_parse_file (set_yydebug)
int set_yydebug ATTRIBUTE_UNUSED;
{
__gnat_initialize();
adainit ();
immediate_size_expand = 1;
_ada_gnat1drv ();
}
static int
gnat_decode_option (argc, argv)
int argc ATTRIBUTE_UNUSED;
char **argv;
{
char *p = argv[0];
int i;
if (!strncmp (p, "-I", 2))
{
gnat_argv[gnat_argc] = p;
gnat_argc ++;
return 1;
}
else if (!strncmp (p, "-gant", 5))
{
char *q = xstrdup (p);
warning ("`-gnat' misspelled as `-gant'");
q[2] = 'n', q[3] = 'a';
p = q;
return 1;
}
else if (!strncmp (p, "-gnat", 5))
{
gnat_argv[gnat_argc] = (char *) xmalloc (strlen (p) - 3);
gnat_argv[gnat_argc][0] = '-';
strcpy (gnat_argv[gnat_argc] + 1, p + 5);
gnat_argc ++;
if (p[5] == 'O')
for (i = 1; i < save_argc - 1; i++)
if (!strncmp (save_argv[i], "-gnatO", 6))
if (save_argv[++i][0] != '-')
{
gnat_argv[gnat_argc] = save_argv[i];
gnat_argc++;
break;
}
return 1;
}
if (!strncmp (p, "-fRTS", 5))
{
gnat_argv[gnat_argc] = p;
gnat_argc ++;
return 1;
}
else if (p[0] == '-' && p[1] == 'W' && p[2] != 0)
return 1;
return 0;
}
static void
gnat_init_options ()
{
gnat_argv = (char **) xmalloc ((save_argc + 1) * sizeof (gnat_argv[0]));
gnat_argv[0] = save_argv[0];
gnat_argc = 1;
}
static void
internal_error_function (msgid, ap)
const char *msgid;
va_list *ap;
{
char buffer[1000];
char *p;
String_Template temp;
Fat_Pointer fp;
vsprintf (buffer, msgid, *ap);
for (p = buffer; *p != 0; p++)
if (*p == '\n')
{
*p = '\0';
break;
}
temp.Low_Bound = 1, temp.High_Bound = strlen (buffer);
fp.Array = buffer, fp.Bounds = &temp;
Current_Error_Node = error_gnat_node;
Compiler_Abort (fp, -1);
}
static const char *
gnat_init (filename)
const char *filename;
{
gnat_init_decl_processing ();
gnat_argv[gnat_argc] = (char *) filename;
gnat_argc++;
gnat_argv[gnat_argc] = 0;
global_dc->internal_error = &internal_error_function;
internal_reference_types ();
set_lang_adjust_rli (gnat_adjust_rli);
if (filename == 0)
filename = "";
return filename;
}
void
gnat_init_gcc_eh ()
{
if (No_Exception_Handlers_Set ())
return;
eh_personality_libfunc = init_one_libfunc ("__gnat_eh_personality");
lang_eh_type_covers = gnat_eh_type_covers;
lang_eh_runtime_type = gnat_eh_runtime_type;
flag_exceptions = 1;
init_eh ();
#ifdef DWARF2_UNWIND_INFO
if (dwarf2out_do_frame ())
dwarf2out_frame_init ();
#endif
}
static void
gnat_print_decl (file, node, indent)
FILE *file;
tree node;
int indent;
{
switch (TREE_CODE (node))
{
case CONST_DECL:
print_node (file, "const_corresponding_var",
DECL_CONST_CORRESPONDING_VAR (node), indent + 4);
break;
case FIELD_DECL:
print_node (file, "original field", DECL_ORIGINAL_FIELD (node),
indent + 4);
break;
default:
break;
}
}
static void
gnat_print_type (file, node, indent)
FILE *file;
tree node;
int indent;
{
switch (TREE_CODE (node))
{
case FUNCTION_TYPE:
print_node (file, "ci_co_list", TYPE_CI_CO_LIST (node), indent + 4);
break;
case ENUMERAL_TYPE:
print_node (file, "RM size", TYPE_RM_SIZE_ENUM (node), indent + 4);
break;
case INTEGER_TYPE:
if (TYPE_MODULAR_P (node))
print_node (file, "modulus", TYPE_MODULUS (node), indent + 4);
else if (TYPE_HAS_ACTUAL_BOUNDS_P (node))
print_node (file, "actual bounds", TYPE_ACTUAL_BOUNDS (node),
indent + 4);
else if (TYPE_VAX_FLOATING_POINT_P (node))
;
else
print_node (file, "index type", TYPE_INDEX_TYPE (node), indent + 4);
print_node (file, "RM size", TYPE_RM_SIZE_INT (node), indent + 4);
break;
case ARRAY_TYPE:
print_node (file,"actual bounds", TYPE_ACTUAL_BOUNDS (node), indent + 4);
break;
case RECORD_TYPE:
if (TYPE_IS_FAT_POINTER_P (node) || TYPE_CONTAINS_TEMPLATE_P (node))
print_node (file, "unconstrained array",
TYPE_UNCONSTRAINED_ARRAY (node), indent + 4);
else
print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4);
break;
case UNION_TYPE:
case QUAL_UNION_TYPE:
print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4);
break;
default:
break;
}
}
static const char *
gnat_printable_name (decl, verbosity)
tree decl;
int verbosity ATTRIBUTE_UNUSED;
{
const char *coded_name = IDENTIFIER_POINTER (DECL_NAME (decl));
char *ada_name = (char *) ggc_alloc (strlen (coded_name) * 2 + 60);
__gnat_decode (coded_name, ada_name, 0);
return (const char *) ada_name;
}
static rtx
gnat_expand_expr (exp, target, tmode, modifier)
tree exp;
rtx target;
enum machine_mode tmode;
int modifier;
{
tree type = TREE_TYPE (exp);
tree new;
rtx result;
switch (TREE_CODE (exp))
{
case TRANSFORM_EXPR:
gnat_to_code (TREE_COMPLEXITY (exp));
return const0_rtx;
break;
case NULL_EXPR:
expand_expr (TREE_OPERAND (exp, 0), const0_rtx, VOIDmode, 0);
if (! host_integerp (TYPE_SIZE_UNIT (type), 1))
result = gen_rtx_MEM (BLKmode, virtual_stack_vars_rtx);
else
result = assign_temp (type, 0, TREE_ADDRESSABLE (exp), 1);
return result;
case ALLOCATE_EXPR:
return
allocate_dynamic_stack_space
(expand_expr (TREE_OPERAND (exp, 0), NULL_RTX, TYPE_MODE (sizetype),
EXPAND_NORMAL),
NULL_RTX, tree_low_cst (TREE_OPERAND (exp, 1), 1));
case USE_EXPR:
if (target != const0_rtx)
gigi_abort (203);
result = gen_rtx_ASM_INPUT (VOIDmode, "");
MEM_VOLATILE_P (result) = 1;
emit_insn (result);
result = expand_expr (TREE_OPERAND (exp, 0), NULL_RTX, VOIDmode,
modifier);
emit_insn (gen_rtx_USE (VOIDmode, result));
return target;
case GNAT_NOP_EXPR:
return expand_expr (build1 (NOP_EXPR, type, TREE_OPERAND (exp, 0)),
target, tmode, modifier);
case UNCONSTRAINED_ARRAY_REF:
if (target == const0_rtx || TREE_CODE (type) == VOID_TYPE)
return expand_expr (TREE_OPERAND (exp, 0), const0_rtx,
VOIDmode, modifier);
default:
gigi_abort (201);
}
return expand_expr (new, target, tmode, modifier);
}
static void
gnat_adjust_rli (rli)
record_layout_info rli;
{
unsigned int record_align = rli->unpadded_align;
tree field;
for (field = TYPE_FIELDS (rli->t); field; field = TREE_CHAIN (field))
if (TREE_CODE (DECL_SIZE_UNIT (field)) != INTEGER_CST)
record_align = MAX (record_align, DECL_ALIGN (field));
if (TYPE_PACKED (rli->t))
rli->record_align = record_align;
}
tree
make_transform_expr (gnat_node)
Node_Id gnat_node;
{
tree gnu_result = build (TRANSFORM_EXPR, void_type_node);
TREE_SIDE_EFFECTS (gnu_result) = 1;
TREE_COMPLEXITY (gnu_result) = gnat_node;
return gnu_result;
}
void
update_setjmp_buf (buf)
tree buf;
{
enum machine_mode sa_mode = Pmode;
rtx stack_save;
#ifdef HAVE_save_stack_nonlocal
if (HAVE_save_stack_nonlocal)
sa_mode = insn_data[(int) CODE_FOR_save_stack_nonlocal].operand[0].mode;
#endif
#ifdef STACK_SAVEAREA_MODE
sa_mode = STACK_SAVEAREA_MODE (SAVE_NONLOCAL);
#endif
stack_save
= gen_rtx_MEM (sa_mode,
memory_address
(sa_mode,
plus_constant (expand_expr
(build_unary_op (ADDR_EXPR, NULL_TREE, buf),
NULL_RTX, VOIDmode, 0),
2 * GET_MODE_SIZE (Pmode))));
#ifdef HAVE_setjmp
if (HAVE_setjmp)
emit_insn (gen_setjmp ());
#endif
emit_stack_save (SAVE_NONLOCAL, &stack_save, NULL_RTX);
}
static tree
gnat_eh_runtime_type (type)
tree type;
{
return type;
}
static int
gnat_eh_type_covers (a, b)
tree a, b;
{
return (a == b || a == integer_zero_node);
}
void
adjust_decl_rtl (decl)
tree decl;
{
tree new_type;
if (TREE_CODE (decl) != CONST_DECL
&& ! DECL_BY_REF_P (decl)
&& (GET_CODE (DECL_RTL (decl)) == MEM
&& (GET_CODE (XEXP (DECL_RTL (decl), 0)) == MEM
|| (GET_CODE (XEXP (DECL_RTL (decl), 0)) == REG
&& (REGNO (XEXP (DECL_RTL (decl), 0))
> LAST_VIRTUAL_REGISTER))))
&& (new_type = build_reference_type (TREE_TYPE (decl))) != 0
&& TYPE_MODE (new_type) == GET_MODE (XEXP (DECL_RTL (decl), 0))
&& (TREE_CODE (decl) != PARM_DECL
|| (GET_CODE (DECL_INCOMING_RTL (decl)) == MEM
&& (TYPE_MODE (new_type)
== GET_MODE (XEXP (DECL_INCOMING_RTL (decl), 0)))
&& TREE_READONLY (decl))))
{
new_type
= build_qualified_type (new_type,
(TYPE_QUALS (new_type) | TYPE_QUAL_CONST));
DECL_POINTS_TO_READONLY_P (decl) = TREE_READONLY (decl);
DECL_BY_REF_P (decl) = 1;
SET_DECL_RTL (decl, XEXP (DECL_RTL (decl), 0));
TREE_TYPE (decl) = new_type;
DECL_MODE (decl) = TYPE_MODE (new_type);
DECL_ALIGN (decl) = TYPE_ALIGN (new_type);
DECL_SIZE (decl) = TYPE_SIZE (new_type);
if (TREE_CODE (decl) == PARM_DECL)
DECL_INCOMING_RTL (decl) = XEXP (DECL_INCOMING_RTL (decl), 0);
DECL_INITIAL (decl)
= build1 (ADDR_EXPR, new_type,
DECL_INITIAL (decl) != 0 ? DECL_INITIAL (decl) : decl);
}
}
void
record_code_position (gnat_node)
Node_Id gnat_node;
{
if (global_bindings_p ())
{
add_pending_elaborations (NULL_TREE, NULL_TREE);
save_gnu_tree (gnat_node, get_elaboration_location (), 1);
}
else
save_gnu_tree (gnat_node,
build (RTL_EXPR, void_type_node, NULL_TREE,
(tree) emit_note (0, NOTE_INSN_DELETED)),
1);
}
void
insert_code_for (gnat_node)
Node_Id gnat_node;
{
if (global_bindings_p ())
{
push_pending_elaborations ();
gnat_to_code (gnat_node);
Check_Elaboration_Code_Allowed (gnat_node);
insert_elaboration_list (get_gnu_tree (gnat_node));
pop_pending_elaborations ();
}
else
{
rtx insns;
do_pending_stack_adjust ();
start_sequence ();
mark_all_temps_used ();
gnat_to_code (gnat_node);
do_pending_stack_adjust ();
insns = get_insns ();
end_sequence ();
emit_insn_after (insns, RTL_EXPR_RTL (get_gnu_tree (gnat_node)));
}
}
static HOST_WIDE_INT
gnat_get_alias_set (type)
tree type;
{
if (TREE_CODE (type) == RECORD_TYPE
&& TYPE_IS_PADDING_P (type))
return get_alias_set (TREE_TYPE (TYPE_FIELDS (type)));
else if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
return
get_alias_set (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (type)))));
return -1;
}
int
default_pass_by_ref (gnu_type)
tree gnu_type;
{
CUMULATIVE_ARGS cum;
INIT_CUMULATIVE_ARGS (cum, NULL_TREE, NULL_RTX, 0);
return (0
#ifdef FUNCTION_ARG_PASS_BY_REFERENCE
|| FUNCTION_ARG_PASS_BY_REFERENCE (cum, TYPE_MODE (gnu_type),
gnu_type, 1)
#endif
|| RETURN_IN_MEMORY (gnu_type)
|| (AGGREGATE_TYPE_P (gnu_type)
&& (! host_integerp (TYPE_SIZE (gnu_type), 1)
|| 0 < compare_tree_int (TYPE_SIZE (gnu_type),
8 * TYPE_ALIGN (gnu_type)))));
}
int
must_pass_by_ref (gnu_type)
tree gnu_type;
{
return (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE
|| (AGGREGATE_TYPE_P (gnu_type) && TYPE_BY_REFERENCE_P (gnu_type))
|| (TYPE_SIZE (gnu_type) != 0
&& TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST));
}
int
gcc_version ()
{
return 3;
}