{
/* For __float128, the story is a bit different, because we return
a decl to a library function rather than a built-in. */
- gfc_intrinsic_map_t *m;
+ gfc_intrinsic_map_t *m;
for (m = gfc_intrinsic_map; m->double_built_in != double_built_in ; m++)
;
nargs = gfc_intrinsic_argument_list_length (expr);
args = XALLOCAVEC (tree, nargs);
- /* Evaluate all the arguments passed. Whilst we're only interested in the
- first one here, there are other parts of the front-end that assume this
+ /* Evaluate all the arguments passed. Whilst we're only interested in the
+ first one here, there are other parts of the front-end that assume this
and will trigger an ICE if it's not the case. */
type = gfc_typenode_for_spec (&expr->ts);
gcc_assert (expr->value.function.actual->expr);
nargs = gfc_intrinsic_argument_list_length (expr);
args = XALLOCAVEC (tree, nargs);
- /* Evaluate the argument, we process all arguments even though we only
+ /* Evaluate the argument, we process all arguments even though we only
use the first one for code generation purposes. */
type = gfc_typenode_for_spec (&expr->ts);
gcc_assert (expr->value.function.actual->expr);
/* Send data to a remove coarray. */
-
+
static tree
conv_caf_send (gfc_code *code) {
gfc_expr *lhs_expr, *rhs_expr;
extent = gfc_extent(i)
ml = m
m = m/extent
- if (i >= min_var)
+ if (i >= min_var)
goto exit_label
i++
}
return;
}
- m = gfc_create_var (type, NULL);
- ml = gfc_create_var (type, NULL);
- loop_var = gfc_create_var (integer_type_node, NULL);
- min_var = gfc_create_var (integer_type_node, NULL);
+ m = gfc_create_var (type, NULL);
+ ml = gfc_create_var (type, NULL);
+ loop_var = gfc_create_var (integer_type_node, NULL);
+ min_var = gfc_create_var (integer_type_node, NULL);
/* m = this_image () - 1. */
gfc_add_modify (&se->pre, m, tmp);
extent = fold_convert (type, extent);
/* m = m/extent. */
- gfc_add_modify (&loop, m,
+ gfc_add_modify (&loop, m,
fold_build2_loc (input_location, TRUNC_DIV_EXPR, type,
m, extent));
ubound = gfc_conv_descriptor_ubound_get (desc, bound);
lbound = gfc_conv_descriptor_lbound_get (desc, bound);
-
+
/* 13.14.53: Result value for LBOUND
Case (i): For an array section or for an array expression other than a
/* Remainder function MOD(A, P) = A - INT(A / P) * P
- MODULO(A, P) = A - FLOOR (A / P) * P
+ MODULO(A, P) = A - FLOOR (A / P) * P
The obvious algorithms above are numerically instable for large
arguments, hence these intrinsics are instead implemented via calls
In order to calculate the result accurately, we use the fmod
function as follows.
-
+
res = fmod (arg, arg2);
if (res)
{
=> As two nested ternary exprs:
- res = res ? (((arg < 0) xor (arg2 < 0)) ? res + arg2 : res)
+ res = res ? (((arg < 0) xor (arg2 < 0)) ? res + arg2 : res)
: copysign (0., arg2);
*/
boolean_type_node, test, test2);
test = gfc_evaluate_now (test, &se->pre);
se->expr = fold_build3_loc (input_location, COND_EXPR, type, test,
- fold_build2_loc (input_location,
+ fold_build2_loc (input_location,
PLUS_EXPR,
- type, tmp, args[1]),
+ type, tmp, args[1]),
tmp);
}
else
{
tree expr1, copysign, cscall;
- copysign = gfc_builtin_decl_for_float_kind (BUILT_IN_COPYSIGN,
+ copysign = gfc_builtin_decl_for_float_kind (BUILT_IN_COPYSIGN,
expr->ts.kind);
test = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
args[0], zero);
test2 = fold_build2_loc (input_location, TRUTH_XOR_EXPR,
boolean_type_node, test, test2);
expr1 = fold_build3_loc (input_location, COND_EXPR, type, test2,
- fold_build2_loc (input_location,
+ fold_build2_loc (input_location,
PLUS_EXPR,
- type, tmp, args[1]),
+ type, tmp, args[1]),
tmp);
test = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
tmp, zero);
- cscall = build_call_expr_loc (input_location, copysign, 2, zero,
+ cscall = build_call_expr_loc (input_location, copysign, 2, zero,
args[1]);
se->expr = fold_build3_loc (input_location, COND_EXPR, type, test,
expr1, cscall);
{
tree cond, isnan;
- val = args[i];
+ val = args[i];
/* Handle absent optional arguments by ignoring the comparison. */
if (argexpr->expr->expr_type == EXPR_VARIABLE
&& TREE_CODE (val) == INDIRECT_REF)
cond = fold_build2_loc (input_location,
NE_EXPR, boolean_type_node,
- TREE_OPERAND (val, 0),
+ TREE_OPERAND (val, 0),
build_int_cst (TREE_TYPE (TREE_OPERAND (val, 0)), 0));
else
{
gfc_add_modify (&ifblock2, val,
fold_build2_loc (input_location, RDIV_EXPR, type, scale,
absX));
- res1 = fold_build2_loc (input_location, MULT_EXPR, type, val, val);
+ res1 = fold_build2_loc (input_location, MULT_EXPR, type, val, val);
res1 = fold_build2_loc (input_location, MULT_EXPR, type, resvar, res1);
res1 = fold_build2_loc (input_location, PLUS_EXPR, type, res1,
gfc_build_const (type, integer_one_node));
gfc_add_modify (&ifblock2, resvar, res1);
gfc_add_modify (&ifblock2, scale, absX);
- res1 = gfc_finish_block (&ifblock2);
+ res1 = gfc_finish_block (&ifblock2);
gfc_init_block (&ifblock3);
gfc_add_modify (&ifblock3, val,
fold_build2_loc (input_location, RDIV_EXPR, type, absX,
scale));
- res2 = fold_build2_loc (input_location, MULT_EXPR, type, val, val);
+ res2 = fold_build2_loc (input_location, MULT_EXPR, type, val, val);
res2 = fold_build2_loc (input_location, PLUS_EXPR, type, resvar, res2);
gfc_add_modify (&ifblock3, resvar, res2);
res2 = gfc_finish_block (&ifblock3);
cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
absX, scale);
tmp = build3_v (COND_EXPR, cond, res1, res2);
- gfc_add_expr_to_block (&ifblock1, tmp);
+ gfc_add_expr_to_block (&ifblock1, tmp);
tmp = gfc_finish_block (&ifblock1);
cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
gfc_build_const (type, integer_zero_node));
tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt (input_location));
- gfc_add_expr_to_block (&block, tmp);
+ gfc_add_expr_to_block (&block, tmp);
}
else
{
For INTEGER kinds smaller than the C 'int' type, we have to subtract the
difference in bit size between the argument of LEADZ and the C int. */
-
+
static void
gfc_conv_intrinsic_leadz (gfc_se * se, gfc_expr * expr)
{
{
/* We end up here if the argument type is larger than 'long long'.
We generate this code:
-
+
if (x & (ULL_MAX << ULL_SIZE) != 0)
return clzll ((unsigned long long) (x >> ULLSIZE));
else
The conditional expression is necessary because the result of TRAILZ(0)
is defined, but the result of __builtin_ctz(0) is undefined for most
targets. */
-
+
static void
gfc_conv_intrinsic_trailz (gfc_se * se, gfc_expr *expr)
{
{
/* We end up here if the argument type is larger than 'long long'.
We generate this code:
-
+
if ((x & ULL_MAX) == 0)
return ULL_SIZE + ctzll ((unsigned long long) (x >> ULLSIZE));
else
/* Using __builtin_popcount for POPCNT and __builtin_parity for POPPAR;
for types larger than "long long", we call the long long built-in for
the lower and higher bits and combine the result. */
-
+
static void
gfc_conv_intrinsic_popcnt_poppar (gfc_se * se, gfc_expr *expr, int parity)
{
call2 = build_call_expr_loc (input_location, func, 1,
fold_convert (long_long_unsigned_type_node,
arg2));
-
+
/* Combine the results. */
if (parity)
se->expr = fold_build2_loc (input_location, BIT_XOR_EXPR, result_type,
{
tree arg, allones, type, utype, res, cond, bitsize;
int i;
-
+
gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
arg = gfc_evaluate_now (arg, &se->pre);
gfc_add_block_to_block (&se->pre, &argse.pre);
/* Unusually, for an intrinsic, size does not exclude
- an optional arg2, so we must test for it. */
+ an optional arg2, so we must test for it. */
if (actual->expr->expr_type == EXPR_VARIABLE
&& actual->expr->symtree->n.sym->attr.dummy
&& actual->expr->symtree->n.sym->attr.optional)
{
tree bytesize;
int i = gfc_validate_kind (BT_CHARACTER, kind, false);
-
+
bytesize = build_int_cst (gfc_array_index_type,
gfc_character_kinds[i].bit_size / 8);
tree type, result_type, tmp;
arg = expr->value.function.actual->expr;
-
+
gfc_init_se (&argse, NULL);
result_type = gfc_get_int_type (expr->ts.kind);
}
gfc_conv_expr_reference (&argse, arg);
- type = TREE_TYPE (build_fold_indirect_ref_loc (input_location,
+ type = TREE_TYPE (build_fold_indirect_ref_loc (input_location,
argse.expr));
}
else
}
type = gfc_get_element_type (TREE_TYPE (argse.expr));
}
-
+
/* Obtain the argument's word length. */
if (arg->ts.type == BT_CHARACTER)
tmp = size_of_string_in_bytes (arg->ts.kind, argse.string_length);
else
- tmp = size_in_bytes (type);
+ tmp = size_in_bytes (type);
tmp = fold_convert (result_type, tmp);
done:
argse.string_length);
else
tmp = fold_convert (gfc_array_index_type,
- size_in_bytes (source_type));
+ size_in_bytes (source_type));
/* Obtain the size of the array in bytes. */
extent = gfc_create_var (gfc_array_index_type, NULL);
&& arg1->expr->symtree->n.sym->attr.dummy)
arg1se.expr = build_fold_indirect_ref_loc (input_location,
arg1se.expr);
- if (arg1->expr->ts.type == BT_CLASS)
+ if (arg1->expr->ts.type == BT_CLASS)
+ {
tmp2 = gfc_class_data_get (arg1se.expr);
+ if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp2)))
+ tmp2 = gfc_conv_descriptor_data_get (tmp2);
+ }
else
tmp2 = arg1se.expr;
}
gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
/* The argument to SELECTED_INT_KIND is INTEGER(4). */
- type = gfc_get_int_type (4);
+ type = gfc_get_int_type (4);
arg = gfc_build_addr_expr (NULL_TREE, fold_convert (type, arg));
/* Convert it to the required type. */
gfc_convert_type (actual->expr, &ts, 2);
}
gfc_conv_expr_reference (&argse, actual->expr);
- }
+ }
gfc_add_block_to_block (&se->pre, &argse.pre);
gfc_add_block_to_block (&se->post, &argse.post);
else
gfc_conv_array_parameter (se, arg_expr, true, NULL, NULL, NULL);
se->expr = convert (gfc_get_int_type (gfc_index_integer_kind), se->expr);
-
- /* Create a temporary variable for loc return value. Without this,
+
+ /* Create a temporary variable for loc return value. Without this,
we get an error an ICE in gcc/expr.c(expand_expr_addr_expr_1). */
temp_var = gfc_create_var (gfc_get_int_type (gfc_index_integer_kind), NULL);
gfc_add_modify (&se->pre, temp_var, se->expr);
case GFC_ISYM_CO_SUM:
fndecl = gfor_fndecl_co_sum;
break;
- default:
+ default:
gcc_unreachable ();
}
build_int_cst (NULL, MEMMODEL_RELAXED),
build_int_cst (NULL, MEMMODEL_RELAXED));
gfc_add_expr_to_block (&block, tmp);
-
+
if (stat != NULL_TREE)
gfc_add_modify (&block, stat, build_int_cst (TREE_TYPE (stat), 0));
gfc_add_block_to_block (&block, &post_block);
projects / gcc.git / commitdiff