#include <stddef.h>
#include <math.h>
#include "config.h"
#include "system.h"
#include "coretypes.h"
#include "tm.h"
#include "tree.h"
#include "tm_p.h"
#include "defaults.h"
#include "ggc.h"
#include "diagnostic.h"
#include "langhooks.h"
#include "langhooks-def.h"
#include "toplev.h"
#include "opts.h"
#include "options.h"
#include "real.h"
#include "tree-iterator.h"
#include "function.h"
#include "cgraph.h"
#include "target.h"
#include "convert.h"
#include "tree-pass.h"
#include "tree-dump.h"
// temp for debugging
#include "stdio.h"
/* TODO:
* remove stmt_list_stack, save in if/case/loop block
* Re-add -v (if necessary)
*/
static tree type_for_size (unsigned int precision, int unsignedp);
const int tree_identifier_size = sizeof (struct tree_identifier);
struct GTY(()) binding_level
{
/* The BIND_EXPR node for this binding. */
tree bind;
/* The BLOCK node for this binding. */
tree block;
/* If true, stack must be saved (alloca is used). */
int save_stack;
/* Parent binding level. */
struct binding_level *prev;
/* Decls in this binding. */
tree first_decl;
tree last_decl;
/* Blocks in this binding. */
tree first_block;
tree last_block;
};
/* The current binding level. */
static GTY(()) struct binding_level *cur_binding_level = NULL;
/* Chain of unused binding levels. */
static GTY(()) struct binding_level *old_binding_levels = NULL;
/* Chain of statements currently generated. */
static GTY(()) tree cur_stmts = NULL_TREE;
static void
push_binding (void)
{
struct binding_level *res;
if (old_binding_levels == NULL)
res = ggc_alloc_binding_level ();
else
{
res = old_binding_levels;
old_binding_levels = res->prev;
}
/* Init. */
res->first_decl = NULL_TREE;
res->last_decl = NULL_TREE;
res->first_block = NULL_TREE;
res->last_block = NULL_TREE;
res->save_stack = 0;
res->bind = make_node (BIND_EXPR);
res->block = make_node (BLOCK);
BIND_EXPR_BLOCK (res->bind) = res->block;
TREE_SIDE_EFFECTS (res->bind) = true;
TREE_TYPE (res->bind) = void_type_node;
TREE_USED (res->block) = true;
if (cur_binding_level != NULL)
{
/* Append the block created. */
if (cur_binding_level->first_block == NULL)
cur_binding_level->first_block = res->block;
else
BLOCK_CHAIN (cur_binding_level->last_block) = res->block;
cur_binding_level->last_block = res->block;
BLOCK_SUPERCONTEXT (res->block) = cur_binding_level->block;
}
res->prev = cur_binding_level;
cur_binding_level = res;
}
static void
push_decl (tree decl)
{
DECL_CONTEXT (decl) = current_function_decl;
if (cur_binding_level->first_decl == NULL)
cur_binding_level->first_decl = decl;
else
TREE_CHAIN (cur_binding_level->last_decl) = decl;
cur_binding_level->last_decl = decl;
}
static tree
pop_binding (void)
{
tree res;
struct binding_level *cur;
cur = cur_binding_level;
res = cur->bind;
if (cur->save_stack)
{
tree tmp_var;
tree save;
tree save_call;
tree restore;
tree t;
/* Create an artificial var to save the stack pointer. */
tmp_var = build_decl (input_location, VAR_DECL, NULL, ptr_type_node);
DECL_ARTIFICIAL (tmp_var) = true;
DECL_IGNORED_P (tmp_var) = true;
TREE_USED (tmp_var) = true;
push_decl (tmp_var);
/* Create the save stmt. */
save_call = build_call_expr
(builtin_decl_implicit (BUILT_IN_STACK_SAVE), 0);
save = build2 (MODIFY_EXPR, ptr_type_node, tmp_var, save_call);
TREE_SIDE_EFFECTS (save) = true;
/* Create the restore stmt. */
restore = build_call_expr
(builtin_decl_implicit (BUILT_IN_STACK_RESTORE), 1, tmp_var);
/* Build a try-finally block.
The statement list is the block of current statements. */
t = build2 (TRY_FINALLY_EXPR, void_type_node, cur_stmts, NULL_TREE);
TREE_SIDE_EFFECTS (t) = true;
/* The finally block is the restore stmt. */
append_to_statement_list (restore, &TREE_OPERAND (t, 1));
/* The body of the BIND_BLOCK is the save stmt, followed by the
try block. */
BIND_EXPR_BODY (res) = NULL_TREE;
append_to_statement_list (save, &BIND_EXPR_BODY (res));
append_to_statement_list (t, &BIND_EXPR_BODY (res));
}
else
{
/* The body of the BIND_BLOCK is the statement block. */
BIND_EXPR_BODY (res) = cur_stmts;
}
BIND_EXPR_VARS (res) = cur->first_decl;
BLOCK_SUBBLOCKS (cur->block) = cur->first_block;
BLOCK_VARS (cur->block) = cur->first_decl;
cur_binding_level = cur->prev;
cur->prev = old_binding_levels;
old_binding_levels = cur;
return res;
}
/* This is a stack of current statement_lists */
//static GTY(()) VEC_tree_gc * stmt_list_stack;
// naive conversion to new vec API following the wiki at
// http://gcc.gnu.org/wiki/cxx-conversion/cxx-vec
// see also push_stmts, pop_stmts
static vec <tree> stmt_list_stack = vec<tree>();
static void
push_stmts (tree stmts)
{
// VEC_safe_push (tree, gc, stmt_list_stack, cur_stmts);
stmt_list_stack.safe_push(cur_stmts);
cur_stmts = stmts;
}
static void
pop_stmts (void)
{
// cur_stmts = VEC_pop (tree, stmt_list_stack);
cur_stmts = stmt_list_stack.pop();
}
static void
append_stmt (tree stmt)
{
if (!EXPR_HAS_LOCATION (stmt))
SET_EXPR_LOCATION (stmt, input_location);
TREE_SIDE_EFFECTS (stmt) = true;
append_to_statement_list (stmt, &cur_stmts);
}
static GTY(()) tree top;
static GTY(()) tree stack_alloc_function_ptr;
extern "C" void ortho_fe_init (void);
static bool
global_bindings_p (void)
{
return cur_binding_level->prev == NULL;
}
static tree
pushdecl (tree t)
{
//gcc_unreachable ();
// gcc4.8.2 we get here from build_common_builtin_nodes () call in ortho_init
return t;
}
static tree
builtin_function (const char *name,
tree type,
int function_code,
enum built_in_class decl_class,
const char *library_name,
tree attrs ATTRIBUTE_UNUSED);
REAL_VALUE_TYPE fp_const_p5; /* 0.5 */
REAL_VALUE_TYPE fp_const_m_p5; /* -0.5 */
REAL_VALUE_TYPE fp_const_zero; /* 0.0 */
static bool
ortho_init (void)
{
tree n;
input_location = BUILTINS_LOCATION;
/* Create a global binding. */
push_binding ();
build_common_tree_nodes (0, 0);
n = build_decl (input_location,
TYPE_DECL, get_identifier ("int"), integer_type_node);
push_decl (n);
n = build_decl (input_location,
TYPE_DECL, get_identifier ("char"), char_type_node);
push_decl (n);
/* Create alloca builtin. */
{
tree args_type = tree_cons (NULL_TREE, size_type_node, void_list_node);
tree func_type = build_function_type (ptr_type_node, args_type);
set_builtin_decl
(BUILT_IN_ALLOCA,
builtin_function
("__builtin_alloca", func_type,
BUILT_IN_ALLOCA, BUILT_IN_NORMAL, NULL, NULL_TREE), true);
stack_alloc_function_ptr = build1
(ADDR_EXPR,
build_pointer_type (func_type),
builtin_decl_implicit (BUILT_IN_ALLOCA));
}
{
tree ptr_ftype = build_function_type (ptr_type_node, NULL_TREE);
set_builtin_decl
(BUILT_IN_STACK_SAVE,
builtin_function
("__builtin_stack_save", ptr_ftype,
BUILT_IN_STACK_SAVE, BUILT_IN_NORMAL, NULL, NULL_TREE), true);
}
{
tree ftype_ptr;
ftype_ptr = build_function_type
(void_type_node,
tree_cons (NULL_TREE, ptr_type_node, NULL_TREE));
set_builtin_decl
(BUILT_IN_STACK_RESTORE,
builtin_function
("__builtin_stack_restore", ftype_ptr,
BUILT_IN_STACK_RESTORE, BUILT_IN_NORMAL, NULL, NULL_TREE), true);
}
{
REAL_VALUE_TYPE v;
REAL_VALUE_FROM_INT (v, 1, 0, DFmode);
real_ldexp (&fp_const_p5, &v, -1);
REAL_VALUE_FROM_INT (v, -1, -1, DFmode);
real_ldexp (&fp_const_m_p5, &v, -1);
REAL_VALUE_FROM_INT (fp_const_zero, 0, 0, DFmode);
}
ortho_fe_init ();
build_common_builtin_nodes ();
// FIXME: this MAY remove the need for creating the builtins above...
// Evaluate tree.c / build_common_builtin_nodes (); for each in turn.
return true;
}
static void
ortho_finish (void)
{
}
static unsigned int
ortho_option_lang_mask (void)
{
return CL_vhdl;
}
static bool
ortho_post_options (const char **pfilename)
{
if (*pfilename == NULL || strcmp (*pfilename, "-") == 0)
*pfilename = "*stdin*";
/* Default hook. */
lhd_post_options (pfilename);
// This stops compile failures writing debug information when both -g and -O2
// (or -O1, -O3 or -Os) options are present.
// Should really make it conditional on specific options
// FIXME : re-evaluate if this is still necessary with newer gccrevisions
dwarf_strict = 1;
/* Run the back-end. */
return false;
}
extern "C" bool lang_handle_option (const char *opt, const char *arg);
static bool
ortho_handle_option (size_t code, const char *arg, int value, int kind,
location_t loc,
const struct cl_option_handlers *handlers)
{
const char *opt;
opt = cl_options[code].opt_text;
switch (code)
{
case OPT__elab:
case OPT_l:
case OPT_c:
case OPT__anaelab:
/* Only a few options have a real arguments. */
return lang_handle_option (opt, arg);
default:
/* The other options must have a joint argument. */
if (arg != NULL)
{
size_t len1;
size_t len2;
char *nopt;
len1 = strlen (opt);
len2 = strlen (arg);
nopt = (char *) alloca (len1 + len2 + 1);
memcpy (nopt, opt, len1);
memcpy (nopt + len1, arg, len2);
nopt[len1 + len2] = 0;
opt = nopt;
}
return lang_handle_option (opt, NULL);
}
}
extern "C" int lang_parse_file (const char *filename);
static void
ortho_parse_file (void)
{
const char *filename;
if (num_in_fnames == 0)
filename = NULL;
else
filename = in_fnames[0];
linemap_add (line_table, LC_ENTER, 0, filename ? filename :"*no-file*", 1);
input_location = linemap_line_start (line_table, 1, 252);
if (!lang_parse_file (filename))
errorcount++;
linemap_add (line_table, LC_LEAVE, 0, NULL, 1);
}
/* Called by the back-end or by the front-end when the address of EXP
must be taken.
This function should found the base object (if any), and mark it as
addressable (via TREE_ADDRESSABLE). It may emit a warning if this
object cannot be addressable (front-end restriction).
Returns TRUE in case of success, FALSE in case of failure.
Note that the status is never checked by the back-end. */
static bool
ortho_mark_addressable (tree exp)
{
tree n;
n = exp;
while (1)
switch (TREE_CODE (n))
{
case VAR_DECL:
case CONST_DECL:
case PARM_DECL:
case RESULT_DECL:
TREE_ADDRESSABLE (n) = true;
return true;
case COMPONENT_REF:
case ARRAY_REF:
case ARRAY_RANGE_REF:
n = TREE_OPERAND (n, 0);
break;
case FUNCTION_DECL:
case CONSTRUCTOR:
TREE_ADDRESSABLE (n) = true;
return true;
case INDIRECT_REF:
return true;
default:
gcc_unreachable ();
}
}
static tree
ortho_truthvalue_conversion (tree expr)
{
tree expr_type;
tree t;
tree f;
expr_type = TREE_TYPE (expr);
if (TREE_CODE (expr_type) != BOOLEAN_TYPE)
{
t = integer_one_node;
f = integer_zero_node;
}
else
{
f = TYPE_MIN_VALUE (expr_type);
t = TYPE_MAX_VALUE (expr_type);
}
switch (TREE_CODE (expr))
{
case EQ_EXPR:
case NE_EXPR:
case LE_EXPR:
case GE_EXPR:
case LT_EXPR:
case GT_EXPR:
case TRUTH_ANDIF_EXPR:
case TRUTH_ORIF_EXPR:
case TRUTH_AND_EXPR:
case TRUTH_OR_EXPR:
case ERROR_MARK:
return expr;
case INTEGER_CST:
/* Not 0 is true. */
return integer_zerop (expr) ? f : t;
case REAL_CST:
return real_zerop (expr) ? f : t;
default:
gcc_unreachable ();
}
}
/* The following function has been copied and modified from c-convert.c. */
/* Change of width--truncation and extension of integers or reals--
is represented with NOP_EXPR. Proper functioning of many things
assumes that no other conversions can be NOP_EXPRs.
Conversion between integer and pointer is represented with CONVERT_EXPR.
Converting integer to real uses FLOAT_EXPR
and real to integer uses FIX_TRUNC_EXPR.
Here is a list of all the functions that assume that widening and
narrowing is always done with a NOP_EXPR:
In convert.c, convert_to_integer.
In c-typeck.c, build_binary_op (boolean ops), and
c_common_truthvalue_conversion.
In expr.c: expand_expr, for operands of a MULT_EXPR.
In fold-const.c: fold.
In tree.c: get_narrower and get_unwidened. */
/* Subroutines of `convert'. */
/* Create an expression whose value is that of EXPR,
converted to type TYPE. The TREE_TYPE of the value
is always TYPE. This function implements all reasonable
conversions; callers should filter out those that are
not permitted by the language being compiled. */
tree
convert (tree type, tree expr)
{
tree e = expr;
enum tree_code code = TREE_CODE (type);
const char *invalid_conv_diag;
if (type == error_mark_node
|| expr == error_mark_node
|| TREE_TYPE (expr) == error_mark_node)
return error_mark_node;
if ((invalid_conv_diag
= targetm.invalid_conversion (TREE_TYPE (expr), type)))
{
error (invalid_conv_diag);
return error_mark_node;
}
if (type == TREE_TYPE (expr))
return expr;
if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (expr)))
return fold_build1 (NOP_EXPR, type, expr);
if (TREE_CODE (TREE_TYPE (expr)) == ERROR_MARK)
return error_mark_node;
if (TREE_CODE (TREE_TYPE (expr)) == VOID_TYPE || code == VOID_TYPE)
{
gcc_unreachable ();
}
if (code == INTEGER_TYPE || code == ENUMERAL_TYPE)
return fold (convert_to_integer (type, e));
if (code == BOOLEAN_TYPE)
{
tree t = ortho_truthvalue_conversion (expr);
if (TREE_CODE (t) == ERROR_MARK)
return t;
/* If it returns a NOP_EXPR, we must fold it here to avoid
infinite recursion between fold () and convert (). */
if (TREE_CODE (t) == NOP_EXPR)
return fold_build1 (NOP_EXPR, type, TREE_OPERAND (t, 0));
else
return fold_build1 (NOP_EXPR, type, t);
}
if (code == POINTER_TYPE || code == REFERENCE_TYPE)
return fold (convert_to_pointer (type, e));
if (code == REAL_TYPE)
return fold (convert_to_real (type, e));
gcc_unreachable ();
}
/* Return a definition for a builtin function named NAME and whose data type
is TYPE. TYPE should be a function type with argument types.
FUNCTION_CODE tells later passes how to compile calls to this function.
See tree.h for its possible values.
If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME,
the name to be called if we can't opencode the function. If
ATTRS is nonzero, use that for the function's attribute list. */
static tree
builtin_function (const char *name,
tree type,
int function_code,
enum built_in_class decl_class,
const char *library_name,
tree attrs ATTRIBUTE_UNUSED)
{
tree decl = build_decl (input_location,
FUNCTION_DECL, get_identifier (name), type);
DECL_EXTERNAL (decl) = 1;
TREE_PUBLIC (decl) = 1;
if (library_name)
SET_DECL_ASSEMBLER_NAME (decl, get_identifier (library_name));
make_decl_rtl (decl);
DECL_BUILT_IN_CLASS (decl) = decl_class;
DECL_FUNCTION_CODE (decl) = (built_in_function) function_code;
DECL_SOURCE_LOCATION (decl) = input_location;
return decl;
}
#ifndef MAX_BITS_PER_WORD
#define MAX_BITS_PER_WORD BITS_PER_WORD
#endif
/* This variable keeps a table for types for each precision so that we only
allocate each of them once. Signed and unsigned types are kept separate.
*/
static GTY(()) tree signed_and_unsigned_types[MAX_BITS_PER_WORD + 1][2];
/* Return an integer type with the number of bits of precision given by
PRECISION. UNSIGNEDP is nonzero if the type is unsigned; otherwise
it is a signed type. */
static tree
type_for_size (unsigned int precision, int unsignedp)
{
tree t;
if (precision <= MAX_BITS_PER_WORD
&& signed_and_unsigned_types[precision][unsignedp] != NULL_TREE)
return signed_and_unsigned_types[precision][unsignedp];
if (unsignedp)
t = make_unsigned_type (precision);
else
t = make_signed_type (precision);
if (precision <= MAX_BITS_PER_WORD)
signed_and_unsigned_types[precision][unsignedp] = t;
else
// Handle larger requests by returning a NULL tree and letting
// the back end default to another approach.
// the exact test is unknown : distinguishing between 32 and 64 bits
// may be enough for all likely platforms
if (MAX_BITS_PER_WORD >= 64)
t = NULL_TREE;
return t;
}
/* Return a data type that has machine mode MODE. UNSIGNEDP selects
an unsigned type; otherwise a signed type is returned. */
static tree
type_for_mode (enum machine_mode mode, int unsignedp)
{
return type_for_size (GET_MODE_BITSIZE (mode), unsignedp);
}
#undef LANG_HOOKS_NAME
#define LANG_HOOKS_NAME "vhdl"
#undef LANG_HOOKS_IDENTIFIER_SIZE
#define LANG_HOOKS_IDENTIFIER_SIZE sizeof (struct tree_identifier)
#undef LANG_HOOKS_INIT
#define LANG_HOOKS_INIT ortho_init
#undef LANG_HOOKS_FINISH
#define LANG_HOOKS_FINISH ortho_finish
#undef LANG_HOOKS_OPTION_LANG_MASK
#define LANG_HOOKS_OPTION_LANG_MASK ortho_option_lang_mask
#undef LANG_HOOKS_HANDLE_OPTION
#define LANG_HOOKS_HANDLE_OPTION ortho_handle_option
#undef LANG_HOOKS_POST_OPTIONS
#define LANG_HOOKS_POST_OPTIONS ortho_post_options
#undef LANG_HOOKS_HONOR_READONLY
#define LANG_HOOKS_HONOR_READONLY true
#undef LANG_HOOKS_MARK_ADDRESSABLE
#define LANG_HOOKS_MARK_ADDRESSABLE ortho_mark_addressable
#undef LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION
#define LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION ortho_expand_function
#undef LANG_HOOKS_TYPE_FOR_MODE
#define LANG_HOOKS_TYPE_FOR_MODE type_for_mode
#undef LANG_HOOKS_TYPE_FOR_SIZE
#define LANG_HOOKS_TYPE_FOR_SIZE type_for_size
#undef LANG_HOOKS_SIGNED_TYPE
#define LANG_HOOKS_SIGNED_TYPE signed_type
#undef LANG_HOOKS_UNSIGNED_TYPE
#define LANG_HOOKS_UNSIGNED_TYPE unsigned_type
#undef LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE
#define LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE signed_or_unsigned_type
#undef LANG_HOOKS_PARSE_FILE
#define LANG_HOOKS_PARSE_FILE ortho_parse_file
#define pushlevel lhd_do_nothing_i
#define poplevel lhd_do_nothing_iii_return_null_tree
#define set_block lhd_do_nothing_t
#undef LANG_HOOKS_GETDECLS
#define LANG_HOOKS_GETDECLS lhd_return_null_tree_v
struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
union GTY((desc ("0"),
chain_next ("CODE_CONTAINS_STRUCT (TREE_CODE (&%h.generic), TS_COMMON) ? ((union lang_tree_node *) TREE_CHAIN (&%h.generic)) : NULL")))
lang_tree_node
{
union tree_node GTY((tag ("0"),
desc ("tree_node_structure (&%h)"))) generic;
};
/* GHDL does not use the lang_decl and lang_type.
FIXME: the variable_size annotation here is needed because these types are
variable-sized in some other front-ends. Due to gengtype deficiency, the
GTY options of such types have to agree across all front-ends. */
struct GTY((variable_size)) lang_type { char dummy; };
struct GTY((variable_size)) lang_decl { char dummy; };
struct GTY(()) language_function
{
char dummy;
};
extern "C" {
struct GTY(()) chain_constr_type
{
tree first;
tree last;
};
static void
chain_init (struct chain_constr_type *constr)
{
constr->first = NULL_TREE;
constr->last = NULL_TREE;
}
static void
chain_append (struct chain_constr_type *constr, tree el)
{
if (constr->first == NULL_TREE)
{
gcc_assert (constr->last == NULL_TREE);
constr->first = el;
}
else
TREE_CHAIN (constr->last) = el;
constr->last = el;
}
struct GTY(()) list_constr_type
{
tree first;
tree last;
};
static void
list_init (struct list_constr_type *constr)
{
constr->first = NULL_TREE;
constr->last = NULL_TREE;
}
static void
ortho_list_append (struct list_constr_type *constr, tree el)
{
tree res;
res = tree_cons (NULL_TREE, el, NULL_TREE);
if (constr->first == NULL_TREE)
constr->first = res;
else
TREE_CHAIN (constr->last) = res;
constr->last = res;
}
enum ON_op_kind {
/* Not an operation; invalid. */
ON_Nil,
/* Dyadic operations. */
ON_Add_Ov,
ON_Sub_Ov,
ON_Mul_Ov,
ON_Div_Ov,
ON_Rem_Ov,
ON_Mod_Ov,
/* Binary operations. */
ON_And,
ON_Or,
ON_Xor,
ON_And_Then,
ON_Or_Else,
/* Monadic operations. */
ON_Not,
ON_Neg_Ov,
ON_Abs_Ov,
/* Comparaisons */
ON_Eq,
ON_Neq,
ON_Le,
ON_Lt,
ON_Ge,
ON_Gt,
ON_LAST
};
static enum tree_code ON_op_to_TREE_CODE[ON_LAST] = {
ERROR_MARK,
PLUS_EXPR,
MINUS_EXPR,
MULT_EXPR,
ERROR_MARK,
TRUNC_MOD_EXPR,
FLOOR_MOD_EXPR,
TRUTH_AND_EXPR,
TRUTH_OR_EXPR,
TRUTH_XOR_EXPR,
TRUTH_ANDIF_EXPR,
TRUTH_ORIF_EXPR,
TRUTH_NOT_EXPR,
NEGATE_EXPR,
ABS_EXPR,
EQ_EXPR,
NE_EXPR,
LE_EXPR,
LT_EXPR,
GE_EXPR,
GT_EXPR,
};
tree
new_dyadic_op (enum ON_op_kind kind, tree left, tree right)
{
tree left_type;
enum tree_code code;
left_type = TREE_TYPE (left);
gcc_assert (left_type == TREE_TYPE (right));
switch (kind)
{
case ON_Div_Ov:
if (TREE_CODE (left_type) == REAL_TYPE)
code = RDIV_EXPR;
else
code = TRUNC_DIV_EXPR;
break;
default:
code = ON_op_to_TREE_CODE[kind];
break;
}
return build2 (code, left_type, left, right);
}
tree
new_monadic_op (enum ON_op_kind kind, tree operand)
{
return build1 (ON_op_to_TREE_CODE[kind], TREE_TYPE (operand), operand);
}
tree
new_compare_op (enum ON_op_kind kind, tree left, tree right, tree ntype)
{
gcc_assert (TREE_CODE (ntype) == BOOLEAN_TYPE);
gcc_assert (TREE_TYPE (left) == TREE_TYPE (right));
return build2 (ON_op_to_TREE_CODE[kind], ntype, left, right);
}
tree
new_convert_ov (tree val, tree rtype)
{
tree val_type;
enum tree_code val_code;
enum tree_code rtype_code;
enum tree_code code;
val_type = TREE_TYPE (val);
if (val_type == rtype)
return val;
/* FIXME: check conversions. */
val_code = TREE_CODE (val_type);
rtype_code = TREE_CODE (rtype);
if (val_code == POINTER_TYPE && rtype_code == POINTER_TYPE)
code = NOP_EXPR;
else if (val_code == INTEGER_TYPE && rtype_code == INTEGER_TYPE)
code = CONVERT_EXPR;
else if (val_code == REAL_TYPE && rtype_code == INTEGER_TYPE)
{
/* REAL to INTEGER
Gcc only handles FIX_TRUNC_EXPR, but we need rounding. */
tree m_p5;
tree p5;
tree zero;
tree saved;
tree comp;
tree adj;
tree res;
m_p5 = build_real (val_type, fp_const_m_p5);
p5 = build_real (val_type, fp_const_p5);
zero = build_real (val_type, fp_const_zero);
saved = save_expr (val);
comp = build2 (GE_EXPR, integer_type_node, saved, zero);
/* FIXME: instead of res = res + (comp ? .5 : -.5)
do: res = res (comp ? + : -) .5 */
adj = build3 (COND_EXPR, val_type, comp, p5, m_p5);
res = build2 (PLUS_EXPR, val_type, saved, adj);
res = build1 (FIX_TRUNC_EXPR, rtype, res);
return res;
}
else if (val_code == INTEGER_TYPE && rtype_code == ENUMERAL_TYPE)
code = CONVERT_EXPR;
else if (val_code == ENUMERAL_TYPE && rtype_code == INTEGER_TYPE)
code = CONVERT_EXPR;
else if (val_code == INTEGER_TYPE && rtype_code == REAL_TYPE)
code = FLOAT_EXPR;
else if (val_code == BOOLEAN_TYPE && rtype_code == BOOLEAN_TYPE)
code = NOP_EXPR;
else if (val_code == BOOLEAN_TYPE && rtype_code == INTEGER_TYPE)
code = CONVERT_EXPR;
else if (val_code == INTEGER_TYPE && rtype_code == BOOLEAN_TYPE)
code = NOP_EXPR;
else if (val_code == REAL_TYPE && rtype_code == REAL_TYPE)
code = NOP_EXPR;
else
gcc_unreachable ();
return build1 (code, rtype, val);
}
tree
new_alloca (tree rtype, tree size)
{
tree res;
/* Must save stack except when at function level. */
if (cur_binding_level->prev != NULL
&& cur_binding_level->prev->prev != NULL)
cur_binding_level->save_stack = 1;
res = build_call_nary (ptr_type_node, stack_alloc_function_ptr,
1, fold_convert (size_type_node, size));
return fold_convert (rtype, res);
}
tree
new_signed_literal (tree ltype, long long value)
{
tree res;
HOST_WIDE_INT lo;
HOST_WIDE_INT hi;
lo = value;
hi = (value >> 1) >> (8 * sizeof (HOST_WIDE_INT) - 1);
res = build_int_cst_wide (ltype, lo, hi);
return res;
}
tree
new_unsigned_literal (tree ltype, unsigned long long value)
{
tree res;
unsigned HOST_WIDE_INT lo;
unsigned HOST_WIDE_INT hi;
lo = value;
hi = (value >> 1) >> (8 * sizeof (HOST_WIDE_INT) - 1);
res = build_int_cst_wide (ltype, lo, hi);
return res;
}
tree
new_null_access (tree ltype)
{
tree res;
res = build_int_cst_wide (ltype, 0, 0);
return res;
}
tree
new_float_literal (tree ltype, double value)
{
signed long long s;
double frac;
int ex;
REAL_VALUE_TYPE r_sign;
REAL_VALUE_TYPE r_exp;
REAL_VALUE_TYPE r;
tree res;
HOST_WIDE_INT lo;
HOST_WIDE_INT hi;
frac = frexp (value, &ex);
s = ldexp (frac, 60);
lo = s;
hi = (s >> 1) >> (8 * sizeof (HOST_WIDE_INT) - 1);
res = build_int_cst_wide (long_integer_type_node, lo, hi);
REAL_VALUE_FROM_INT (r_sign, lo, hi, DFmode);
real_2expN (&r_exp, ex - 60, DFmode);
real_arithmetic (&r, MULT_EXPR, &r_sign, &r_exp);
res = build_real (ltype, r);
return res;
}
struct GTY(()) o_element_list
{
tree res;
struct chain_constr_type chain;
};
void
new_uncomplete_record_type (tree *res)
{
*res = make_node (RECORD_TYPE);
}
void
start_record_type (struct o_element_list *elements)
{
elements->res = make_node (RECORD_TYPE);
chain_init (&elements->chain);
}
void
start_uncomplete_record_type (tree res, struct o_element_list *elements)
{
elements->res = res;
chain_init (&elements->chain);
}
static void
new_record_union_field (struct o_element_list *list,
tree *el,
tree ident,
tree etype)
{
tree res;
res = build_decl (input_location,
FIELD_DECL, ident, etype);
DECL_CONTEXT (res) = list->res;
chain_append (&list->chain, res);
*el = res;
}
void
new_record_field (struct o_element_list *list,
tree *el,
tree ident,
tree etype)
{
return new_record_union_field (list, el, ident, etype);
}
void
finish_record_type (struct o_element_list *elements, tree *res)
{
TYPE_FIELDS (elements->res) = elements->chain.first;
layout_type (elements->res);
*res = elements->res;
if (TYPE_NAME (elements->res) != NULL_TREE)
{
/* The type was completed. */
rest_of_type_compilation (elements->res, 1);
}
}
void
start_union_type (struct o_element_list *elements)
{
elements->res = make_node (UNION_TYPE);
chain_init (&elements->chain);
}
void
new_union_field (struct o_element_list *elements,
tree *el,
tree ident,
tree etype)
{
return new_record_union_field (elements, el, ident, etype);
}
void
finish_union_type (struct o_element_list *elements, tree *res)
{
TYPE_FIELDS (elements->res) = elements->chain.first;
layout_type (elements->res);
*res = elements->res;
}
tree
new_unsigned_type (int size)
{
return make_unsigned_type (size);
}
tree
new_signed_type (int size)
{
return make_signed_type (size);
}
tree
new_float_type (void)
{
tree res;
res = make_node (REAL_TYPE);
TYPE_PRECISION (res) = DOUBLE_TYPE_SIZE;
layout_type (res);
return res;
}
tree
new_access_type (tree dtype)
{
tree res;
if (dtype == NULL_TREE)
{
res = make_node (POINTER_TYPE);
TREE_TYPE (res) = NULL_TREE;
/* Seems necessary. */
SET_TYPE_MODE (res, Pmode);
layout_type (res);
return res;
}
else
return build_pointer_type (dtype);
}
void
finish_access_type (tree atype, tree dtype)
{
gcc_assert (TREE_CODE (atype) == POINTER_TYPE
&& TREE_TYPE (atype) == NULL_TREE);
TREE_TYPE (atype) = dtype;
}
tree
new_array_type (tree el_type, tree index_type)
{
return build_array_type (el_type, index_type);
}
tree
new_constrained_array_type (tree atype, tree length)
{
tree range_type;
tree index_type;
tree len;
tree one;
tree res;
index_type = TYPE_DOMAIN (atype);
if (integer_zerop (length))
{
/* Handle null array, by creating a one-length array... */
len = size_zero_node;
}
else
{
one = build_int_cstu (index_type, 1);
len = build2 (MINUS_EXPR, index_type, length, one);
len = fold (len);
}
range_type = build_range_type (index_type, size_zero_node, len);
res = build_array_type (TREE_TYPE (atype), range_type);
/* Constrained arrays are *always* a subtype of its array type.
Just copy alias set. */
TYPE_ALIAS_SET (res) = get_alias_set (atype);
return res;
}
void
new_boolean_type (tree *res,
tree false_id, tree *false_e,
tree true_id, tree *true_e)
{
*res = make_node (BOOLEAN_TYPE);
TYPE_PRECISION (*res) = 1;
fixup_unsigned_type (*res);
*false_e = TYPE_MIN_VALUE (*res);
*true_e = TYPE_MAX_VALUE (*res);
}
struct o_enum_list
{
tree res;
struct chain_constr_type chain;
int num;
int size;
};
void
start_enum_type (struct o_enum_list *list, int size)
{
list->res = make_node (ENUMERAL_TYPE);
// as of gcc4.8, TYPE_PRECISION of 0 is rigorously enforced!
TYPE_PRECISION(list->res) = size;
chain_init (&list->chain);
list->num = 0;
list->size = size;
}
void
new_enum_literal (struct o_enum_list *list, tree ident, tree *res)
{
*res = build_int_cstu (list->res, (HOST_WIDE_INT)(list->num));
chain_append (&list->chain, tree_cons (ident, *res, NULL_TREE));
list->num++;
}
void
finish_enum_type (struct o_enum_list *list, tree *res)
{
*res = list->res;
TYPE_VALUES (*res) = list->chain.first;
TYPE_UNSIGNED (*res) = 1;
TYPE_PRECISION (*res) = list->size;
set_min_and_max_values_for_integral_type (*res, list->size, 1);
layout_type (*res);
}
struct GTY(()) o_record_aggr_list
{
/* Type of the record. */
tree atype;
/* Type of the next field to be added. */
tree field;
/* Vector of elements. */
// VEC(constructor_elt,gc) *elts;
vec<constructor_elt,va_gc> *elts;
};
void
start_record_aggr (struct o_record_aggr_list *list, tree atype)
{
list->atype = atype;
list->field = TYPE_FIELDS (atype);
//list->elts = VEC_alloc (constructor_elt, gc, fields_length (atype));
vec_alloc(list->elts, fields_length (atype));
}
void
new_record_aggr_el (struct o_record_aggr_list *list, tree value)
{
CONSTRUCTOR_APPEND_ELT (list->elts, list->field, value);
list->field = TREE_CHAIN (list->field);
}
void
finish_record_aggr (struct o_record_aggr_list *list, tree *res)
{
*res = build_constructor (list->atype, list->elts);
}
struct GTY(()) o_array_aggr_list
{
tree atype;
/* Vector of elements. */
//VEC(constructor_elt,gc) *elts;
vec<constructor_elt,va_gc> *elts;
};
void
start_array_aggr (struct o_array_aggr_list *list, tree atype)
{
tree nelts;
unsigned HOST_WIDE_INT n;
list->atype = atype;
list->elts = NULL;
nelts = array_type_nelts (atype);
gcc_assert (nelts != NULL_TREE && host_integerp (nelts, 1));
n = tree_low_cst (nelts, 1) + 1;
//list->elts = VEC_alloc (constructor_elt, gc, n);
vec_alloc(list->elts, n);
}
void
new_array_aggr_el (struct o_array_aggr_list *list, tree value)
{
CONSTRUCTOR_APPEND_ELT (list->elts, NULL_TREE, value);
}
void
finish_array_aggr (struct o_array_aggr_list *list, tree *res)
{
*res = build_constructor (list->atype, list->elts);
}
tree
new_union_aggr (tree atype, tree field, tree value)
{
tree res;
res = build_constructor_single (atype, field, value);
TREE_CONSTANT (res) = 1;
return res;
}
tree
new_indexed_element (tree arr, tree index)
{
ortho_mark_addressable (arr);
return build4 (ARRAY_REF, TREE_TYPE (TREE_TYPE (arr)),
arr, index, NULL_TREE, NULL_TREE);
}
tree
new_slice (tree arr, tree res_type, tree index)
{
#if 0
tree res;
tree el_ptr_type;
tree el_type;
tree res_ptr_type;
#endif
/* *((RES_TYPE *)(&ARR[INDEX]))
convert ARR to a pointer, add index, and reconvert to array ? */
gcc_assert (TREE_CODE (res_type) == ARRAY_TYPE);
ortho_mark_addressable (arr);
return build4 (ARRAY_RANGE_REF, res_type, arr, index, NULL_TREE, NULL_TREE);
#if 0
el_type = TREE_TYPE (TREE_TYPE (arr));
el_ptr_type = build_pointer_type (el_type);
res = build4 (ARRAY_REF, el_type, arr, index, NULL_TREE, NULL_TREE);
res = build1 (ADDR_EXPR, el_ptr_type, res);
res_ptr_type = build_pointer_type (res_type);
res = build1 (NOP_EXPR, res_ptr_type, res);
res = build1 (INDIRECT_REF, res_type, res);
return res;
#endif
}
tree
new_selected_element (tree rec, tree el)
{
tree res;
gcc_assert (TREE_CODE (TREE_TYPE (rec)) == RECORD_TYPE);
res = build3 (COMPONENT_REF, TREE_TYPE (el), rec, el, NULL_TREE);
return res;
}
tree
new_access_element (tree acc)
{
tree acc_type;
acc_type = TREE_TYPE (acc);
gcc_assert (TREE_CODE (acc_type) == POINTER_TYPE);
return build1 (INDIRECT_REF, TREE_TYPE (acc_type), acc);
}
tree
new_offsetof (tree field, tree rtype)
{
tree off;
tree bit_off;
HOST_WIDE_INT pos;
tree res;
off = DECL_FIELD_OFFSET (field);
/* The offset must be a constant. */
gcc_assert (host_integerp (off, 1));
bit_off = DECL_FIELD_BIT_OFFSET (field);
/* The offset must be a constant. */
gcc_assert (host_integerp (bit_off, 1));
pos = TREE_INT_CST_LOW (off)
+ (TREE_INT_CST_LOW (bit_off) / BITS_PER_UNIT);
res = build_int_cstu (rtype, pos);
return res;
}
tree
new_sizeof (tree atype, tree rtype)
{
tree size;
size = TYPE_SIZE_UNIT (atype);
return fold (build1 (NOP_EXPR, rtype, size));
}
/* Convert the array expression EXP to a pointer. */
static tree array_to_pointer_conversion (tree exp);
static tree
ortho_build_addr (tree lvalue, tree atype)
{
tree res;
if (TREE_CODE (lvalue) == INDIRECT_REF)
{
/* ADDR_REF(INDIRECT_REF(x)) -> x. */
res = TREE_OPERAND (lvalue, 0);
}
else
{
/* &base[off] -> base+off. */
if (TREE_CODE (lvalue) == ARRAY_REF
|| TREE_CODE (lvalue) == ARRAY_RANGE_REF)
{
tree base = TREE_OPERAND (lvalue, 0);
tree idx = TREE_OPERAND (lvalue, 1);
tree offset;
tree base_type;
ortho_mark_addressable (base);
idx = fold_convert (sizetype, idx);
offset = fold_build2 (MULT_EXPR, sizetype, idx,
array_ref_element_size (lvalue));
base = array_to_pointer_conversion (base);
base_type = TREE_TYPE (base);
res = build2 (POINTER_PLUS_EXPR, base_type, base, offset);
}
else
{
ortho_mark_addressable (lvalue);
if (TREE_TYPE (lvalue) != TREE_TYPE (atype))
{
tree ptr;
ptr = build_pointer_type (TREE_TYPE (lvalue));
res = build1 (ADDR_EXPR, ptr, lvalue);
}
else
res = build1 (ADDR_EXPR, atype, lvalue);
}
res = fold (res);
}
if (TREE_TYPE (res) != atype)
res = fold_build1 (NOP_EXPR, atype, res);
return res;
}
/* Convert the array expression EXP to a pointer. */
static tree
array_to_pointer_conversion (tree exp)
{
tree type = TREE_TYPE (exp);
tree adr;
tree restype = TREE_TYPE (type);
tree ptrtype;
gcc_assert (TREE_CODE (type) == ARRAY_TYPE);
/* Create a pointer to elements. */
ptrtype = build_pointer_type (restype);
switch (TREE_CODE (exp))
{
case INDIRECT_REF:
return convert (ptrtype, TREE_OPERAND (exp, 0));
case VAR_DECL:
/* Convert array to pointer to elements. */
adr = build1 (ADDR_EXPR, ptrtype, exp);
ortho_mark_addressable (exp);
TREE_SIDE_EFFECTS (adr) = 0; /* Default would be, same as EXP. */
return adr;
default:
/* Get address. */
return ortho_build_addr (exp, ptrtype);
}
}
tree
new_unchecked_address (tree lvalue, tree atype)
{
return ortho_build_addr (lvalue, atype);
}
tree
new_address (tree lvalue, tree atype)
{
return ortho_build_addr (lvalue, atype);
}
tree
new_global_address (tree lvalue, tree atype)
{
return ortho_build_addr (lvalue, atype);
}
tree
new_global_unchecked_address (tree lvalue, tree atype)
{
return ortho_build_addr (lvalue, atype);
}
/* Return a pointer to function FUNC. */
static tree
build_function_ptr (tree func)
{
return build1 (ADDR_EXPR,
build_pointer_type (TREE_TYPE (func)), func);
}
tree
new_subprogram_address (tree subprg, tree atype)
{
return fold (build1 (NOP_EXPR, atype, build_function_ptr (subprg)));
}
tree
new_value (tree lvalue)
{
return lvalue;
}
void
new_debug_line_decl (int line)
{
input_location = linemap_line_start (line_table, line, 252);
}
void
new_type_decl (tree ident, tree atype)
{
tree decl;
TYPE_NAME (atype) = ident;
decl = build_decl (input_location, TYPE_DECL, ident, atype);
TYPE_STUB_DECL (atype) = decl;
push_decl (decl);
/*
if Get_TYPE_SIZE (Ttype) /= NULL_TREE then
-- Do not generate debug info for uncompleted types.
Rest_Of_Type_Compilation (Ttype, C_True);
end if;
*/
}
enum o_storage { o_storage_external,
o_storage_public,
o_storage_private,
o_storage_local };
static void
set_storage (tree Node, enum o_storage storage)
{
switch (storage)
{
case o_storage_external:
DECL_EXTERNAL (Node) = 1;
TREE_PUBLIC (Node) = 1;
TREE_STATIC (Node) = 0;
break;
case o_storage_public:
DECL_EXTERNAL (Node) = 0;
TREE_PUBLIC (Node) = 1;
TREE_STATIC (Node) = 1;
break;
case o_storage_private:
DECL_EXTERNAL (Node) = 0;
TREE_PUBLIC (Node) = 0;
TREE_STATIC (Node) = 1;
break;
case o_storage_local:
DECL_EXTERNAL (Node) = 0;
TREE_PUBLIC (Node) = 0;
TREE_STATIC (Node) = 0;
break;
}
}
void
new_const_decl (tree *res, tree ident, enum o_storage storage, tree atype)
{
tree cst;
cst = build_decl (input_location, VAR_DECL, ident, atype);
set_storage (cst, storage);
TREE_READONLY (cst) = 1;
push_decl (cst);
switch (storage)
{
case o_storage_local:
gcc_unreachable ();
case o_storage_external:
/* We are at top level if Current_Function_Decl is null. */
rest_of_decl_compilation
(cst, current_function_decl == NULL_TREE, 0);
break;
case o_storage_public:
case o_storage_private:
break;
}
*res = cst;
}
void
start_const_value (tree *cst)
{
}
void
finish_const_value (tree *cst, tree val)
{
DECL_INITIAL (*cst) = val;
TREE_CONSTANT (val) = 1;
TREE_STATIC (*cst) = 1;
rest_of_decl_compilation
(*cst, current_function_decl == NULL_TREE, 0);
}
void
new_var_decl (tree *res, tree ident, enum o_storage storage, tree atype)
{
tree var;
var = build_decl (input_location, VAR_DECL, ident, atype);
if (current_function_decl != NULL_TREE)
{
/* Local variable. */
TREE_STATIC (var) = 0;
DECL_EXTERNAL (var) = 0;
TREE_PUBLIC (var) = 0;
}
else
set_storage (var, storage);
push_decl (var);
if (current_function_decl == NULL_TREE)
rest_of_decl_compilation (var, 1, 0);
*res = var;
}
struct GTY(()) o_inter_list
{
tree ident;
enum o_storage storage;
/* Return type. */
tree rtype;
/* List of parameter types. */
struct list_constr_type param_list;
/* Chain of parameters declarations. */
struct chain_constr_type param_chain;
};
void
start_function_decl (struct o_inter_list *interfaces,
tree ident,
enum o_storage storage,
tree rtype)
{
interfaces->ident = ident;
interfaces->storage = storage;
interfaces->rtype = rtype;
chain_init (&interfaces->param_chain);
list_init (&interfaces->param_list);
}
void
start_procedure_decl (struct o_inter_list *interfaces,
tree ident,
enum o_storage storage)
{
start_function_decl (interfaces, ident, storage, void_type_node);
}
void
new_interface_decl (struct o_inter_list *interfaces,
tree *res,
tree ident,
tree atype)
{
tree r;
r = build_decl (input_location, PARM_DECL, ident, atype);
/* DECL_CONTEXT (Res, Xxx); */
/* Do type conversion: convert boolean and enums to int */
switch (TREE_CODE (atype))
{
case ENUMERAL_TYPE:
case BOOLEAN_TYPE:
DECL_ARG_TYPE (r) = integer_type_node;
default:
DECL_ARG_TYPE (r) = atype;
}
layout_decl (r, 0);
chain_append (&interfaces->param_chain, r);
ortho_list_append (&interfaces->param_list, atype);
*res = r;
}
void
finish_subprogram_decl (struct o_inter_list *interfaces, tree *res)
{
tree decl;
tree result;
tree parm;
int is_global;
/* Append a void type in the parameter types chain, so that the function
is known not be have variables arguments. */
ortho_list_append (&interfaces->param_list, void_type_node);
decl = build_decl (input_location, FUNCTION_DECL, interfaces->ident,
build_function_type (interfaces->rtype,
interfaces->param_list.first));
DECL_SOURCE_LOCATION (decl) = input_location;
is_global = current_function_decl == NULL_TREE
|| interfaces->storage == o_storage_external;
if (is_global)
set_storage (decl, interfaces->storage);
else
{
/* A nested subprogram. */
DECL_EXTERNAL (decl) = 0;
TREE_PUBLIC (decl) = 0;
}
/* The function exist in static storage. */
TREE_STATIC (decl) = 1;
DECL_INITIAL (decl) = error_mark_node;
TREE_ADDRESSABLE (decl) = 1;
/* Declare the result.
FIXME: should be moved in start_function_body. */
result = build_decl (input_location,
RESULT_DECL, NULL_TREE, interfaces->rtype);
DECL_RESULT (decl) = result;
DECL_CONTEXT (result) = decl;
DECL_ARGUMENTS (decl) = interfaces->param_chain.first;
/* Set DECL_CONTEXT of parameters. */
for (parm = interfaces->param_chain.first;
parm != NULL_TREE;
parm = TREE_CHAIN (parm))
DECL_CONTEXT (parm) = decl;
push_decl (decl);
/* External functions are never nested.
Remove their context, which is set by push_decl. */
if (interfaces->storage == o_storage_external)
DECL_CONTEXT (decl) = NULL_TREE;
if (is_global)
rest_of_decl_compilation (decl, 1, 0);
*res = decl;
}
void
start_subprogram_body (tree func)
{
gcc_assert (current_function_decl == DECL_CONTEXT (func));
current_function_decl = func;
/* The function is not anymore external. */
DECL_EXTERNAL (func) = 0;
push_stmts (alloc_stmt_list ());
push_binding ();
}
void
finish_subprogram_body (void)
{
tree bind;
tree func;
tree parent;
bind = pop_binding ();
pop_stmts ();
func = current_function_decl;
DECL_INITIAL (func) = BIND_EXPR_BLOCK (bind);
DECL_SAVED_TREE (func) = bind;
/* Initialize the RTL code for the function. */
allocate_struct_function (func, false);
/* Store the end of the function. */
cfun->function_end_locus = input_location;
parent = DECL_CONTEXT (func);
if (parent != NULL)
cgraph_get_create_node (func);
else
cgraph_finalize_function (func, false);
current_function_decl = parent;
set_cfun (NULL);
}
void
new_debug_line_stmt (int line)
{
input_location = linemap_line_start (line_table, line, 252);
}
void
start_declare_stmt (void)
{
push_stmts (alloc_stmt_list ());
push_binding ();
}
void
finish_declare_stmt (void)
{
tree bind;
bind = pop_binding ();
pop_stmts ();
append_stmt (bind);
}
struct GTY(()) o_assoc_list
{
tree subprg;
// VEC(tree,gc) *vec;
vec<tree, va_gc> *vecptr;
};
void
start_association (struct o_assoc_list *assocs, tree subprg)
{
assocs->subprg = subprg;
assocs->vecptr = NULL;
}
void
new_association (struct o_assoc_list *assocs, tree val)
{
// VEC_safe_push (tree, gc, assocs->vec, val);
vec_safe_push(assocs->vecptr, val);
}
tree
new_function_call (struct o_assoc_list *assocs)
{
return build_call_vec (TREE_TYPE (TREE_TYPE (assocs->subprg)),
build_function_ptr (assocs->subprg),
assocs->vecptr);
}
void
new_procedure_call (struct o_assoc_list *assocs)
{
tree res;
res = build_call_vec (TREE_TYPE (TREE_TYPE (assocs->subprg)),
build_function_ptr (assocs->subprg),
assocs->vecptr);
TREE_SIDE_EFFECTS (res) = 1;
append_stmt (res);
}
void
new_assign_stmt (tree target, tree value)
{
tree n;
n = build2 (MODIFY_EXPR, TREE_TYPE (target), target, value);
TREE_SIDE_EFFECTS (n) = 1;
append_stmt (n);
}
void
new_func_return_stmt (tree value)
{
tree assign;
tree stmt;
tree res;
res = DECL_RESULT (current_function_decl);
assign = build2 (MODIFY_EXPR, TREE_TYPE (value), res, value);
TREE_SIDE_EFFECTS (assign) = 1;
stmt = build1 (RETURN_EXPR, void_type_node, assign);
TREE_SIDE_EFFECTS (stmt) = 1;
append_stmt (stmt);
}
void
new_proc_return_stmt (void)
{
tree stmt;
stmt = build1 (RETURN_EXPR, void_type_node, NULL_TREE);
TREE_SIDE_EFFECTS (stmt) = 1;
append_stmt (stmt);
}
struct GTY(()) o_if_block
{
tree stmt;
};
void
start_if_stmt (struct o_if_block *block, tree cond)
{
tree stmt;
tree stmts;
stmts = alloc_stmt_list ();
stmt = build3 (COND_EXPR, void_type_node, cond, stmts, NULL_TREE);
block->stmt = stmt;
append_stmt (stmt);
push_stmts (stmts);
}
void
new_elsif_stmt (struct o_if_block *block, tree cond)
{
tree stmts;
tree stmt;
pop_stmts ();
stmts = alloc_stmt_list ();
stmt = build3 (COND_EXPR, void_type_node, cond, stmts, NULL_TREE);
COND_EXPR_ELSE (block->stmt) = stmt;
block->stmt = stmt;
push_stmts (stmts);
}
void
new_else_stmt (struct o_if_block *block)
{
tree stmts;
pop_stmts ();
stmts = alloc_stmt_list ();
COND_EXPR_ELSE (block->stmt) = stmts;
push_stmts (stmts);
}
void
finish_if_stmt (struct o_if_block *block)
{
pop_stmts ();
}
struct GTY(()) o_snode
{
tree beg_label;
tree end_label;
};
/* Create an artificial label. */
static tree
build_label (void)
{
tree res;
res = build_decl (input_location, LABEL_DECL, NULL_TREE, void_type_node);
DECL_CONTEXT (res) = current_function_decl;
DECL_ARTIFICIAL (res) = 1;
return res;
}
void
start_loop_stmt (struct o_snode *label)
{
tree stmt;
label->beg_label = build_label ();
stmt = build1 (LABEL_EXPR, void_type_node, label->beg_label);
append_stmt (stmt);
label->end_label = build_label ();
}
void
finish_loop_stmt (struct o_snode *label)
{
tree stmt;
stmt = build1 (GOTO_EXPR, void_type_node, label->beg_label);
TREE_USED (label->beg_label) = 1;
append_stmt (stmt);
/* Emit the end label only if there is a goto to it.
(Return may be used to exit from the loop). */
if (TREE_USED (label->end_label))
{
stmt = build1 (LABEL_EXPR, void_type_node, label->end_label);
append_stmt (stmt);
}
}
void
new_exit_stmt (struct o_snode *l)
{
tree stmt;
stmt = build1 (GOTO_EXPR, void_type_node, l->end_label);
append_stmt (stmt);
TREE_USED (l->end_label) = 1;
}
void
new_next_stmt (struct o_snode *l)
{
tree stmt;
stmt = build1 (GOTO_EXPR, void_type_node, l->beg_label);
TREE_USED (l->beg_label) = 1;
append_stmt (stmt);
}
struct GTY(()) o_case_block
{
tree end_label;
int add_break;
};
static GTY(()) tree t_condtype = NULL_TREE;
static vec <tree> t_condtype_stack = vec<tree>();
void
start_case_stmt (struct o_case_block *block, tree value)
{
tree stmt;
tree stmts;
// following https://bitbucket.org/goshawk/gdc/issue/344/compilation-with-latest-trunk-fails
// gimplify_switch_expr now checks type of index expr is (some discrete type) but at least not void
// Saved in static variable t_condtype for start_choice to use
//
// Static variable is inadequate : nested Case statements won't work, so we either:
// need to stack t_condtypes, or add a parameter to start_choice, which affects
// translation.adb and the interface to ALL backends, mcode etc. I think this is less ugly.
t_condtype_stack.safe_push(t_condtype);
t_condtype = TREE_TYPE(value);
block->end_label = build_label ();
block->add_break = 0;
stmts = alloc_stmt_list ();
stmt = build3 (SWITCH_EXPR, t_condtype, value, stmts, NULL_TREE);
append_stmt (stmt);
push_stmts (stmts);
}
void
start_choice (struct o_case_block *block)
{
tree stmt;
if (block->add_break)
{
// following https://bitbucket.org/goshawk/gdc/issue/344/compilation-with-latest-trunk-fails
// gimplify_switch_expr now checks type of index expr is (saved) t_condtype
stmt = build1 (GOTO_EXPR, t_condtype, block->end_label);
append_stmt (stmt);
block->add_break = 0;
}
}
void
new_expr_choice (struct o_case_block *block, tree expr)
{
tree stmt;
stmt = build_case_label
(expr, NULL_TREE, create_artificial_label (input_location));
append_stmt (stmt);
}
void
new_range_choice (struct o_case_block *block, tree low, tree high)
{
tree stmt;
stmt = build_case_label
(low, high, create_artificial_label (input_location));
append_stmt (stmt);
}
void
new_default_choice (struct o_case_block *block)
{
tree stmt;
stmt = build_case_label
(NULL_TREE, NULL_TREE, create_artificial_label (input_location));
append_stmt (stmt);
}
void
finish_choice (struct o_case_block *block)
{
block->add_break = 1;
}
void
finish_case_stmt (struct o_case_block *block)
{
tree stmt;
pop_stmts ();
stmt = build1 (LABEL_EXPR, void_type_node, block->end_label);
append_stmt (stmt);
// see start_case_stmt : restore t_condtype to handle outer case statement
t_condtype = t_condtype_stack.pop();
}
bool
compare_identifier_string (tree id, const char *str, size_t len)
{
if (IDENTIFIER_LENGTH (id) != len)
return false;
if (!memcmp (IDENTIFIER_POINTER (id), str, len))
return true;
else
return false;
}
void
get_identifier_string (tree id, const char **str, int *len)
{
*len = IDENTIFIER_LENGTH (id);
*str = IDENTIFIER_POINTER (id);
}
// C linkage wrappers for two (now C++) functions so that
// Ada code can call them without name mangling
tree get_identifier_with_length_c (const char *c, size_t s)
{
return get_identifier_with_length(c, s);
}
int toplev_main_c (int argc, char **argv)
{
return toplev_main(argc, argv);
}
void
debug_tree_c ( tree expr)
{
warning(OPT_Wall,"Debug tree");
debug_tree(expr);
}
} // end extern "C"
#include "debug.h"
#include "gt-vhdl-ortho-lang.h"
#include "gtype-vhdl.h"