#include "config.h"
#include "system.h"
#include "tree.h"
#include "rtl.h"
#include "errors.h"
#include "diagnostic.h"
#include "expr.h"
#include "ggc.h"
#include "flags.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"
extern FILE *asm_out_file;
extern int save_argc;
extern char **save_argv;
#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
static char const gnat_tree_code_type[] = {
'x',
#include "ada-tree.def"
};
#undef DEFTREECODE
#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH,
static int const gnat_tree_code_length[] = {
0,
#include "ada-tree.def"
};
#undef DEFTREECODE
#define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME,
static const char *gnat_tree_code_name[] = {
"@@dummy",
#include "ada-tree.def"
};
#undef DEFTREECODE
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));
extern void gnat_init_decl_processing PARAMS ((void));
static tree gnat_expand_constant PARAMS ((tree));
#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_HONOR_READONLY
#define LANG_HOOKS_HONOR_READONLY 1
#undef LANG_HOOKS_GET_ALIAS_SET
#define LANG_HOOKS_GET_ALIAS_SET gnat_get_alias_set
#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_EXPAND_CONSTANT
#define LANG_HOOKS_EXPAND_CONSTANT gnat_expand_constant
const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
extern int gnat_argc;
extern char **gnat_argv;
int flag_traditional;
int ggc_p = 1;
static void internal_error_function PARAMS ((const char *, va_list *));
static rtx gnat_expand_expr PARAMS ((tree, rtx, enum machine_mode,
enum expand_modifier));
static void gnat_adjust_rli PARAMS ((record_layout_info));
#if defined(MIPS_DEBUGGING_INFO) && defined(DWARF2_DEBUGGING_INFO)
static char *convert_ada_name_to_qualified_name PARAMS ((char *));
#endif
extern void __gnat_initialize PARAMS((void));
extern void adainit PARAMS((void));
extern void _ada_gnat1drv PARAMS((void));
int
yyparse ()
{
__gnat_initialize();
adainit ();
immediate_size_expand = 1;
_ada_gnat1drv ();
return 0;
}
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 = (char *) xmalloc (strlen (p) + 1);
warning ("`-gnat' misspelled as `-gant'");
strcpy (q, p);
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;
}
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;
}
void
lang_mark_tree (t)
tree t;
{
switch (TREE_CODE (t))
{
case FUNCTION_TYPE:
ggc_mark_tree (TYPE_CI_CO_LIST (t));
return;
case INTEGER_TYPE:
if (TYPE_MODULAR_P (t))
ggc_mark_tree (TYPE_MODULUS (t));
else if (TYPE_VAX_FLOATING_POINT_P (t))
;
else if (TYPE_HAS_ACTUAL_BOUNDS_P (t))
ggc_mark_tree (TYPE_ACTUAL_BOUNDS (t));
else
ggc_mark_tree (TYPE_INDEX_TYPE (t));
return;
case ENUMERAL_TYPE:
ggc_mark_tree (TYPE_RM_SIZE_ENUM (t));
return;
case ARRAY_TYPE:
ggc_mark_tree (TYPE_ACTUAL_BOUNDS (t));
return;
case RECORD_TYPE: case UNION_TYPE: case QUAL_UNION_TYPE:
ggc_mark_tree (TYPE_ADA_SIZE (t));
return;
case CONST_DECL:
ggc_mark_tree (DECL_CONST_CORRESPONDING_VAR (t));
return;
case FIELD_DECL:
ggc_mark_tree (DECL_ORIGINAL_FIELD (t));
return;
default:
return;
}
}
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;
{
lang_expand_expr = gnat_expand_expr;
memcpy ((char *) (tree_code_type + (int) LAST_AND_UNUSED_TREE_CODE),
(char *) gnat_tree_code_type,
((LAST_GNAT_TREE_CODE - (int) LAST_AND_UNUSED_TREE_CODE)
* sizeof (char *)));
memcpy ((char *) (tree_code_length + (int) LAST_AND_UNUSED_TREE_CODE),
(char *) gnat_tree_code_length,
((LAST_GNAT_TREE_CODE - (int) LAST_AND_UNUSED_TREE_CODE)
* sizeof (int)));
memcpy ((char *) (tree_code_name + (int) LAST_AND_UNUSED_TREE_CODE),
(char *) gnat_tree_code_name,
((LAST_GNAT_TREE_CODE - (int) LAST_AND_UNUSED_TREE_CODE)
* sizeof (char *)));
gnat_init_decl_processing ();
gnat_argv [gnat_argc] = (char *) filename;
gnat_argc++;
gnat_argv [gnat_argc] = 0;
set_internal_error_function (internal_error_function);
internal_reference_types ();
lang_attribute_common = 0;
set_lang_adjust_rli (gnat_adjust_rli);
#if defined(MIPS_DEBUGGING_INFO) && defined(DWARF2_DEBUGGING_INFO)
dwarf2out_set_demangle_name_func (convert_ada_name_to_qualified_name);
#endif
if (filename == 0)
filename = "";
return filename;
}
tree
maybe_build_cleanup (decl)
tree decl ATTRIBUTE_UNUSED;
{
return NULL_TREE;
}
void
copy_lang_decl (node)
tree node ATTRIBUTE_UNUSED;
{
}
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 rtx
gnat_expand_expr (exp, target, tmode, modifier)
tree exp;
rtx target;
enum machine_mode tmode;
enum expand_modifier modifier;
{
tree type = TREE_TYPE (exp);
tree inner_type;
tree new;
rtx result;
int align_ok;
switch (TREE_CODE (exp))
{
case TRANSFORM_EXPR:
gnat_to_code (TREE_COMPLEXITY (exp));
return const0_rtx;
break;
case UNCHECKED_CONVERT_EXPR:
inner_type = TREE_TYPE (TREE_OPERAND (exp, 0));
align_ok = (! SLOW_BYTE_ACCESS
|| TYPE_ALIGN_OK_P (type) || TYPE_ALIGN_OK_P (inner_type)
|| TYPE_ALIGN (inner_type) >= BIGGEST_ALIGNMENT
|| TYPE_ALIGN (type) <= TYPE_ALIGN (inner_type));
if (target != 0 && GET_CODE (target) == MEM
&& (MEM_IN_STRUCT_P (target) != AGGREGATE_TYPE_P (inner_type)))
target = 0;
if (TYPE_MODE (type) == TYPE_MODE (inner_type)
&& align_ok
&& ! (TYPE_MODE (type) == BLKmode
&& ! operand_equal_p (TYPE_SIZE (type),
TYPE_SIZE (inner_type), 0)))
{
new = TREE_OPERAND (exp, 0);
if (TYPE_ALIGN (type) != TYPE_ALIGN (inner_type))
{
tree copy_type = copy_node (inner_type);
TYPE_ALIGN (copy_type) = TYPE_ALIGN (type);
if (DECL_P (new))
new = build1 (NOP_EXPR, copy_type, new);
else
{
if (TREE_CONSTANT (new))
new = copy_node (new);
TREE_TYPE (new) = copy_type;
}
}
}
else if ((TYPE_MODE (type) == BLKmode
|| TYPE_MODE (inner_type) == BLKmode)
&& align_ok)
new = build_unary_op (INDIRECT_REF, NULL_TREE,
convert
(build_pointer_type (type),
build_unary_op (ADDR_EXPR, NULL_TREE,
TREE_OPERAND (exp, 0))));
else
{
tree union_type, in_field, out_field;
if (TREE_ADDRESSABLE (exp))
gigi_abort (202);
union_type = make_node (UNION_TYPE);
in_field = create_field_decl (get_identifier ("in"),
inner_type, union_type, 0, 0, 0, 0);
out_field = create_field_decl (get_identifier ("out"),
type, union_type, 0, 0, 0, 0);
TYPE_FIELDS (union_type) = chainon (in_field, out_field);
layout_type (union_type);
TYPE_SIZE (union_type) = TYPE_SIZE (type);
TYPE_SIZE_UNIT (union_type) = TYPE_SIZE (type);
if (TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST
&& TREE_CODE (TYPE_SIZE (inner_type)) == INTEGER_CST)
{
TYPE_SIZE (union_type) = TYPE_SIZE (inner_type);
TYPE_SIZE_UNIT (union_type) = TYPE_SIZE_UNIT (inner_type);
}
new = build (COMPONENT_REF, type,
build1 (CONVERT_EXPR, union_type,
TREE_OPERAND (exp, 0)),
out_field);
}
result = expand_expr (new, target, tmode, modifier);
if (GET_CODE (result) == MEM)
{
set_mem_alias_set (result, 0);
set_mem_attributes (result, exp, 0);
}
return result;
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 tree
gnat_expand_constant (exp)
tree exp;
{
if (TREE_CODE (exp) == UNCHECKED_CONVERT_EXPR
&& operand_equal_p (TYPE_SIZE_UNIT (TREE_TYPE (exp)),
TYPE_SIZE_UNIT (TREE_TYPE (TREE_OPERAND (exp, 0))),
1)
&& TREE_CODE (TREE_OPERAND (exp, 0)) != CONSTRUCTOR)
return TREE_OPERAND (exp, 0);
return exp;
}
static void
gnat_adjust_rli (rli)
record_layout_info rli;
{
if (TYPE_PACKED (rli->t))
rli->record_align = rli->unpadded_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);
}
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;
start_sequence ();
mark_all_temps_used ();
gnat_to_code (gnat_node);
insns = get_insns ();
end_sequence ();
emit_insns_after (insns, RTL_EXPR_RTL (get_gnu_tree (gnat_node)));
}
}
#if 0
unsigned int
get_type_alignment (gnat_type)
Entity_Id gnat_type;
{
return TYPE_ALIGN (gnat_to_gnu_type (gnat_type)) / BITS_PER_UNIT;
}
#endif
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)));
return -1;
}
void
insert_default_attributes (decl)
tree decl ATTRIBUTE_UNUSED;
{
}
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));
}
#if defined(MIPS_DEBUGGING_INFO) && defined(DWARF2_DEBUGGING_INFO)
static char *
convert_ada_name_to_qualified_name (name)
char *name;
{
int len = strlen (name);
char *new_name = xstrdup (name);
char *buf;
int i, start;
char *qual_name_suffix = 0;
char *p;
if (len <= 3 || use_gnu_debug_info_extensions)
{
free (new_name);
return name;
}
for (p = (char *) index (&name[1], '_'); p != 0;
p = (char *) index (p+1, '_'))
if (p[1] == '_')
{
qual_name_suffix = p;
break;
}
if (qual_name_suffix == 0)
{
free (new_name);
return name;
}
start = qual_name_suffix - name;
buf = new_name + start;
for (i = start; i < len; i++)
{
if (name[i] == '_' && name[i + 1] == '_')
{
if (islower (name[i + 2]))
{
*buf++ = '.';
*buf++ = name[i + 2];
i += 2;
}
else if (name[i + 2] == '_' && islower (name[i + 3]))
{
*buf++ = '.';
*buf++ = name[i + 3];
i += 3;
}
else if (name[i + 2] == 'T')
{
*buf++ = '.';
*buf++ = '_';
*buf++ = '_';
*buf++ = 'T';
i += 3;
}
else
*buf++ = name[i];
}
else
*buf++ = name[i];
}
*buf = 0;
return new_name;
}
#endif
void
emit_unit_label (unitname_label, filename)
char *unitname_label;
char *filename ATTRIBUTE_UNUSED;
{
ASM_GLOBALIZE_LABEL (asm_out_file, unitname_label);
ASM_OUTPUT_LABEL (asm_out_file, unitname_label);
}