OSDN Git Service

* builtin-types.def (BT_FN_PTR_PTR_SIZE): New type.
[pf3gnuchains/gcc-fork.git] / gcc / fortran / trans-stmt.c
index 51586c8..f900ec5 100644 (file)
@@ -8,7 +8,7 @@ This file is part of GCC.
 
 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
@@ -17,9 +17,8 @@ FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
 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"
@@ -154,8 +153,8 @@ gfc_trans_goto (gfc_code * code)
   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);
 
@@ -180,8 +179,8 @@ gfc_trans_goto (gfc_code * code)
       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); 
 }
@@ -387,8 +386,8 @@ gfc_trans_call (gfc_code * code, bool dependency_check)
        {
          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);
        }
@@ -447,7 +446,8 @@ gfc_trans_return (gfc_code * code ATTRIBUTE_UNUSED)
 
       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 ());
@@ -1319,13 +1319,12 @@ gfc_trans_logical_select (gfc_code * code)
 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;
@@ -1351,7 +1350,7 @@ gfc_trans_character_select (gfc_code *code)
       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);
@@ -1365,20 +1364,6 @@ gfc_trans_character_select (gfc_code *code)
   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 */
@@ -1389,7 +1374,10 @@ gfc_trans_character_select (gfc_code *code)
     {
       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);
         }
 
@@ -1402,9 +1390,8 @@ gfc_trans_character_select (gfc_code *code)
 
   /* 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;
 
@@ -1437,8 +1424,8 @@ gfc_trans_character_select (gfc_code *code)
           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);
@@ -1462,33 +1449,27 @@ gfc_trans_character_select (gfc_code *code)
 
   /* 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);
 }
 
@@ -1609,7 +1590,8 @@ gfc_trans_forall_loop (forall_info *forall_tmp, tree body,
        }
 
       /* 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);
@@ -3583,11 +3565,7 @@ gfc_trans_allocate (gfc_code * code)
       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)
     {
@@ -3608,8 +3586,9 @@ gfc_trans_allocate (gfc_code * code)
          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)
@@ -3696,10 +3675,7 @@ gfc_trans_deallocate (gfc_code * code)
       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)
     {
@@ -3737,7 +3713,7 @@ gfc_trans_deallocate (gfc_code * code)
        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,