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);
}
{
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 ());
static tree
gfc_trans_character_select (gfc_code *code)
{
- tree init, node, end_label, tmp, type, *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);
/* Build the library call */
init = gfc_build_addr_expr (pvoid_type_node, init);
- tmp = gfc_build_addr_expr (pvoid_type_node, end_label);
gfc_init_se (&se, NULL);
gfc_conv_expr_reference (&se, code->expr);
gfc_add_block_to_block (&block, &se.pre);
- tmp = build_call_expr (gfor_fndecl_select_string, 5,
- init, build_int_cst (NULL_TREE, n),
- tmp, se.expr, se.string_length);
-
- 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 ());
}
}
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),
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);
/* 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 (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);
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;
- tmp = build_call_expr (gfor_fndecl_allocate, 2, tmp, pstat);
- 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_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
{
- tmp = build_call_expr (gfor_fndecl_deallocate, 2, se.expr, pstat);
+ 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
