2010-01-08 Tobias Burnus <burnus@net-b.de

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

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index c3d7dfb..208a3b5 100644 (file)
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -832,7 +832,7 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
   tree type;
   tree bound;
   tree tmp;
-  tree cond, cond1, cond2, cond3, cond4, size;
+  tree cond, cond1, cond3, cond4, size;
   tree ubound;
   tree lbound;
   gfc_se argse;
@@ -970,7 +970,6 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
       tree stride = gfc_conv_descriptor_stride_get (desc, bound);
 
       cond1 = fold_build2 (GE_EXPR, boolean_type_node, ubound, lbound);
-      cond2 = fold_build2 (LE_EXPR, boolean_type_node, ubound, lbound);
 
       cond3 = fold_build2 (GE_EXPR, boolean_type_node, stride,
                           gfc_index_zero_node);
@@ -4090,7 +4089,6 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
   gfc_expr *arg;
   gfc_ss *ss;
   gfc_se argse;
-  tree source;
   tree source_bytes;
   tree type;
   tree tmp;
@@ -4106,7 +4104,6 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
   if (ss == gfc_ss_terminator)
     {
       gfc_conv_expr_reference (&argse, arg);
-      source = argse.expr;
 
       type = TREE_TYPE (build_fold_indirect_ref_loc (input_location,
                                                 argse.expr));
@@ -4123,7 +4120,6 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
       source_bytes = gfc_create_var (gfc_array_index_type, "bytes");
       argse.want_pointer = 0;
       gfc_conv_expr_descriptor (&argse, arg, ss);
-      source = gfc_conv_descriptor_data_get (argse.expr);
       type = gfc_get_element_type (TREE_TYPE (argse.expr));
 
       /* Obtain the argument's word length.  */
@@ -4228,7 +4224,6 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
   tree size_bytes;
   tree upper;
   tree lower;
-  tree stride;
   tree stmt;
   gfc_actual_arglist *arg;
   gfc_se argse;
@@ -4332,7 +4327,6 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
          tree idx;
          idx = gfc_rank_cst[n];
          gfc_add_modify (&argse.pre, source_bytes, tmp);
-         stride = gfc_conv_descriptor_stride_get (argse.expr, idx);
          lower = gfc_conv_descriptor_lbound_get (argse.expr, idx);
          upper = gfc_conv_descriptor_ubound_get (argse.expr, idx);
          tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
@@ -4721,14 +4715,20 @@ gfc_conv_same_type_as (gfc_se *se, gfc_expr *expr)
   b = expr->value.function.actual->next->expr;
 
   if (a->ts.type == BT_CLASS)
-    gfc_add_component_ref (a, "$vindex");
+    {
+      gfc_add_component_ref (a, "$vptr");
+      gfc_add_component_ref (a, "$hash");
+    }
   else if (a->ts.type == BT_DERIVED)
-    a = gfc_int_expr (a->ts.u.derived->vindex);
+    a = gfc_int_expr (a->ts.u.derived->hash_value);
 
   if (b->ts.type == BT_CLASS)
-    gfc_add_component_ref (b, "$vindex");
+    {
+      gfc_add_component_ref (b, "$vptr");
+      gfc_add_component_ref (b, "$hash");
+    }
   else if (b->ts.type == BT_DERIVED)
-    b = gfc_int_expr (b->ts.u.derived->vindex);
+    b = gfc_int_expr (b->ts.u.derived->hash_value);
 
   gfc_conv_expr (&se1, a);
   gfc_conv_expr (&se2, b);
@@ -4739,21 +4739,6 @@ gfc_conv_same_type_as (gfc_se *se, gfc_expr *expr)
 }
 
 
-/* Generate code for the EXTENDS_TYPE_OF intrinsic.  */
-
-static void
-gfc_conv_extends_type_of (gfc_se *se, gfc_expr *expr)
-{
-  gfc_expr *e;
-  /* TODO: Implement EXTENDS_TYPE_OF.  */
-  gfc_error ("Intrinsic EXTENDS_TYPE_OF at %L not yet implemented",
-            &expr->where);
-  /* Just return 'false' for now.  */
-  e = gfc_logical_expr (false, &expr->where);
-  gfc_conv_expr (se, e);
-}
-
-
 /* Generate code for SELECTED_CHAR_KIND (NAME) intrinsic function.  */
 
 static void
@@ -5065,13 +5050,10 @@ gfc_conv_intrinsic_loc (gfc_se * se, gfc_expr * expr)
 void
 gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
 {
-  gfc_intrinsic_sym *isym;
   const char *name;
   int lib, kind;
   tree fndecl;
 
-  isym = expr->value.function.isym;
-
   name = &expr->value.function.name[2];
 
   if (expr->rank > 0 && !expr->inline_noncopying_intrinsic)
@@ -5166,10 +5148,6 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_same_type_as (se, expr);
       break;
 
-    case GFC_ISYM_EXTENDS_TYPE_OF:
-      gfc_conv_extends_type_of (se, expr);
-      break;
-
     case GFC_ISYM_ABS:
       gfc_conv_intrinsic_abs (se, expr);
       break;
@@ -5547,6 +5525,7 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
     case GFC_ISYM_CHMOD:
     case GFC_ISYM_DTIME:
     case GFC_ISYM_ETIME:
+    case GFC_ISYM_EXTENDS_TYPE_OF:
     case GFC_ISYM_FGET:
     case GFC_ISYM_FGETC:
     case GFC_ISYM_FNUM: