GCC is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free
-Software Foundation; either version 2, or (at your option) any later
+Software Foundation; either version 3, or (at your option) any later
version.
GCC is distributed in the hope that it will be useful, but WITHOUT ANY
for more details.
You should have received a copy of the GNU General Public License
-along with GCC; see the file COPYING. If not, write to the Free
-Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
-02110-1301, USA. */
+along with GCC; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
#include "config.h"
tmp = GFC_DECL_STRING_LEN (se.expr);
tmp = fold_build2 (NE_EXPR, boolean_type_node, tmp,
build_int_cst (TREE_TYPE (tmp), -1));
- gfc_trans_runtime_check (tmp, "Assigned label is not a target label",
- &se.pre, &loc);
+ gfc_trans_runtime_check (tmp, &se.pre, &loc,
+ "Assigned label is not a target label");
assigned_goto = GFC_DECL_ASSIGN_ADDR (se.expr);
code = code->block;
}
while (code != NULL);
- gfc_trans_runtime_check (boolean_true_node,
- "Assigned label is not in the list", &se.pre, &loc);
+ gfc_trans_runtime_check (boolean_true_node, &se.pre, &loc,
+ "Assigned label is not in the list");
return gfc_finish_block (&se.pre);
}
}
/* If there is a dependency, create a temporary and use it
- instead of the variable. */
+ instead of the variable. */
fsym = formal ? formal->sym : NULL;
if (e->expr_type == EXPR_VARIABLE
&& e->rank && fsym
tmp = gfc_typenode_for_spec (&e->ts);
tmp = gfc_trans_create_temp_array (&se->pre, &se->post,
&tmp_loop, info, tmp,
- false, true, false, false);
+ false, true, false);
gfc_add_modify_expr (&se->pre, size, tmp);
tmp = fold_convert (pvoid_type_node, info->data);
gfc_add_modify_expr (&se->pre, data, tmp);
gfc_add_modify_expr (&se->pre, info->offset, offset);
/* Copy the result back using unpack. */
- tmp = gfc_chainon_list (NULL_TREE, parmse.expr);
- tmp = gfc_chainon_list (tmp, data);
- tmp = build_function_call_expr (gfor_fndecl_in_unpack, tmp);
+ tmp = build_call_expr (gfor_fndecl_in_unpack, 2, parmse.expr, data);
gfc_add_expr_to_block (&se->post, tmp);
gfc_add_block_to_block (&se->post, &parmse.post);
{
gfc_symbol *sym;
sym = code->resolved_sym;
- gcc_assert (sym->formal->sym->attr.intent = INTENT_OUT);
- gcc_assert (sym->formal->next->sym->attr.intent = INTENT_IN);
+ gcc_assert (sym->formal->sym->attr.intent == INTENT_OUT);
+ gcc_assert (sym->formal->next->sym->attr.intent == INTENT_IN);
gfc_conv_elemental_dependencies (&se, &loopse, sym,
code->ext.actual);
}
gfc_conv_expr (&se, code->expr);
- tmp = build2 (MODIFY_EXPR, TREE_TYPE (result), result, se.expr);
+ tmp = build2 (MODIFY_EXPR, TREE_TYPE (result), result,
+ fold_convert (TREE_TYPE (result), se.expr));
gfc_add_expr_to_block (&se.pre, tmp);
tmp = build1_v (GOTO_EXPR, gfc_get_return_label ());
{
tree gfc_int4_type_node = gfc_get_int_type (4);
gfc_se se;
- tree args;
tree tmp;
- tree fndecl;
/* Start a new block for this statement. */
gfc_init_se (&se, NULL);
if (code->expr == NULL)
{
tmp = build_int_cst (gfc_int4_type_node, code->ext.stop_code);
- args = gfc_chainon_list (NULL_TREE, tmp);
- fndecl = gfor_fndecl_pause_numeric;
+ tmp = build_call_expr (gfor_fndecl_pause_numeric, 1, tmp);
}
else
{
gfc_conv_expr_reference (&se, code->expr);
- args = gfc_chainon_list (NULL_TREE, se.expr);
- args = gfc_chainon_list (args, se.string_length);
- fndecl = gfor_fndecl_pause_string;
+ tmp = build_call_expr (gfor_fndecl_pause_string, 2,
+ se.expr, se.string_length);
}
- tmp = build_function_call_expr (fndecl, args);
gfc_add_expr_to_block (&se.pre, tmp);
gfc_add_block_to_block (&se.pre, &se.post);
{
tree gfc_int4_type_node = gfc_get_int_type (4);
gfc_se se;
- tree args;
tree tmp;
- tree fndecl;
/* Start a new block for this statement. */
gfc_init_se (&se, NULL);
if (code->expr == NULL)
{
tmp = build_int_cst (gfc_int4_type_node, code->ext.stop_code);
- args = gfc_chainon_list (NULL_TREE, tmp);
- fndecl = gfor_fndecl_stop_numeric;
+ tmp = build_call_expr (gfor_fndecl_stop_numeric, 1, tmp);
}
else
{
gfc_conv_expr_reference (&se, code->expr);
- args = gfc_chainon_list (NULL_TREE, se.expr);
- args = gfc_chainon_list (args, se.string_length);
- fndecl = gfor_fndecl_stop_string;
+ tmp = build_call_expr (gfor_fndecl_stop_string, 2,
+ se.expr, se.string_length);
}
- tmp = build_function_call_expr (fndecl, args);
gfc_add_expr_to_block (&se.pre, tmp);
gfc_add_block_to_block (&se.pre, &se.post);
to:
[evaluate loop bounds and step]
- count = (to + step - from) / step;
+ empty = (step > 0 ? to < from : to > from);
+ countm1 = (to - from) / step;
dovar = from;
+ if (empty) goto exit_label;
for (;;)
{
body;
cycle_label:
dovar += step
- count--;
- if (count <=0) goto exit_label;
+ if (countm1 ==0) goto exit_label;
+ countm1--;
}
exit_label:
- TODO: Large loop counts
- The code above assumes the loop count fits into a signed integer kind,
- i.e. Does not work for loop counts > 2^31 for integer(kind=4) variables
- We must support the full range. */
+ countm1 is an unsigned integer. It is equal to the loop count minus one,
+ because the loop count itself can overflow. */
tree
gfc_trans_do (gfc_code * code)
tree from;
tree to;
tree step;
- tree count;
- tree count_one;
+ tree empty;
+ tree countm1;
tree type;
+ tree utype;
tree cond;
tree cycle_label;
tree exit_label;
tree tmp;
+ tree pos_step;
stmtblock_t block;
stmtblock_t body;
|| tree_int_cst_equal (step, integer_minus_one_node)))
return gfc_trans_simple_do (code, &block, dovar, from, to, step);
- /* Initialize loop count. This code is executed before we enter the
- loop body. We generate: count = (to + step - from) / step. */
+ /* We need a special check for empty loops:
+ empty = (step > 0 ? to < from : to > from); */
+ pos_step = fold_build2 (GT_EXPR, boolean_type_node, step,
+ fold_convert (type, integer_zero_node));
+ empty = fold_build3 (COND_EXPR, boolean_type_node, pos_step,
+ fold_build2 (LT_EXPR, boolean_type_node, to, from),
+ fold_build2 (GT_EXPR, boolean_type_node, to, from));
- tmp = fold_build2 (MINUS_EXPR, type, step, from);
- tmp = fold_build2 (PLUS_EXPR, type, to, tmp);
+ /* Initialize loop count. This code is executed before we enter the
+ loop body. We generate: countm1 = abs(to - from) / abs(step). */
if (TREE_CODE (type) == INTEGER_TYPE)
{
- tmp = fold_build2 (TRUNC_DIV_EXPR, type, tmp, step);
- count = gfc_create_var (type, "count");
+ tree ustep;
+
+ utype = unsigned_type_for (type);
+
+ /* tmp = abs(to - from) / abs(step) */
+ ustep = fold_convert (utype, fold_build1 (ABS_EXPR, type, step));
+ tmp = fold_build3 (COND_EXPR, type, pos_step,
+ fold_build2 (MINUS_EXPR, type, to, from),
+ fold_build2 (MINUS_EXPR, type, from, to));
+ tmp = fold_build2 (TRUNC_DIV_EXPR, utype, fold_convert (utype, tmp),
+ ustep);
}
else
{
/* TODO: We could use the same width as the real type.
This would probably cause more problems that it solves
when we implement "long double" types. */
+ utype = unsigned_type_for (gfc_array_index_type);
+ tmp = fold_build2 (MINUS_EXPR, type, to, from);
tmp = fold_build2 (RDIV_EXPR, type, tmp, step);
- tmp = fold_build1 (FIX_TRUNC_EXPR, gfc_array_index_type, tmp);
- count = gfc_create_var (gfc_array_index_type, "count");
+ tmp = fold_build1 (FIX_TRUNC_EXPR, utype, tmp);
}
- gfc_add_modify_expr (&block, count, tmp);
+ countm1 = gfc_create_var (utype, "countm1");
+ gfc_add_modify_expr (&block, countm1, tmp);
- count_one = build_int_cst (TREE_TYPE (count), 1);
+ /* Cycle and exit statements are implemented with gotos. */
+ cycle_label = gfc_build_label_decl (NULL_TREE);
+ exit_label = gfc_build_label_decl (NULL_TREE);
+ TREE_USED (exit_label) = 1;
/* Initialize the DO variable: dovar = from. */
gfc_add_modify_expr (&block, dovar, from);
+ /* If the loop is empty, go directly to the exit label. */
+ tmp = fold_build3 (COND_EXPR, void_type_node, empty,
+ build1_v (GOTO_EXPR, exit_label), build_empty_stmt ());
+ gfc_add_expr_to_block (&block, tmp);
+
/* Loop body. */
gfc_start_block (&body);
- /* Cycle and exit statements are implemented with gotos. */
- cycle_label = gfc_build_label_decl (NULL_TREE);
- exit_label = gfc_build_label_decl (NULL_TREE);
-
- /* Start with the loop condition. Loop until count <= 0. */
- cond = fold_build2 (LE_EXPR, boolean_type_node, count,
- build_int_cst (TREE_TYPE (count), 0));
- tmp = build1_v (GOTO_EXPR, exit_label);
- TREE_USED (exit_label) = 1;
- tmp = fold_build3 (COND_EXPR, void_type_node,
- cond, tmp, build_empty_stmt ());
- gfc_add_expr_to_block (&body, tmp);
-
/* Put these labels where they can be found later. We put the
labels in a TREE_LIST node (because TREE_CHAIN is already
used). cycle_label goes in TREE_PURPOSE (backend_decl), exit
tmp = build2 (PLUS_EXPR, type, dovar, step);
gfc_add_modify_expr (&body, dovar, tmp);
+ /* End with the loop condition. Loop until countm1 == 0. */
+ cond = fold_build2 (EQ_EXPR, boolean_type_node, countm1,
+ build_int_cst (utype, 0));
+ tmp = build1_v (GOTO_EXPR, exit_label);
+ tmp = fold_build3 (COND_EXPR, void_type_node,
+ cond, tmp, build_empty_stmt ());
+ gfc_add_expr_to_block (&body, tmp);
+
/* Decrement the loop count. */
- tmp = build2 (MINUS_EXPR, TREE_TYPE (count), count, count_one);
- gfc_add_modify_expr (&body, count, tmp);
+ tmp = build2 (MINUS_EXPR, utype, countm1, build_int_cst (utype, 1));
+ gfc_add_modify_expr (&body, countm1, tmp);
/* End of loop body. */
tmp = gfc_finish_block (&body);
if (cp->low)
{
- low = gfc_conv_constant_to_tree (cp->low);
+ low = gfc_conv_mpz_to_tree (cp->low->value.integer,
+ cp->low->ts.kind);
/* If there's only a lower bound, set the high bound to the
maximum value of the case expression. */
|| (cp->low
&& mpz_cmp (cp->low->value.integer,
cp->high->value.integer) != 0))
- high = gfc_conv_constant_to_tree (cp->high);
+ high = gfc_conv_mpz_to_tree (cp->high->value.integer,
+ cp->high->ts.kind);
/* Unbounded case. */
if (!cp->low)
static tree
gfc_trans_character_select (gfc_code *code)
{
- tree init, node, end_label, tmp, type, args, *labels;
- tree case_label;
+ tree init, node, end_label, tmp, type, case_num, label;
stmtblock_t block, body;
gfc_case *cp, *d;
gfc_code *c;
gfc_se se;
- int i, n;
+ int n;
static tree select_struct;
static tree ss_string1, ss_string1_len;
ADD_FIELD (string2, pchar_type_node);
ADD_FIELD (string2_len, gfc_int4_type_node);
- ADD_FIELD (target, pvoid_type_node);
+ ADD_FIELD (target, integer_type_node);
#undef ADD_FIELD
gfc_finish_type (select_struct);
for (d = cp; d; d = d->right)
d->n = n++;
- if (n != 0)
- labels = gfc_getmem (n * sizeof (tree));
- else
- labels = NULL;
-
- for(i = 0; i < n; i++)
- {
- labels[i] = gfc_build_label_decl (NULL_TREE);
- TREE_USED (labels[i]) = 1;
- /* TODO: The gimplifier should do this for us, but it has
- inadequacies when dealing with static initializers. */
- FORCED_LABEL (labels[i]) = 1;
- }
-
end_label = gfc_build_label_decl (NULL_TREE);
/* Generate the body */
{
for (d = c->ext.case_list; d; d = d->next)
{
- tmp = build1_v (LABEL_EXPR, labels[d->n]);
+ label = gfc_build_label_decl (NULL_TREE);
+ tmp = build3 (CASE_LABEL_EXPR, void_type_node,
+ build_int_cst (NULL_TREE, d->n),
+ build_int_cst (NULL_TREE, d->n), label);
gfc_add_expr_to_block (&body, tmp);
}
/* Generate the structure describing the branches */
init = NULL_TREE;
- i = 0;
- for(d = cp; d; d = d->right, i++)
+ for(d = cp; d; d = d->right)
{
node = NULL_TREE;
node = tree_cons (ss_string2_len, se.string_length, node);
}
- tmp = gfc_build_addr_expr (pvoid_type_node, labels[i]);
- node = tree_cons (ss_target, tmp, node);
+ node = tree_cons (ss_target, build_int_cst (integer_type_node, d->n),
+ node);
tmp = build_constructor_from_list (select_struct, nreverse (node));
init = tree_cons (NULL_TREE, tmp, init);
DECL_INITIAL (tmp) = init;
init = tmp;
- /* Build an argument list for the library call */
+ /* Build the library call */
init = gfc_build_addr_expr (pvoid_type_node, init);
- args = gfc_chainon_list (NULL_TREE, init);
-
- tmp = build_int_cst (NULL_TREE, n);
- args = gfc_chainon_list (args, tmp);
-
- tmp = gfc_build_addr_expr (pvoid_type_node, end_label);
- args = gfc_chainon_list (args, tmp);
gfc_init_se (&se, NULL);
gfc_conv_expr_reference (&se, code->expr);
- args = gfc_chainon_list (args, se.expr);
- args = gfc_chainon_list (args, se.string_length);
-
gfc_add_block_to_block (&block, &se.pre);
- tmp = build_function_call_expr (gfor_fndecl_select_string, args);
- case_label = gfc_create_var (TREE_TYPE (tmp), "case_label");
- gfc_add_modify_expr (&block, case_label, tmp);
+ tmp = build_call_expr (gfor_fndecl_select_string, 4, init,
+ build_int_cst (NULL_TREE, n), se.expr,
+ se.string_length);
+ case_num = gfc_create_var (integer_type_node, "case_num");
+ gfc_add_modify_expr (&block, case_num, tmp);
gfc_add_block_to_block (&block, &se.post);
- tmp = build1 (GOTO_EXPR, void_type_node, case_label);
- gfc_add_expr_to_block (&block, tmp);
-
tmp = gfc_finish_block (&body);
+ tmp = build3_v (SWITCH_EXPR, case_num, tmp, NULL_TREE);
gfc_add_expr_to_block (&block, tmp);
+
tmp = build1_v (LABEL_EXPR, end_label);
gfc_add_expr_to_block (&block, tmp);
- if (n != 0)
- gfc_free (labels);
-
return gfc_finish_block (&block);
}
}
/* Decrement the loop counter. */
- tmp = build2 (MINUS_EXPR, TREE_TYPE (var), count, gfc_index_one_node);
+ tmp = build2 (MINUS_EXPR, TREE_TYPE (var), count,
+ build_int_cst (TREE_TYPE (var), 1));
gfc_add_modify_expr (&block, count, tmp);
body = gfc_finish_block (&block);
/* If a mask was specified make the assignment conditional. */
if (mask)
{
- tmp = gfc_build_array_ref (mask, maskindex);
+ tmp = gfc_build_array_ref (mask, maskindex, NULL);
body = build3_v (COND_EXPR, tmp, body, build_empty_stmt ());
}
}
tree tmpvar;
tree type;
tree tmp;
- tree args;
if (INTEGER_CST_P (size))
{
tmpvar = gfc_create_var (build_pointer_type (type), "temp");
*pdata = convert (pvoid_type_node, tmpvar);
- args = gfc_chainon_list (NULL_TREE, bytesize);
- if (gfc_index_integer_kind == 4)
- tmp = gfor_fndecl_internal_malloc;
- else if (gfc_index_integer_kind == 8)
- tmp = gfor_fndecl_internal_malloc64;
- else
- gcc_unreachable ();
- tmp = build_function_call_expr (tmp, args);
- tmp = convert (TREE_TYPE (tmpvar), tmp);
+ tmp = gfc_call_malloc (pblock, TREE_TYPE (tmpvar), bytesize);
gfc_add_modify_expr (pblock, tmpvar, tmp);
}
return tmpvar;
gfc_conv_expr (&lse, expr);
/* Form the expression for the temporary. */
- tmp = gfc_build_array_ref (tmp1, count1);
+ tmp = gfc_build_array_ref (tmp1, count1, NULL);
/* Use the scalar assignment as is. */
gfc_add_block_to_block (&block, &lse.pre);
/* Form the expression of the temporary. */
if (lss != gfc_ss_terminator)
- rse.expr = gfc_build_array_ref (tmp1, count1);
+ rse.expr = gfc_build_array_ref (tmp1, count1, NULL);
/* Translate expr. */
gfc_conv_expr (&lse, expr);
/* Form the mask expression according to the mask tree list. */
if (wheremask)
{
- wheremaskexpr = gfc_build_array_ref (wheremask, count3);
+ wheremaskexpr = gfc_build_array_ref (wheremask, count3, NULL);
if (invert)
wheremaskexpr = fold_build1 (TRUTH_NOT_EXPR,
TREE_TYPE (wheremaskexpr),
{
gfc_init_block (&body1);
gfc_conv_expr (&rse, expr2);
- lse.expr = gfc_build_array_ref (tmp1, count1);
+ lse.expr = gfc_build_array_ref (tmp1, count1, NULL);
}
else
{
gfc_conv_expr (&rse, expr2);
/* Form the expression of the temporary. */
- lse.expr = gfc_build_array_ref (tmp1, count1);
+ lse.expr = gfc_build_array_ref (tmp1, count1, NULL);
}
/* Use the scalar assignment. */
/* Form the mask expression according to the mask tree list. */
if (wheremask)
{
- wheremaskexpr = gfc_build_array_ref (wheremask, count3);
+ wheremaskexpr = gfc_build_array_ref (wheremask, count3, NULL);
if (invert)
wheremaskexpr = fold_build1 (TRUTH_NOT_EXPR,
TREE_TYPE (wheremaskexpr),
tree unit;
tree tmp;
- unit = TYPE_SIZE_UNIT (type);
+ unit = fold_convert (gfc_array_index_type, TYPE_SIZE_UNIT (type));
if (!integer_onep (unit))
bytesize = fold_build2 (MULT_EXPR, gfc_array_index_type, size, unit);
else
if (ptemp1)
{
/* Free the temporary. */
- tmp = gfc_chainon_list (NULL_TREE, ptemp1);
- tmp = build_function_call_expr (gfor_fndecl_internal_free, tmp);
+ tmp = gfc_call_free (ptemp1);
gfc_add_expr_to_block (block, tmp);
}
}
inner_size, NULL, block, &ptemp1);
gfc_start_block (&body);
gfc_init_se (&lse, NULL);
- lse.expr = gfc_build_array_ref (tmp1, count);
+ lse.expr = gfc_build_array_ref (tmp1, count, NULL);
gfc_init_se (&rse, NULL);
rse.want_pointer = 1;
gfc_conv_expr (&rse, expr2);
gfc_start_block (&body);
gfc_init_se (&lse, NULL);
gfc_init_se (&rse, NULL);
- rse.expr = gfc_build_array_ref (tmp1, count);
+ rse.expr = gfc_build_array_ref (tmp1, count, NULL);
lse.want_pointer = 1;
gfc_conv_expr (&lse, expr1);
gfc_add_block_to_block (&body, &lse.pre);
inner_size, NULL, block, &ptemp1);
gfc_start_block (&body);
gfc_init_se (&lse, NULL);
- lse.expr = gfc_build_array_ref (tmp1, count);
+ lse.expr = gfc_build_array_ref (tmp1, count, NULL);
lse.direct_byref = 1;
rss = gfc_walk_expr (expr2);
gfc_conv_expr_descriptor (&lse, expr2, rss);
/* Reset count. */
gfc_add_modify_expr (block, count, gfc_index_zero_node);
- parm = gfc_build_array_ref (tmp1, count);
+ parm = gfc_build_array_ref (tmp1, count, NULL);
lss = gfc_walk_expr (expr1);
gfc_init_se (&lse, NULL);
gfc_conv_expr_descriptor (&lse, expr1, lss);
/* Free the temporary. */
if (ptemp1)
{
- tmp = gfc_chainon_list (NULL_TREE, ptemp1);
- tmp = build_function_call_expr (gfor_fndecl_internal_free, tmp);
+ tmp = gfc_call_free (ptemp1);
gfc_add_expr_to_block (block, tmp);
}
}
/* Store the mask. */
se.expr = convert (mask_type, se.expr);
- tmp = gfc_build_array_ref (mask, maskindex);
+ tmp = gfc_build_array_ref (mask, maskindex, NULL);
gfc_add_modify_expr (&body, tmp, se.expr);
/* Advance to the next mask element. */
if (pmask)
{
/* Free the temporary for the mask. */
- tmp = gfc_chainon_list (NULL_TREE, pmask);
- tmp = build_function_call_expr (gfor_fndecl_internal_free, tmp);
+ tmp = gfc_call_free (pmask);
gfc_add_expr_to_block (&block, tmp);
}
if (maskindex)
if (mask && (cmask || pmask))
{
- tmp = gfc_build_array_ref (mask, count);
+ tmp = gfc_build_array_ref (mask, count, NULL);
if (invert)
tmp = fold_build1 (TRUTH_NOT_EXPR, mask_type, tmp);
gfc_add_modify_expr (&body1, mtmp, tmp);
if (cmask)
{
- tmp1 = gfc_build_array_ref (cmask, count);
+ tmp1 = gfc_build_array_ref (cmask, count, NULL);
tmp = cond;
if (mask)
tmp = build2 (TRUTH_AND_EXPR, mask_type, mtmp, tmp);
if (pmask)
{
- tmp1 = gfc_build_array_ref (pmask, count);
+ tmp1 = gfc_build_array_ref (pmask, count, NULL);
tmp = build1 (TRUTH_NOT_EXPR, mask_type, cond);
if (mask)
tmp = build2 (TRUTH_AND_EXPR, mask_type, mtmp, tmp);
/* Form the mask expression according to the mask. */
index = count1;
- maskexpr = gfc_build_array_ref (mask, index);
+ maskexpr = gfc_build_array_ref (mask, index, NULL);
if (invert)
maskexpr = fold_build1 (TRUTH_NOT_EXPR, TREE_TYPE (maskexpr), maskexpr);
/* Form the mask expression according to the mask tree list. */
index = count2;
- maskexpr = gfc_build_array_ref (mask, index);
+ maskexpr = gfc_build_array_ref (mask, index, NULL);
if (invert)
maskexpr = fold_build1 (TRUTH_NOT_EXPR, TREE_TYPE (maskexpr),
maskexpr);
/* If we allocated a pending mask array, deallocate it now. */
if (ppmask)
{
- tree args = gfc_chainon_list (NULL_TREE, ppmask);
- tmp = build_function_call_expr (gfor_fndecl_internal_free, args);
+ tmp = gfc_call_free (ppmask);
gfc_add_expr_to_block (block, tmp);
}
/* If we allocated a current mask array, deallocate it now. */
if (pcmask)
{
- tree args = gfc_chainon_list (NULL_TREE, pcmask);
- tmp = build_function_call_expr (gfor_fndecl_internal_free, args);
+ tmp = gfc_call_free (pcmask);
gfc_add_expr_to_block (block, tmp);
}
}
TREE_USED (error_label) = 1;
}
else
- {
- pstat = integer_zero_node;
- stat = error_label = NULL_TREE;
- }
-
+ pstat = stat = error_label = NULL_TREE;
for (al = code->ext.alloc_list; al != NULL; al = al->next)
{
if (expr->ts.type == BT_CHARACTER && tmp == NULL_TREE)
tmp = se.string_length;
- parm = gfc_chainon_list (NULL_TREE, tmp);
- parm = gfc_chainon_list (parm, pstat);
- tmp = build_function_call_expr (gfor_fndecl_allocate, parm);
- tmp = build2 (MODIFY_EXPR, void_type_node, se.expr, tmp);
+ tmp = gfc_allocate_with_status (&se.pre, tmp, pstat);
+ tmp = build2 (MODIFY_EXPR, void_type_node, se.expr,
+ fold_convert (TREE_TYPE (se.expr), tmp));
gfc_add_expr_to_block (&se.pre, tmp);
if (code->expr)
gfc_se se;
gfc_alloc *al;
gfc_expr *expr;
- tree apstat, astat, parm, pstat, stat, tmp;
+ tree apstat, astat, pstat, stat, tmp;
stmtblock_t block;
gfc_start_block (&block);
gfc_add_modify_expr (&block, astat, build_int_cst (TREE_TYPE (astat), 0));
}
else
- {
- pstat = apstat = null_pointer_node;
- stat = astat = NULL_TREE;
- }
+ pstat = apstat = stat = astat = NULL_TREE;
for (al = code->ext.alloc_list; al != NULL; al = al->next)
{
tmp = gfc_array_deallocate (se.expr, pstat);
else
{
- parm = gfc_chainon_list (NULL_TREE, se.expr);
- parm = gfc_chainon_list (parm, pstat);
- tmp = build_function_call_expr (gfor_fndecl_deallocate, parm);
+ tmp = gfc_deallocate_with_status (se.expr, pstat, false);
gfc_add_expr_to_block (&se.pre, tmp);
tmp = build2 (MODIFY_EXPR, void_type_node,
OSDN Git Service
