#include "real.h"
#include "tree-gimple.h"
#include "flags.h"
-#include <gmp.h>
#include <assert.h>
#include "gfortran.h"
+#include "arith.h"
#include "intrinsic.h"
#include "trans.h"
#include "trans-const.h"
intval = gfc_evaluate_now (intval, pblock);
tmp = convert (argtype, intval);
- cond = build (up ? GE_EXPR : LE_EXPR, boolean_type_node, tmp, arg);
+ cond = build2 (up ? GE_EXPR : LE_EXPR, boolean_type_node, tmp, arg);
- tmp = build (up ? PLUS_EXPR : MINUS_EXPR, type, intval,
- convert (type, integer_one_node));
- tmp = build (COND_EXPR, type, cond, intval, tmp);
+ tmp = build2 (up ? PLUS_EXPR : MINUS_EXPR, type, intval,
+ convert (type, integer_one_node));
+ tmp = build3 (COND_EXPR, type, cond, intval, tmp);
return tmp;
}
neg = build_real (argtype, r);
tmp = gfc_build_const (argtype, integer_zero_node);
- cond = fold (build (GT_EXPR, boolean_type_node, arg, tmp));
+ cond = fold (build2 (GT_EXPR, boolean_type_node, arg, tmp));
- tmp = fold (build (COND_EXPR, argtype, cond, pos, neg));
- tmp = fold (build (PLUS_EXPR, argtype, arg, tmp));
+ tmp = fold (build3 (COND_EXPR, argtype, cond, pos, neg));
+ tmp = fold (build2 (PLUS_EXPR, argtype, arg, tmp));
return fold (build1 (FIX_TRUNC_EXPR, type, tmp));
}
tree arg;
tree tmp;
tree cond;
- mpf_t huge;
+ mpfr_t huge;
int n;
int kind;
arg = gfc_evaluate_now (arg, &se->pre);
/* Test if the value is too large to handle sensibly. */
- mpf_init (huge);
+ gfc_set_model_kind (kind);
+ mpfr_init (huge);
n = gfc_validate_kind (BT_INTEGER, kind);
- mpf_set_z (huge, gfc_integer_kinds[n].huge);
- tmp = gfc_conv_mpf_to_tree (huge, kind);
- cond = build (LT_EXPR, boolean_type_node, arg, tmp);
-
- mpf_neg (huge, huge);
- tmp = gfc_conv_mpf_to_tree (huge, kind);
- tmp = build (GT_EXPR, boolean_type_node, arg, tmp);
- cond = build (TRUTH_AND_EXPR, boolean_type_node, cond, tmp);
+ mpfr_set_z (huge, gfc_integer_kinds[n].huge, GFC_RND_MODE);
+ tmp = gfc_conv_mpfr_to_tree (huge, kind);
+ cond = build2 (LT_EXPR, boolean_type_node, arg, tmp);
+
+ mpfr_neg (huge, huge, GFC_RND_MODE);
+ tmp = gfc_conv_mpfr_to_tree (huge, kind);
+ tmp = build2 (GT_EXPR, boolean_type_node, arg, tmp);
+ cond = build2 (TRUTH_AND_EXPR, boolean_type_node, cond, tmp);
itype = gfc_get_int_type (kind);
tmp = build_fix_expr (&se->pre, arg, itype, op);
tmp = convert (type, tmp);
- se->expr = build (COND_EXPR, type, cond, tmp, arg);
+ se->expr = build3 (COND_EXPR, type, cond, tmp, arg);
+ mpfr_clear (huge);
}
/* Mark it __attribute__((const)), if possible. */
TREE_READONLY (fndecl) = m->is_constant;
- rest_of_decl_compilation (fndecl, NULL, 1, 0);
+ rest_of_decl_compilation (fndecl, 1, 0);
(*pdecl) = fndecl;
return fndecl;
assert (se->ss->expr == expr);
gfc_advance_se_ss_chain (se);
bound = se->loop->loopvar[0];
- bound = fold (build (MINUS_EXPR, gfc_array_index_type, bound,
- se->loop->from[0]));
+ bound = fold (build2 (MINUS_EXPR, gfc_array_index_type, bound,
+ se->loop->from[0]));
}
else
{
gfc_add_block_to_block (&se->pre, &argse.pre);
bound = argse.expr;
/* Convert from one based to zero based. */
- bound = fold (build (MINUS_EXPR, gfc_array_index_type, bound,
- gfc_index_one_node));
+ bound = fold (build2 (MINUS_EXPR, gfc_array_index_type, bound,
+ gfc_index_one_node));
}
/* TODO: don't re-evaluate the descriptor on each iteration. */
if (flag_bounds_check)
{
bound = gfc_evaluate_now (bound, &se->pre);
- cond = fold (build (LT_EXPR, boolean_type_node, bound,
- convert (TREE_TYPE (bound), integer_zero_node)));
+ cond = fold (build2 (LT_EXPR, boolean_type_node,
+ bound, convert (TREE_TYPE (bound),
+ integer_zero_node)));
tmp = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))];
- tmp = fold (build (GE_EXPR, boolean_type_node, bound, tmp));
- cond = fold(build (TRUTH_ORIF_EXPR, boolean_type_node, cond, tmp));
+ tmp = fold (build2 (GE_EXPR, boolean_type_node, bound, tmp));
+ cond = fold(build2 (TRUTH_ORIF_EXPR, boolean_type_node, cond, tmp));
gfc_trans_runtime_check (cond, gfc_strconst_fault, &se->pre);
}
}
{
tree args;
tree val;
- tree fndecl;
+ int n;
args = gfc_conv_intrinsic_function_args (se, expr);
assert (args && TREE_CHAIN (args) == NULL_TREE);
switch (expr->ts.kind)
{
case 4:
- fndecl = gfor_fndecl_math_cabsf;
+ n = BUILT_IN_CABSF;
break;
case 8:
- fndecl = gfor_fndecl_math_cabs;
+ n = BUILT_IN_CABS;
break;
default:
abort ();
}
- se->expr = gfc_build_function_call (fndecl, args);
+ se->expr = fold (gfc_build_function_call (built_in_decls[n], args));
break;
default:
else
imag = build_real_from_int_cst (TREE_TYPE (type), integer_zero_node);
- se->expr = fold (build (COMPLEX_EXPR, type, real, imag));
+ se->expr = fold (build2 (COMPLEX_EXPR, type, real, imag));
}
/* Remainder function MOD(A, P) = A - INT(A / P) * P.
tree zero;
tree test;
tree test2;
- mpf_t huge;
+ mpfr_t huge;
int n;
arg = gfc_conv_intrinsic_function_args (se, expr);
{
case BT_INTEGER:
/* Integer case is easy, we've got a builtin op. */
- se->expr = build (TRUNC_MOD_EXPR, type, arg, arg2);
+ se->expr = build2 (TRUNC_MOD_EXPR, type, arg, arg2);
break;
case BT_REAL:
arg = gfc_evaluate_now (arg, &se->pre);
arg2 = gfc_evaluate_now (arg2, &se->pre);
- tmp = build (RDIV_EXPR, type, arg, arg2);
+ tmp = build2 (RDIV_EXPR, type, arg, arg2);
/* Test if the value is too large to handle sensibly. */
- mpf_init (huge);
+ gfc_set_model_kind (expr->ts.kind);
+ mpfr_init (huge);
n = gfc_validate_kind (BT_INTEGER, expr->ts.kind);
- mpf_set_z (huge, gfc_integer_kinds[n].huge);
- test = gfc_conv_mpf_to_tree (huge, expr->ts.kind);
- test2 = build (LT_EXPR, boolean_type_node, tmp, test);
+ mpfr_set_z (huge, gfc_integer_kinds[n].huge, GFC_RND_MODE);
+ test = gfc_conv_mpfr_to_tree (huge, expr->ts.kind);
+ test2 = build2 (LT_EXPR, boolean_type_node, tmp, test);
- mpf_neg (huge, huge);
- test = gfc_conv_mpf_to_tree (huge, expr->ts.kind);
- test = build (GT_EXPR, boolean_type_node, tmp, test);
- test2 = build (TRUTH_AND_EXPR, boolean_type_node, test, test2);
+ mpfr_neg (huge, huge, GFC_RND_MODE);
+ test = gfc_conv_mpfr_to_tree (huge, expr->ts.kind);
+ test = build2 (GT_EXPR, boolean_type_node, tmp, test);
+ test2 = build2 (TRUTH_AND_EXPR, boolean_type_node, test, test2);
itype = gfc_get_int_type (expr->ts.kind);
tmp = build_fix_expr (&se->pre, tmp, itype, FIX_TRUNC_EXPR);
tmp = convert (type, tmp);
- tmp = build (COND_EXPR, type, test2, tmp, arg);
- tmp = build (MULT_EXPR, type, tmp, arg2);
- se->expr = build (MINUS_EXPR, type, arg, tmp);
+ tmp = build3 (COND_EXPR, type, test2, tmp, arg);
+ tmp = build2 (MULT_EXPR, type, tmp, arg2);
+ se->expr = build2 (MINUS_EXPR, type, arg, tmp);
+ mpfr_clear (huge);
break;
default:
{
zero = gfc_build_const (type, integer_zero_node);
/* Build !(A > 0 .xor. P > 0). */
- test = build (GT_EXPR, boolean_type_node, arg, zero);
- test2 = build (GT_EXPR, boolean_type_node, arg2, zero);
- test = build (TRUTH_XOR_EXPR, boolean_type_node, test, test2);
+ test = build2 (GT_EXPR, boolean_type_node, arg, zero);
+ test2 = build2 (GT_EXPR, boolean_type_node, arg2, zero);
+ test = build2 (TRUTH_XOR_EXPR, boolean_type_node, test, test2);
test = build1 (TRUTH_NOT_EXPR, boolean_type_node, test);
/* Build (A == 0) .or. !(A > 0 .xor. P > 0). */
- test2 = build (EQ_EXPR, boolean_type_node, arg, zero);
- test = build (TRUTH_OR_EXPR, boolean_type_node, test, test2);
+ test2 = build2 (EQ_EXPR, boolean_type_node, arg, zero);
+ test = build2 (TRUTH_OR_EXPR, boolean_type_node, test, test2);
- se->expr = build (COND_EXPR, type, test, se->expr,
- build (PLUS_EXPR, type, se->expr, arg2));
+ se->expr = build3 (COND_EXPR, type, test, se->expr,
+ build2 (PLUS_EXPR, type, se->expr, arg2));
}
}
arg = TREE_VALUE (arg);
type = TREE_TYPE (arg);
- val = build (MINUS_EXPR, type, arg, arg2);
+ val = build2 (MINUS_EXPR, type, arg, arg2);
val = gfc_evaluate_now (val, &se->pre);
zero = gfc_build_const (type, integer_zero_node);
- tmp = build (LE_EXPR, boolean_type_node, val, zero);
- se->expr = build (COND_EXPR, type, tmp, zero, val);
+ tmp = build2 (LE_EXPR, boolean_type_node, val, zero);
+ se->expr = build3 (COND_EXPR, type, tmp, zero, val);
}
switch (expr->ts.kind)
{
case 4:
- tmp = gfor_fndecl_math_sign4;
+ tmp = built_in_decls[BUILT_IN_COPYSIGNF];
break;
case 8:
- tmp = gfor_fndecl_math_sign8;
+ tmp = built_in_decls[BUILT_IN_COPYSIGN];
break;
default:
abort ();
}
- se->expr = gfc_build_function_call (tmp, arg);
+ se->expr = fold (gfc_build_function_call (tmp, arg));
return;
}
type = TREE_TYPE (arg);
zero = gfc_build_const (type, integer_zero_node);
- testa = fold (build (GE_EXPR, boolean_type_node, arg, zero));
- testb = fold (build (GE_EXPR, boolean_type_node, arg2, zero));
- tmp = fold (build (TRUTH_XOR_EXPR, boolean_type_node, testa, testb));
- se->expr = fold (build (COND_EXPR, type, tmp,
- build1 (NEGATE_EXPR, type, arg), arg));
+ testa = fold (build2 (GE_EXPR, boolean_type_node, arg, zero));
+ testb = fold (build2 (GE_EXPR, boolean_type_node, arg2, zero));
+ tmp = fold (build2 (TRUTH_XOR_EXPR, boolean_type_node, testa, testb));
+ se->expr = fold (build3 (COND_EXPR, type, tmp,
+ build1 (NEGATE_EXPR, type, arg), arg));
}
type = gfc_typenode_for_spec (&expr->ts);
arg = convert (type, arg);
arg2 = convert (type, arg2);
- se->expr = build (MULT_EXPR, type, arg, arg2);
+ se->expr = build2 (MULT_EXPR, type, arg, arg2);
}
limit = gfc_evaluate_now(limit, &se->pre);
mvar = gfc_create_var (type, "M");
- elsecase = build_v (MODIFY_EXPR, mvar, limit);
+ elsecase = build2_v (MODIFY_EXPR, mvar, limit);
for (arg = TREE_CHAIN (arg); arg != NULL_TREE; arg = TREE_CHAIN (arg))
{
val = TREE_VALUE (arg);
if (TREE_CODE (val) != VAR_DECL && !TREE_CONSTANT (val))
val = gfc_evaluate_now(val, &se->pre);
- thencase = build_v (MODIFY_EXPR, mvar, convert (type, val));
+ thencase = build2_v (MODIFY_EXPR, mvar, convert (type, val));
- tmp = build (op, boolean_type_node, val, limit);
- tmp = build_v (COND_EXPR, tmp, thencase, elsecase);
+ tmp = build2 (op, boolean_type_node, val, limit);
+ tmp = build3_v (COND_EXPR, tmp, thencase, elsecase);
gfc_add_expr_to_block (&se->pre, tmp);
elsecase = build_empty_stmt ();
limit = mvar;
gfc_conv_expr_val (&arrayse, actual->expr);
gfc_add_block_to_block (&body, &arrayse.pre);
- tmp = build (op, boolean_type_node, arrayse.expr,
- fold_convert (TREE_TYPE (arrayse.expr),
- integer_zero_node));
- tmp = build_v (COND_EXPR, tmp, found, build_empty_stmt ());
+ tmp = build2 (op, boolean_type_node, arrayse.expr,
+ fold_convert (TREE_TYPE (arrayse.expr),
+ integer_zero_node));
+ tmp = build3_v (COND_EXPR, tmp, found, build_empty_stmt ());
gfc_add_expr_to_block (&body, tmp);
gfc_add_block_to_block (&body, &arrayse.post);
/* Generate the loop body. */
gfc_start_scalarized_body (&loop, &body);
- tmp = build (PLUS_EXPR, TREE_TYPE (resvar), resvar,
- convert (TREE_TYPE (resvar), integer_one_node));
- tmp = build_v (MODIFY_EXPR, resvar, tmp);
+ tmp = build2 (PLUS_EXPR, TREE_TYPE (resvar), resvar,
+ convert (TREE_TYPE (resvar), integer_one_node));
+ tmp = build2_v (MODIFY_EXPR, resvar, tmp);
gfc_init_se (&arrayse, NULL);
gfc_copy_loopinfo_to_se (&arrayse, &loop);
arrayse.ss = arrayss;
gfc_conv_expr_val (&arrayse, actual->expr);
- tmp = build_v (COND_EXPR, arrayse.expr, tmp, build_empty_stmt ());
+ tmp = build3_v (COND_EXPR, arrayse.expr, tmp, build_empty_stmt ());
gfc_add_block_to_block (&body, &arrayse.pre);
gfc_add_expr_to_block (&body, tmp);
gfc_conv_expr_val (&arrayse, arrayexpr);
gfc_add_block_to_block (&block, &arrayse.pre);
- tmp = build (op, type, resvar, arrayse.expr);
+ tmp = build2 (op, type, resvar, arrayse.expr);
gfc_add_modify_expr (&block, resvar, tmp);
gfc_add_block_to_block (&block, &arrayse.post);
/* We enclose the above in if (mask) {...} . */
tmp = gfc_finish_block (&block);
- tmp = build_v (COND_EXPR, maskse.expr, tmp, build_empty_stmt ());
+ tmp = build3_v (COND_EXPR, maskse.expr, tmp, build_empty_stmt ());
}
else
tmp = gfc_finish_block (&block);
switch (arrayexpr->ts.type)
{
case BT_REAL:
- tmp = gfc_conv_mpf_to_tree (gfc_real_kinds[n].huge, arrayexpr->ts.kind);
+ tmp = gfc_conv_mpfr_to_tree (gfc_real_kinds[n].huge, arrayexpr->ts.kind);
break;
case BT_INTEGER:
size we need to return zero. Otherwise use the first element of the
array, in case all elements are equal to the limit.
ie. pos = (ubound >= lbound) ? lbound, lbound - 1; */
- tmp = fold (build (MINUS_EXPR, gfc_array_index_type,
- loop.from[0], gfc_index_one_node));
- cond = fold (build (GE_EXPR, boolean_type_node,
- loop.to[0], loop.from[0]));
- tmp = fold (build (COND_EXPR, gfc_array_index_type, cond,
- loop.from[0], tmp));
+ tmp = fold (build2 (MINUS_EXPR, gfc_array_index_type,
+ loop.from[0], gfc_index_one_node));
+ cond = fold (build2 (GE_EXPR, boolean_type_node,
+ loop.to[0], loop.from[0]));
+ tmp = fold (build3 (COND_EXPR, gfc_array_index_type, cond,
+ loop.from[0], tmp));
gfc_add_modify_expr (&loop.pre, pos, tmp);
gfc_mark_ss_chain_used (arrayss, 1);
ifbody = gfc_finish_block (&ifblock);
/* If it is a more extreme value. */
- tmp = build (op, boolean_type_node, arrayse.expr, limit);
- tmp = build_v (COND_EXPR, tmp, ifbody, build_empty_stmt ());
+ tmp = build2 (op, boolean_type_node, arrayse.expr, limit);
+ tmp = build3_v (COND_EXPR, tmp, ifbody, build_empty_stmt ());
gfc_add_expr_to_block (&block, tmp);
if (maskss)
/* We enclose the above in if (mask) {...}. */
tmp = gfc_finish_block (&block);
- tmp = build_v (COND_EXPR, maskse.expr, tmp, build_empty_stmt ());
+ tmp = build3_v (COND_EXPR, maskse.expr, tmp, build_empty_stmt ());
}
else
tmp = gfc_finish_block (&block);
gfc_cleanup_loop (&loop);
/* Return a value in the range 1..SIZE(array). */
- tmp = fold (build (MINUS_EXPR, gfc_array_index_type, loop.from[0],
- gfc_index_one_node));
- tmp = fold (build (MINUS_EXPR, gfc_array_index_type, pos, tmp));
+ tmp = fold (build2 (MINUS_EXPR, gfc_array_index_type, loop.from[0],
+ gfc_index_one_node));
+ tmp = fold (build2 (MINUS_EXPR, gfc_array_index_type, pos, tmp));
/* And convert to the required type. */
se->expr = convert (type, tmp);
}
switch (expr->ts.type)
{
case BT_REAL:
- tmp = gfc_conv_mpf_to_tree (gfc_real_kinds[n].huge, expr->ts.kind);
+ tmp = gfc_conv_mpfr_to_tree (gfc_real_kinds[n].huge, expr->ts.kind);
break;
case BT_INTEGER:
gfc_add_block_to_block (&block, &arrayse.pre);
/* Assign the value to the limit... */
- ifbody = build_v (MODIFY_EXPR, limit, arrayse.expr);
+ ifbody = build2_v (MODIFY_EXPR, limit, arrayse.expr);
/* If it is a more extreme value. */
- tmp = build (op, boolean_type_node, arrayse.expr, limit);
- tmp = build_v (COND_EXPR, tmp, ifbody, build_empty_stmt ());
+ tmp = build2 (op, boolean_type_node, arrayse.expr, limit);
+ tmp = build3_v (COND_EXPR, tmp, ifbody, build_empty_stmt ());
gfc_add_expr_to_block (&block, tmp);
gfc_add_block_to_block (&block, &arrayse.post);
tmp = gfc_finish_block (&block);
if (maskss)
- {
- /* We enclose the above in if (mask) {...}. */
- tmp = build_v (COND_EXPR, maskse.expr, tmp, build_empty_stmt ());
- }
+ /* We enclose the above in if (mask) {...}. */
+ tmp = build3_v (COND_EXPR, maskse.expr, tmp, build_empty_stmt ());
gfc_add_expr_to_block (&body, tmp);
gfc_trans_scalarizing_loops (&loop, &body);
arg = TREE_VALUE (arg);
type = TREE_TYPE (arg);
- tmp = build (LSHIFT_EXPR, type, convert (type, integer_one_node), arg2);
- tmp = build (BIT_AND_EXPR, type, arg, tmp);
- tmp = fold (build (NE_EXPR, boolean_type_node, tmp,
- convert (type, integer_zero_node)));
+ tmp = build2 (LSHIFT_EXPR, type, convert (type, integer_one_node), arg2);
+ tmp = build2 (BIT_AND_EXPR, type, arg, tmp);
+ tmp = fold (build2 (NE_EXPR, boolean_type_node, tmp,
+ convert (type, integer_zero_node)));
type = gfc_typenode_for_spec (&expr->ts);
se->expr = convert (type, tmp);
}
arg = TREE_VALUE (arg);
type = TREE_TYPE (arg);
- se->expr = fold (build (op, type, arg, arg2));
+ se->expr = fold (build2 (op, type, arg, arg2));
}
/* Bitwise not. */
arg = TREE_VALUE (arg);
type = TREE_TYPE (arg);
- tmp = fold (build (LSHIFT_EXPR, type,
+ tmp = fold (build2 (LSHIFT_EXPR, type,
convert (type, integer_one_node), arg2));
if (set)
op = BIT_IOR_EXPR;
op = BIT_AND_EXPR;
tmp = fold (build1 (BIT_NOT_EXPR, type, tmp));
}
- se->expr = fold (build (op, type, arg, tmp));
+ se->expr = fold (build2 (op, type, arg, tmp));
}
/* Extract a sequence of bits.
arg2 = TREE_VALUE (arg2);
type = TREE_TYPE (arg);
- mask = build_int_2 (-1, ~(unsigned HOST_WIDE_INT) 0);
- mask = build (LSHIFT_EXPR, type, mask, arg3);
+ mask = build_int_cst (NULL_TREE, -1);
+ mask = build2 (LSHIFT_EXPR, type, mask, arg3);
mask = build1 (BIT_NOT_EXPR, type, mask);
- tmp = build (RSHIFT_EXPR, type, arg, arg2);
+ tmp = build2 (RSHIFT_EXPR, type, arg, arg2);
- se->expr = fold (build (BIT_AND_EXPR, type, tmp, mask));
+ se->expr = fold (build2 (BIT_AND_EXPR, type, tmp, mask));
}
/* ISHFT (I, SHIFT) = (shift >= 0) ? i << shift : i >> -shift. */
type = TREE_TYPE (arg);
/* Left shift if positive. */
- lshift = build (LSHIFT_EXPR, type, arg, arg2);
+ lshift = build2 (LSHIFT_EXPR, type, arg, arg2);
/* Right shift if negative. This will perform an arithmetic shift as
we are dealing with signed integers. Section 13.5.7 allows this. */
tmp = build1 (NEGATE_EXPR, TREE_TYPE (arg2), arg2);
- rshift = build (RSHIFT_EXPR, type, arg, tmp);
+ rshift = build2 (RSHIFT_EXPR, type, arg, tmp);
- tmp = build (GT_EXPR, boolean_type_node, arg2,
- convert (TREE_TYPE (arg2), integer_zero_node));
- rshift = build (COND_EXPR, type, tmp, lshift, rshift);
+ tmp = build2 (GT_EXPR, boolean_type_node, arg2,
+ convert (TREE_TYPE (arg2), integer_zero_node));
+ rshift = build3 (COND_EXPR, type, tmp, lshift, rshift);
/* Do nothing if shift == 0. */
- tmp = build (EQ_EXPR, boolean_type_node, arg2,
- convert (TREE_TYPE (arg2), integer_zero_node));
- se->expr = build (COND_EXPR, type, tmp, arg, rshift);
+ tmp = build2 (EQ_EXPR, boolean_type_node, arg2,
+ convert (TREE_TYPE (arg2), integer_zero_node));
+ se->expr = build3 (COND_EXPR, type, tmp, arg, rshift);
}
/* Circular shift. AKA rotate or barrel shift. */
type = TREE_TYPE (arg);
/* Rotate left if positive. */
- lrot = build (LROTATE_EXPR, type, arg, arg2);
+ lrot = build2 (LROTATE_EXPR, type, arg, arg2);
/* Rotate right if negative. */
tmp = build1 (NEGATE_EXPR, TREE_TYPE (arg2), arg2);
- rrot = build (RROTATE_EXPR, type, arg, tmp);
+ rrot = build2 (RROTATE_EXPR, type, arg, tmp);
- tmp = build (GT_EXPR, boolean_type_node, arg2,
- convert (TREE_TYPE (arg2), integer_zero_node));
- rrot = build (COND_EXPR, type, tmp, lrot, rrot);
+ tmp = build2 (GT_EXPR, boolean_type_node, arg2,
+ convert (TREE_TYPE (arg2), integer_zero_node));
+ rrot = build3 (COND_EXPR, type, tmp, lrot, rrot);
/* Do nothing if shift == 0. */
- tmp = build (EQ_EXPR, boolean_type_node, arg2,
- convert (TREE_TYPE (arg2), integer_zero_node));
- se->expr = build (COND_EXPR, type, tmp, arg, rrot);
+ tmp = build2 (EQ_EXPR, boolean_type_node, arg2,
+ convert (TREE_TYPE (arg2), integer_zero_node));
+ se->expr = build3 (COND_EXPR, type, tmp, arg, rrot);
}
/* The length of a character string. */
switch (arg->expr_type)
{
case EXPR_CONSTANT:
- len = build_int_2 (arg->value.character.length, 0);
+ len = build_int_cst (NULL_TREE, arg->value.character.length);
break;
default:
mask = TREE_VALUE (arg);
type = TREE_TYPE (tsource);
- se->expr = fold (build (COND_EXPR, type, mask, tsource, fsource));
+ se->expr = fold (build3 (COND_EXPR, type, mask, tsource, fsource));
}
se->expr = gfc_build_function_call (gfor_fndecl_compare_string, args);
type = gfc_typenode_for_spec (&expr->ts);
- se->expr = build (op, type, se->expr,
- convert (TREE_TYPE (se->expr), integer_zero_node));
+ se->expr = build2 (op, type, se->expr,
+ convert (TREE_TYPE (se->expr), integer_zero_node));
}
/* Generate a call to the adjustl/adjustr library function. */
gfc_conv_expr_descriptor (&arg1se, arg1->expr, ss1);
tmp = gfc_conv_descriptor_data (arg1se.expr);
- tmp = build (NE_EXPR, boolean_type_node, tmp,
- fold_convert (TREE_TYPE (tmp), null_pointer_node));
+ tmp = build2 (NE_EXPR, boolean_type_node, tmp,
+ fold_convert (TREE_TYPE (tmp), null_pointer_node));
se->expr = convert (gfc_typenode_for_spec (&expr->ts), tmp);
}
gfc_conv_expr_lhs (&arg1se, arg1->expr);
tmp2 = gfc_conv_descriptor_data (arg1se.expr);
}
- tmp = build (NE_EXPR, boolean_type_node, tmp2,
- fold_convert (TREE_TYPE (tmp2), null_pointer_node));
+ tmp = build2 (NE_EXPR, boolean_type_node, tmp2,
+ fold_convert (TREE_TYPE (tmp2), null_pointer_node));
se->expr = tmp;
}
else
gfc_conv_expr (&arg1se, arg1->expr);
arg2se.want_pointer = 1;
gfc_conv_expr (&arg2se, arg2->expr);
- tmp = build (EQ_EXPR, boolean_type_node, arg1se.expr, arg2se.expr);
+ tmp = build2 (EQ_EXPR, boolean_type_node, arg1se.expr, arg2se.expr);
se->expr = tmp;
}
else
/* Caculate the numbers of bits of exponent, fraction and word */
n = gfc_validate_kind (a1->ts.type, a1->ts.kind);
- tmp = build_int_2 (gfc_real_kinds[n].digits - 1, 0);
+ tmp = build_int_cst (NULL_TREE, gfc_real_kinds[n].digits - 1);
rcs->fdigits = convert (masktype, tmp);
- wbits = build_int_2 (TYPE_PRECISION (rcs->type) - 1, 0);
+ wbits = build_int_cst (NULL_TREE, TYPE_PRECISION (rcs->type) - 1);
wbits = convert (masktype, wbits);
- rcs->edigits = fold (build (MINUS_EXPR, masktype, wbits, tmp));
+ rcs->edigits = fold (build2 (MINUS_EXPR, masktype, wbits, tmp));
/* Form masks for exponent/fraction/sign */
one = gfc_build_const (masktype, integer_one_node);
- rcs->smask = fold (build (LSHIFT_EXPR, masktype, one, wbits));
- rcs->f1 = fold (build (LSHIFT_EXPR, masktype, one, rcs->fdigits));
- rcs->emask = fold (build (MINUS_EXPR, masktype, rcs->smask, rcs->f1));
- rcs->fmask = fold (build (MINUS_EXPR, masktype, rcs->f1, one));
+ rcs->smask = fold (build2 (LSHIFT_EXPR, masktype, one, wbits));
+ rcs->f1 = fold (build2 (LSHIFT_EXPR, masktype, one, rcs->fdigits));
+ rcs->emask = fold (build2 (MINUS_EXPR, masktype, rcs->smask, rcs->f1));
+ rcs->fmask = fold (build2 (MINUS_EXPR, masktype, rcs->f1, one));
/* Form bias. */
- tmp = fold (build (MINUS_EXPR, masktype, rcs->edigits, one));
- tmp = fold (build (LSHIFT_EXPR, masktype, one, tmp));
- rcs->bias = fold (build (MINUS_EXPR, masktype, tmp ,one));
+ tmp = fold (build2 (MINUS_EXPR, masktype, rcs->edigits, one));
+ tmp = fold (build2 (LSHIFT_EXPR, masktype, one, tmp));
+ rcs->bias = fold (build2 (MINUS_EXPR, masktype, tmp ,one));
if (all)
{
/* exponent, and fraction */
- tmp = build (BIT_AND_EXPR, masktype, arg, rcs->emask);
- tmp = build (RSHIFT_EXPR, masktype, tmp, rcs->fdigits);
+ tmp = build2 (BIT_AND_EXPR, masktype, arg, rcs->emask);
+ tmp = build2 (RSHIFT_EXPR, masktype, tmp, rcs->fdigits);
exponent = gfc_create_var (masktype, "exponent");
gfc_add_modify_expr(&se->pre, exponent, tmp);
rcs->expn = exponent;
- tmp = build (BIT_AND_EXPR, masktype, arg, rcs->fmask);
+ tmp = build2 (BIT_AND_EXPR, masktype, arg, rcs->fmask);
fraction = gfc_create_var (masktype, "fraction");
gfc_add_modify_expr(&se->pre, fraction, tmp);
rcs->frac = fraction;
fdigits = rcs.fdigits;
tiny = rcs.f1;
zero = gfc_build_const (masktype, integer_zero_node);
- tmp = build (BIT_AND_EXPR, masktype, rcs.emask, arg);
- tmp = build (RSHIFT_EXPR, masktype, tmp, fdigits);
- tmp = build (MINUS_EXPR, masktype, tmp, fdigits);
- cond = build (LE_EXPR, boolean_type_node, tmp, zero);
- t1 = build (LSHIFT_EXPR, masktype, tmp, fdigits);
- tmp = build (COND_EXPR, masktype, cond, tiny, t1);
+ tmp = build2 (BIT_AND_EXPR, masktype, rcs.emask, arg);
+ tmp = build2 (RSHIFT_EXPR, masktype, tmp, fdigits);
+ tmp = build2 (MINUS_EXPR, masktype, tmp, fdigits);
+ cond = build2 (LE_EXPR, boolean_type_node, tmp, zero);
+ t1 = build2 (LSHIFT_EXPR, masktype, tmp, fdigits);
+ tmp = build3 (COND_EXPR, masktype, cond, tiny, t1);
tmp = build1 (VIEW_CONVERT_EXPR, rcs.type, tmp);
se->expr = tmp;
fraction = rcs.frac;
one = gfc_build_const (masktype, integer_one_node);
zero = gfc_build_const (masktype, integer_zero_node);
- t2 = build (PLUS_EXPR, masktype, rcs.edigits, one);
+ t2 = build2 (PLUS_EXPR, masktype, rcs.edigits, one);
t1 = call_builtin_clz (masktype, fraction);
- tmp = build (PLUS_EXPR, masktype, t1, one);
- tmp = build (LSHIFT_EXPR, masktype, fraction, tmp);
- tmp = build (RSHIFT_EXPR, masktype, tmp, t2);
- cond = build (EQ_EXPR, boolean_type_node, rcs.expn, zero);
- fraction = build (COND_EXPR, masktype, cond, tmp, fraction);
+ tmp = build2 (PLUS_EXPR, masktype, t1, one);
+ tmp = build2 (LSHIFT_EXPR, masktype, fraction, tmp);
+ tmp = build2 (RSHIFT_EXPR, masktype, tmp, t2);
+ cond = build2 (EQ_EXPR, boolean_type_node, rcs.expn, zero);
+ fraction = build3 (COND_EXPR, masktype, cond, tmp, fraction);
- tmp = build (PLUS_EXPR, masktype, rcs.bias, fdigits);
- tmp = build (LSHIFT_EXPR, masktype, tmp, fdigits);
- tmp = build (BIT_IOR_EXPR, masktype, tmp, fraction);
+ tmp = build2 (PLUS_EXPR, masktype, rcs.bias, fdigits);
+ tmp = build2 (LSHIFT_EXPR, masktype, tmp, fdigits);
+ tmp = build2 (BIT_IOR_EXPR, masktype, tmp, fraction);
- cond2 = build (EQ_EXPR, boolean_type_node, rcs.frac, zero);
- cond = build (TRUTH_ANDIF_EXPR, boolean_type_node, cond, cond2);
- tmp = build (COND_EXPR, masktype, cond,
- convert (masktype, integer_zero_node), tmp);
+ cond2 = build2 (EQ_EXPR, boolean_type_node, rcs.frac, zero);
+ cond = build2 (TRUTH_ANDIF_EXPR, boolean_type_node, cond, cond2);
+ tmp = build3 (COND_EXPR, masktype, cond,
+ convert (masktype, integer_zero_node), tmp);
tmp = build1 (VIEW_CONVERT_EXPR, rcs.type, tmp);
se->expr = tmp;
gfc_add_expr_to_block (&se->pre, tmp);
/* Free the temporary afterwards, if necessary. */
- cond = build (GT_EXPR, boolean_type_node, len,
- convert (TREE_TYPE (len), integer_zero_node));
+ cond = build2 (GT_EXPR, boolean_type_node, len,
+ convert (TREE_TYPE (len), integer_zero_node));
arglist = gfc_chainon_list (NULL_TREE, var);
tmp = gfc_build_function_call (gfor_fndecl_internal_free, arglist);
- tmp = build_v (COND_EXPR, cond, tmp, build_empty_stmt ());
+ tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
gfc_add_expr_to_block (&se->post, tmp);
se->expr = var;
len = TREE_VALUE (args);
tmp = gfc_advance_chain (args, 2);
ncopies = TREE_VALUE (tmp);
- len = fold (build (MULT_EXPR, gfc_int4_type_node, len, ncopies));
+ len = fold (build2 (MULT_EXPR, gfc_int4_type_node, len, ncopies));
type = gfc_get_character_type (expr->ts.kind, expr->ts.cl);
var = gfc_conv_string_tmp (se, build_pointer_type (type), len);
}
+/* Generate code for the IARGC intrinsic. If args_only is true this is
+ actually the COMMAND_ARGUMENT_COUNT intrinsic, so return IARGC - 1. */
+
+static void
+gfc_conv_intrinsic_iargc (gfc_se * se, gfc_expr * expr, bool args_only)
+{
+ tree tmp;
+ tree fndecl;
+ tree type;
+
+ /* Call the library function. This always returns an INTEGER(4). */
+ fndecl = gfor_fndecl_iargc;
+ tmp = gfc_build_function_call (fndecl, NULL_TREE);
+
+ /* Convert it to the required type. */
+ type = gfc_typenode_for_spec (&expr->ts);
+ tmp = fold_convert (type, tmp);
+
+ if (args_only)
+ tmp = build2 (MINUS_EXPR, type, tmp, convert (type, integer_one_node));
+ se->expr = tmp;
+}
+
/* Generate code for an intrinsic function. Some map directly to library
calls, others get special handling. In some cases the name of the function
used depends on the type specifiers. */
gfc_conv_intrinsic_cmplx (se, expr, name[5] == '1');
break;
+ case GFC_ISYM_COMMAND_ARGUMENT_COUNT:
+ gfc_conv_intrinsic_iargc (se, expr, TRUE);
+ break;
+
case GFC_ISYM_CONJG:
gfc_conv_intrinsic_conjg (se, expr);
break;
gfc_conv_intrinsic_ichar (se, expr);
break;
+ case GFC_ISYM_IARGC:
+ gfc_conv_intrinsic_iargc (se, expr, FALSE);
+ break;
+
case GFC_ISYM_IEOR:
gfc_conv_intrinsic_bitop (se, expr, BIT_XOR_EXPR);
break;
OSDN Git Service
