2010-04-06 Tobias Burnus <burnus@net-b.de>

[pf3gnuchains/gcc-fork.git] / gcc / fortran / trans-stmt.c

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index e0fa371..0b215f2 100644 (file)
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -25,7 +25,10 @@ along with GCC; see the file COPYING3.  If not see
 #include "system.h"
 #include "coretypes.h"
 #include "tree.h"
+#include "gimple.h"
+#include "ggc.h"
 #include "toplev.h"
+#include "real.h"
 #include "gfortran.h"
 #include "flags.h"
 #include "trans.h"
@@ -549,17 +552,9 @@ gfc_trans_pause (gfc_code * code)
 
   if (code->expr1 == NULL)
     {
-      tmp = build_int_cst (gfc_int4_type_node, 0);
+      tmp = build_int_cst (gfc_int4_type_node, code->ext.stop_code);
       tmp = build_call_expr_loc (input_location,
-                                gfor_fndecl_pause_string, 2,
-                                build_int_cst (pchar_type_node, 0), tmp);
-    }
-  else if (code->expr1->ts.type == BT_INTEGER)
-    {
-      gfc_conv_expr (&se, code->expr1);
-      tmp = build_call_expr_loc (input_location,
-                                gfor_fndecl_pause_numeric, 1,
-                                fold_convert (gfc_int4_type_node, se.expr));
+                            gfor_fndecl_pause_numeric, 1, tmp);
     }
   else
     {
@@ -593,27 +588,17 @@ gfc_trans_stop (gfc_code *code, bool error_stop)
 
   if (code->expr1 == NULL)
     {
-      tmp = build_int_cst (gfc_int4_type_node, 0);
+      tmp = build_int_cst (gfc_int4_type_node, code->ext.stop_code);
       tmp = build_call_expr_loc (input_location,
-                                error_stop ? gfor_fndecl_error_stop_string
-                                : gfor_fndecl_stop_string,
-                                2, build_int_cst (pchar_type_node, 0), tmp);
-    }
-  else if (code->expr1->ts.type == BT_INTEGER)
-    {
-      gfc_conv_expr (&se, code->expr1);
-      tmp = build_call_expr_loc (input_location,
-                                error_stop ? gfor_fndecl_error_stop_numeric
-                                : gfor_fndecl_stop_numeric, 1,
-                                fold_convert (gfc_int4_type_node, se.expr));
+                            gfor_fndecl_stop_numeric, 1, tmp);
     }
   else
     {
       gfc_conv_expr_reference (&se, code->expr1);
       tmp = build_call_expr_loc (input_location,
-                                error_stop ? gfor_fndecl_error_stop_string
-                                : gfor_fndecl_stop_string,
-                                2, se.expr, se.string_length);
+                            error_stop ? gfor_fndecl_error_stop_string
+                                     : gfor_fndecl_stop_string,
+                            2, se.expr, se.string_length);
     }
 
   gfc_add_expr_to_block (&se.pre, tmp);
@@ -1608,13 +1593,12 @@ gfc_trans_logical_select (gfc_code * code)
 static tree
 gfc_trans_character_select (gfc_code *code)
 {
-  tree init, end_label, tmp, type, case_num, label, fndecl;
+  tree init, node, end_label, tmp, type, case_num, label, fndecl;
   stmtblock_t block, body;
   gfc_case *cp, *d;
   gfc_code *c;
   gfc_se se;
   int n, k;
-  VEC(constructor_elt,gc) *inits = NULL;
 
   /* The jump table types are stored in static variables to avoid
      constructing them from scratch every single time.  */
@@ -1694,50 +1678,52 @@ gfc_trans_character_select (gfc_code *code)
     }
 
   /* Generate the structure describing the branches */
+  init = NULL_TREE;
+
   for(d = cp; d; d = d->right)
     {
-      VEC(constructor_elt,gc) *node = NULL;
+      node = NULL_TREE;
 
       gfc_init_se (&se, NULL);
 
       if (d->low == NULL)
         {
-          CONSTRUCTOR_APPEND_ELT (node, ss_string1[k], null_pointer_node);
-          CONSTRUCTOR_APPEND_ELT (node, ss_string1_len[k], integer_zero_node);
+          node = tree_cons (ss_string1[k], null_pointer_node, node);
+          node = tree_cons (ss_string1_len[k], integer_zero_node, node);
         }
       else
         {
           gfc_conv_expr_reference (&se, d->low);
 
-          CONSTRUCTOR_APPEND_ELT (node, ss_string1[k], se.expr);
-          CONSTRUCTOR_APPEND_ELT (node, ss_string1_len[k], se.string_length);
+          node = tree_cons (ss_string1[k], se.expr, node);
+          node = tree_cons (ss_string1_len[k], se.string_length, node);
         }
 
       if (d->high == NULL)
         {
-          CONSTRUCTOR_APPEND_ELT (node, ss_string2[k], null_pointer_node);
-          CONSTRUCTOR_APPEND_ELT (node, ss_string2_len[k], integer_zero_node);
+          node = tree_cons (ss_string2[k], null_pointer_node, node);
+          node = tree_cons (ss_string2_len[k], integer_zero_node, node);
         }
       else
         {
           gfc_init_se (&se, NULL);
           gfc_conv_expr_reference (&se, d->high);
 
-          CONSTRUCTOR_APPEND_ELT (node, ss_string2[k], se.expr);
-          CONSTRUCTOR_APPEND_ELT (node, ss_string2_len[k], se.string_length);
+          node = tree_cons (ss_string2[k], se.expr, node);
+          node = tree_cons (ss_string2_len[k], se.string_length, node);
         }
 
-      CONSTRUCTOR_APPEND_ELT (node, ss_target[k],
-                              build_int_cst (integer_type_node, d->n));
+      node = tree_cons (ss_target[k], build_int_cst (integer_type_node, d->n),
+                       node);
 
-      tmp = build_constructor (select_struct[k], node);
-      CONSTRUCTOR_APPEND_ELT (inits, NULL_TREE, tmp);
+      tmp = build_constructor_from_list (select_struct[k], nreverse (node));
+      init = tree_cons (NULL_TREE, tmp, init);
     }
 
   type = build_array_type (select_struct[k],
                           build_index_type (build_int_cst (NULL_TREE, n-1)));
 
-  init = build_constructor (type, inits);
+  init = build_constructor_from_list (type, nreverse(init));
   TREE_CONSTANT (init) = 1;
   TREE_STATIC (init) = 1;
   /* Create a static variable to hold the jump table.  */
@@ -2836,7 +2822,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
 
       /* Make a new descriptor.  */
       parmtype = gfc_get_element_type (TREE_TYPE (desc));
-      parmtype = gfc_get_array_type_bounds (parmtype, loop.dimen, 0,
+      parmtype = gfc_get_array_type_bounds (parmtype, loop.dimen,
                                             loop.from, loop.to, 1,
                                            GFC_ARRAY_UNKNOWN, true);
 
@@ -4292,9 +4278,8 @@ gfc_trans_allocate (gfc_code * code)
 
              if (ts->type == BT_DERIVED)
                {
-                 vtab = gfc_find_derived_vtab (ts->u.derived, true);
+                 vtab = gfc_find_derived_vtab (ts->u.derived);
                  gcc_assert (vtab);
-                 gfc_trans_assign_vtab_procs (&block, ts->u.derived, vtab);
                  gfc_init_se (&lse, NULL);
                  lse.want_pointer = 1;
                  gfc_conv_expr (&lse, lhs);