OSDN Git Service

2007-05-29 Daniel Franke <franke.daniel@gmail.com>
[pf3gnuchains/gcc-fork.git] / gcc / fortran / trans-intrinsic.c
index e6bc46f..9a27b36 100644 (file)
@@ -49,7 +49,7 @@ typedef struct gfc_intrinsic_map_t    GTY(())
 {
   /* The explicit enum is required to work around inadequacies in the
      garbage collection/gengtype parsing mechanism.  */
-  enum gfc_generic_isym_id id;
+  enum gfc_isym_id id;
 
   /* Enum value from the "language-independent", aka C-centric, part
      of gcc, or END_BUILTINS of no such value set.  */
@@ -649,9 +649,9 @@ gfc_conv_intrinsic_lib_function (gfc_se * se, gfc_expr * expr)
   gfc_intrinsic_map_t *m;
   tree args;
   tree fndecl;
-  gfc_generic_isym_id id;
+  gfc_isym_id id;
 
-  id = expr->value.function.isym->generic_id;
+  id = expr->value.function.isym->id;
   /* Find the entry for this function.  */
   for (m = gfc_intrinsic_map; m->id != GFC_ISYM_NONE; m++)
     {
@@ -1275,7 +1275,7 @@ gfc_conv_intrinsic_ctime (gfc_se * se, gfc_expr * expr)
   /* Free the temporary afterwards, if necessary.  */
   cond = build2 (GT_EXPR, boolean_type_node, len,
                 build_int_cst (TREE_TYPE (len), 0));
-  tmp = build_call_expr (gfor_fndecl_internal_free, 1, var);
+  tmp = gfc_call_free (var);
   tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
   gfc_add_expr_to_block (&se->post, tmp);
 
@@ -1310,7 +1310,7 @@ gfc_conv_intrinsic_fdate (gfc_se * se, gfc_expr * expr)
   /* Free the temporary afterwards, if necessary.  */
   cond = build2 (GT_EXPR, boolean_type_node, len,
                 build_int_cst (TREE_TYPE (len), 0));
-  tmp = build_call_expr (gfor_fndecl_internal_free, 1, var);
+  tmp = gfc_call_free (var);
   tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
   gfc_add_expr_to_block (&se->post, tmp);
 
@@ -1347,7 +1347,7 @@ gfc_conv_intrinsic_ttynam (gfc_se * se, gfc_expr * expr)
   /* Free the temporary afterwards, if necessary.  */
   cond = build2 (GT_EXPR, boolean_type_node, len,
                 build_int_cst (TREE_TYPE (len), 0));
-  tmp = build_call_expr (gfor_fndecl_internal_free, 1, var);
+  tmp = gfc_call_free (var);
   tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
   gfc_add_expr_to_block (&se->post, tmp);
 
@@ -1468,7 +1468,7 @@ gfc_conv_intrinsic_funcall (gfc_se * se, gfc_expr * expr)
   /* Calls to libgfortran_matmul need to be appended special arguments,
      to be able to call the BLAS ?gemm functions if required and possible.  */
   append_args = NULL_TREE;
-  if (expr->value.function.isym->generic_id == GFC_ISYM_MATMUL
+  if (expr->value.function.isym->id == GFC_ISYM_MATMUL
       && sym->ts.type != BT_LOGICAL)
     {
       tree cint = gfc_get_int_type (gfc_c_int_kind);
@@ -1604,8 +1604,8 @@ gfc_conv_intrinsic_anyall (gfc_se * se, gfc_expr * expr, int op)
   gfc_conv_expr_val (&arrayse, actual->expr);
 
   gfc_add_block_to_block (&body, &arrayse.pre);
-  tmp = build2 (op, boolean_type_node, arrayse.expr,
-               build_int_cst (TREE_TYPE (arrayse.expr), 0));
+  tmp = fold_build2 (op, boolean_type_node, arrayse.expr,
+                    build_int_cst (TREE_TYPE (arrayse.expr), 0));
   tmp = build3_v (COND_EXPR, tmp, found, build_empty_stmt ());
   gfc_add_expr_to_block (&body, tmp);
   gfc_add_block_to_block (&body, &arrayse.post);
@@ -1840,7 +1840,7 @@ gfc_conv_intrinsic_dot_product (gfc_se * se, gfc_expr * expr)
   /* Initialize the result.  */
   resvar = gfc_create_var (type, "val");
   if (expr->ts.type == BT_LOGICAL)
-    tmp = convert (type, integer_zero_node);
+    tmp = build_int_cst (type, 0);
   else
     tmp = gfc_build_const (type, integer_zero_node);
 
@@ -2400,7 +2400,7 @@ gfc_conv_intrinsic_ishft (gfc_se * se, gfc_expr * expr)
   arg2 = TREE_VALUE (TREE_CHAIN (arg));
   arg = TREE_VALUE (arg);
   type = TREE_TYPE (arg);
-  utype = gfc_unsigned_type (type);
+  utype = unsigned_type_for (type);
 
   width = fold_build1 (ABS_EXPR, TREE_TYPE (arg2), arg2);
 
@@ -2537,7 +2537,7 @@ gfc_conv_intrinsic_len (gfc_se * se, gfc_expr * expr)
       /* Obtain the string length from the function used by
          trans-array.c(gfc_trans_array_constructor).  */
       len = NULL_TREE;
-      get_array_ctor_strlen (arg->value.constructor, &len);
+      get_array_ctor_strlen (&se->pre, arg->value.constructor, &len);
       break;
 
     case EXPR_VARIABLE:
@@ -2681,9 +2681,10 @@ static void
 gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr)
 {
   gfc_actual_arglist *actual;
-  tree args;
+  tree arg1;
   tree type;
-  tree fndecl;
+  tree fncall0;
+  tree fncall1;
   gfc_se argse;
   gfc_ss *ss;
 
@@ -2697,29 +2698,130 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr)
   gfc_conv_expr_descriptor (&argse, actual->expr, ss);
   gfc_add_block_to_block (&se->pre, &argse.pre);
   gfc_add_block_to_block (&se->post, &argse.post);
-  args = gfc_chainon_list (NULL_TREE, argse.expr);
+  arg1 = gfc_evaluate_now (argse.expr, &se->pre);
+
+  /* Build the call to size0.  */
+  fncall0 = build_call_expr (gfor_fndecl_size0, 1, arg1);
 
   actual = actual->next;
+
   if (actual->expr)
     {
       gfc_init_se (&argse, NULL);
-      gfc_conv_expr_type (&argse, actual->expr, gfc_array_index_type);
+      gfc_conv_expr_type (&argse, actual->expr,
+                         gfc_array_index_type);
       gfc_add_block_to_block (&se->pre, &argse.pre);
-      args = gfc_chainon_list (args, argse.expr);
-      fndecl = gfor_fndecl_size1;
+
+      /* Build the call to size1.  */
+      fncall1 = build_call_expr (gfor_fndecl_size1, 2,
+                                arg1, argse.expr);
+
+      /* Unusually, for an intrinsic, size does not exclude
+        an optional arg2, so we must test for it.  */  
+      if (actual->expr->expr_type == EXPR_VARIABLE
+           && actual->expr->symtree->n.sym->attr.dummy
+           && actual->expr->symtree->n.sym->attr.optional)
+       {
+         tree tmp;
+         gfc_init_se (&argse, NULL);
+         argse.want_pointer = 1;
+         argse.data_not_needed = 1;
+         gfc_conv_expr (&argse, actual->expr);
+         gfc_add_block_to_block (&se->pre, &argse.pre);
+         tmp = build2 (NE_EXPR, boolean_type_node, argse.expr,
+                       null_pointer_node);
+         tmp = gfc_evaluate_now (tmp, &se->pre);
+         se->expr = build3 (COND_EXPR, pvoid_type_node,
+                            tmp, fncall1, fncall0);
+       }
+      else
+       se->expr = fncall1;
     }
   else
-    fndecl = gfor_fndecl_size0;
+    se->expr = fncall0;
 
-  se->expr = build_function_call_expr (fndecl, args);
   type = gfc_typenode_for_spec (&expr->ts);
   se->expr = convert (type, se->expr);
 }
 
 
+static void
+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;
+  tree lower;
+  tree upper;
+  /*tree stride;*/
+  int n;
+
+  arg = expr->value.function.actual->expr;
+
+  gfc_init_se (&argse, NULL);
+  ss = gfc_walk_expr (arg);
+
+  source_bytes = gfc_create_var (gfc_array_index_type, "bytes");
+
+  if (ss == gfc_ss_terminator)
+    {
+      gfc_conv_expr_reference (&argse, arg);
+      source = argse.expr;
+
+      type = TREE_TYPE (build_fold_indirect_ref (argse.expr));
+
+      /* Obtain the source word length.  */
+      if (arg->ts.type == BT_CHARACTER)
+       source_bytes = fold_convert (gfc_array_index_type,
+                                    argse.string_length);
+      else
+       source_bytes = fold_convert (gfc_array_index_type,
+                                    size_in_bytes (type)); 
+    }
+  else
+    {
+      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.  */
+      if (arg->ts.type == BT_CHARACTER)
+       tmp = fold_convert (gfc_array_index_type, argse.string_length);
+      else
+       tmp = fold_convert (gfc_array_index_type,
+                           size_in_bytes (type)); 
+      gfc_add_modify_expr (&argse.pre, source_bytes, tmp);
+
+      /* Obtain the size of the array in bytes.  */
+      for (n = 0; n < arg->rank; n++)
+       {
+         tree idx;
+         idx = gfc_rank_cst[n];
+         lower = gfc_conv_descriptor_lbound (argse.expr, idx);
+         upper = gfc_conv_descriptor_ubound (argse.expr, idx);
+         tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
+                            upper, lower);
+         tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
+                            tmp, gfc_index_one_node);
+         tmp = fold_build2 (MULT_EXPR, gfc_array_index_type,
+                            tmp, source_bytes);
+         gfc_add_modify_expr (&argse.pre, source_bytes, tmp);
+       }
+    }
+
+  gfc_add_block_to_block (&se->pre, &argse.pre);
+  se->expr = source_bytes;
+}
+
+
 /* Intrinsic string comparison functions.  */
 
-  static void
+static void
 gfc_conv_intrinsic_strcmp (gfc_se * se, gfc_expr * expr, int op)
 {
   tree type;
@@ -2762,30 +2864,6 @@ gfc_conv_intrinsic_adjust (gfc_se * se, gfc_expr * expr, tree fndecl)
 }
 
 
-/* A helper function for gfc_conv_intrinsic_array_transfer to compute
-   the size of tree expressions in bytes.  */
-static tree
-gfc_size_in_bytes (gfc_se *se, gfc_expr *e)
-{
-  tree tmp;
-
-  if (e->ts.type == BT_CHARACTER)
-    tmp = se->string_length;
-  else
-    {
-      if (e->rank)
-       {
-         tmp = gfc_get_element_type (TREE_TYPE (se->expr));
-         tmp = size_in_bytes (tmp);
-       }
-      else
-       tmp = size_in_bytes (TREE_TYPE (TREE_TYPE (se->expr)));
-    }
-
-  return fold_convert (gfc_array_index_type, tmp);
-}
-
-
 /* Array transfer statement.
      DEST(1:N) = TRANSFER (SOURCE, MOLD[, SIZE])
    where:
@@ -2800,7 +2878,9 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
   tree tmp;
   tree extent;
   tree source;
+  tree source_type;
   tree source_bytes;
+  tree mold_type;
   tree dest_word_len;
   tree size_words;
   tree size_bytes;
@@ -2833,15 +2913,21 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
       gfc_conv_expr_reference (&argse, arg->expr);
       source = argse.expr;
 
+      source_type = TREE_TYPE (build_fold_indirect_ref (argse.expr));
+
       /* Obtain the source word length.  */
-      tmp = gfc_size_in_bytes (&argse, arg->expr);
+      if (arg->expr->ts.type == BT_CHARACTER)
+       tmp = fold_convert (gfc_array_index_type, argse.string_length);
+      else
+       tmp = fold_convert (gfc_array_index_type,
+                           size_in_bytes (source_type)); 
     }
   else
     {
-      gfc_init_se (&argse, NULL);
       argse.want_pointer = 0;
       gfc_conv_expr_descriptor (&argse, arg->expr, ss);
       source = gfc_conv_descriptor_data_get (argse.expr);
+      source_type = gfc_get_element_type (TREE_TYPE (argse.expr));
 
       /* Repack the source if not a full variable array.  */
       if (!(arg->expr->expr_type == EXPR_VARIABLE
@@ -2853,8 +2939,7 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
 
          /* Free the temporary.  */
          gfc_start_block (&block);
-         tmp = convert (pvoid_type_node, source);
-         tmp = build_call_expr (gfor_fndecl_internal_free, 1, tmp);
+         tmp = gfc_call_free (convert (pvoid_type_node, source));
          gfc_add_expr_to_block (&block, tmp);
          stmt = gfc_finish_block (&block);
 
@@ -2870,7 +2955,11 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
        }
 
       /* Obtain the source word length.  */
-      tmp = gfc_size_in_bytes (&argse, arg->expr);
+      if (arg->expr->ts.type == BT_CHARACTER)
+       tmp = fold_convert (gfc_array_index_type, argse.string_length);
+      else
+       tmp = fold_convert (gfc_array_index_type,
+                           size_in_bytes (source_type)); 
 
       /* Obtain the size of the array in bytes.  */
       extent = gfc_create_var (gfc_array_index_type, NULL);
@@ -2882,13 +2971,13 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
          stride = gfc_conv_descriptor_stride (argse.expr, idx);
          lower = gfc_conv_descriptor_lbound (argse.expr, idx);
          upper = gfc_conv_descriptor_ubound (argse.expr, idx);
-         tmp = build2 (MINUS_EXPR, gfc_array_index_type,
-                       upper, lower);
+         tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
+                            upper, lower);
          gfc_add_modify_expr (&argse.pre, extent, tmp);
-         tmp = build2 (PLUS_EXPR, gfc_array_index_type,
-                       extent, gfc_index_one_node);
-         tmp = build2 (MULT_EXPR, gfc_array_index_type,
-                       tmp, source_bytes);
+         tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
+                            extent, gfc_index_one_node);
+         tmp = fold_build2 (MULT_EXPR, gfc_array_index_type,
+                            tmp, source_bytes);
        }
     }
 
@@ -2896,7 +2985,8 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
   gfc_add_block_to_block (&se->pre, &argse.pre);
   gfc_add_block_to_block (&se->post, &argse.post);
 
-  /* Now convert MOLD.  The sole output is:
+  /* Now convert MOLD.  The outputs are:
+       mold_type = the TREE type of MOLD
        dest_word_len = destination word length in bytes.  */
   arg = arg->next;
 
@@ -2906,20 +2996,25 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
   if (ss == gfc_ss_terminator)
     {
       gfc_conv_expr_reference (&argse, arg->expr);
-
-      /* Obtain the source word length.  */
-      tmp = gfc_size_in_bytes (&argse, arg->expr);
+      mold_type = TREE_TYPE (build_fold_indirect_ref (argse.expr));
     }
   else
     {
       gfc_init_se (&argse, NULL);
       argse.want_pointer = 0;
       gfc_conv_expr_descriptor (&argse, arg->expr, ss);
-
-      /* Obtain the source word length.  */
-      tmp = gfc_size_in_bytes (&argse, arg->expr);
+      mold_type = gfc_get_element_type (TREE_TYPE (argse.expr));
     }
 
+  if (arg->expr->ts.type == BT_CHARACTER)
+    {
+      tmp = fold_convert (gfc_array_index_type, argse.string_length);
+      mold_type = gfc_get_character_type_len (arg->expr->ts.kind, tmp);
+    }
+  else
+    tmp = fold_convert (gfc_array_index_type,
+                       size_in_bytes (mold_type)); 
   dest_word_len = gfc_create_var (gfc_array_index_type, NULL);
   gfc_add_modify_expr (&se->pre, dest_word_len, tmp);
 
@@ -2942,17 +3037,18 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
   size_bytes = gfc_create_var (gfc_array_index_type, NULL);
   if (tmp != NULL_TREE)
     {
-      tmp = build2 (MULT_EXPR, gfc_array_index_type,
-                   tmp, dest_word_len);
-      tmp = build2 (MIN_EXPR, gfc_array_index_type, tmp, source_bytes);
+      tmp = fold_build2 (MULT_EXPR, gfc_array_index_type,
+                        tmp, dest_word_len);
+      tmp = fold_build2 (MIN_EXPR, gfc_array_index_type,
+                        tmp, source_bytes);
     }
   else
     tmp = source_bytes;
 
   gfc_add_modify_expr (&se->pre, size_bytes, tmp);
   gfc_add_modify_expr (&se->pre, size_words,
-                      build2 (CEIL_DIV_EXPR, gfc_array_index_type,
-                              size_bytes, dest_word_len));
+                      fold_build2 (CEIL_DIV_EXPR, gfc_array_index_type,
+                                   size_bytes, dest_word_len));
 
   /* Evaluate the bounds of the result.  If the loop range exists, we have
      to check if it is too large.  If so, we modify loop->to be consistent
@@ -2963,23 +3059,23 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
     {
       tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
                         se->loop->to[n], se->loop->from[n]);
-      tmp = build2 (PLUS_EXPR, gfc_array_index_type,
-                   tmp, gfc_index_one_node);
-      tmp = build2 (MIN_EXPR, gfc_array_index_type,
-                   tmp, size_words);
+      tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
+                        tmp, gfc_index_one_node);
+      tmp = fold_build2 (MIN_EXPR, gfc_array_index_type,
+                        tmp, size_words);
       gfc_add_modify_expr (&se->pre, size_words, tmp);
       gfc_add_modify_expr (&se->pre, size_bytes,
-                          build2 (MULT_EXPR, gfc_array_index_type,
-                          size_words, dest_word_len));
-      upper = build2 (PLUS_EXPR, gfc_array_index_type,
-                     size_words, se->loop->from[n]);
-      upper = build2 (MINUS_EXPR, gfc_array_index_type,
-                     upper, gfc_index_one_node);
+                          fold_build2 (MULT_EXPR, gfc_array_index_type,
+                                       size_words, dest_word_len));
+      upper = fold_build2 (PLUS_EXPR, gfc_array_index_type,
+                          size_words, se->loop->from[n]);
+      upper = fold_build2 (MINUS_EXPR, gfc_array_index_type,
+                          upper, gfc_index_one_node);
     }
   else
     {
-      upper = build2 (MINUS_EXPR, gfc_array_index_type,
-                     size_words, gfc_index_one_node);
+      upper = fold_build2 (MINUS_EXPR, gfc_array_index_type,
+                          size_words, gfc_index_one_node);
       se->loop->from[n] = gfc_index_zero_node;
     }
 
@@ -2988,15 +3084,18 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
   /* Build a destination descriptor, using the pointer, source, as the
      data field.  This is already allocated so set callee_alloc.
      FIXME callee_alloc is not set!  */
-  tmp = gfc_typenode_for_spec (&expr->ts);
+
   gfc_trans_create_temp_array (&se->pre, &se->post, se->loop,
-                              info, tmp, false, true, false);
+                              info, mold_type, false, true, false);
+
+  /* Cast the pointer to the result.  */
+  tmp = gfc_conv_descriptor_data_get (info->descriptor);
+  tmp = fold_convert (pvoid_type_node, tmp);
 
   /* Use memcpy to do the transfer.  */
   tmp = build_call_expr (built_in_decls[BUILT_IN_MEMCPY],
                         3,
-                        gfc_conv_descriptor_data_get (info->descriptor),
+                        tmp,
                         fold_convert (pvoid_type_node, source),
                         size_bytes);
   gfc_add_expr_to_block (&se->pre, tmp);
@@ -3338,7 +3437,7 @@ gfc_conv_intrinsic_trim (gfc_se * se, gfc_expr * expr)
   /* Free the temporary afterwards, if necessary.  */
   cond = build2 (GT_EXPR, boolean_type_node, len,
                 build_int_cst (TREE_TYPE (len), 0));
-  tmp = build_call_expr (gfor_fndecl_internal_free, 1, var);
+  tmp = gfc_call_free (var);
   tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
   gfc_add_expr_to_block (&se->post, tmp);
 
@@ -3352,41 +3451,111 @@ gfc_conv_intrinsic_trim (gfc_se * se, gfc_expr * expr)
 static void
 gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr)
 {
-  tree gfc_int4_type_node = gfc_get_int_type (4);
-  tree tmp;
-  tree len;
-  tree args;
-  tree ncopies;
-  tree var;
-  tree type;
-  tree cond;
+  tree args, ncopies, dest, dlen, src, slen, ncopies_type;
+  tree type, cond, tmp, count, exit_label, n, max, largest;
+  stmtblock_t block, body;
+  int i;
 
+  /* Get the arguments.  */
   args = gfc_conv_intrinsic_function_args (se, expr);
-  len = TREE_VALUE (args);
-  tmp = gfc_advance_chain (args, 2);
-  ncopies = TREE_VALUE (tmp);
-
-  /* Check that ncopies is not negative.  */
+  slen = fold_convert (size_type_node, gfc_evaluate_now (TREE_VALUE (args),
+                                                        &se->pre));
+  src = TREE_VALUE (TREE_CHAIN (args));
+  ncopies = TREE_VALUE (TREE_CHAIN (TREE_CHAIN (args)));
   ncopies = gfc_evaluate_now (ncopies, &se->pre);
+  ncopies_type = TREE_TYPE (ncopies);
+
+  /* Check that NCOPIES is not negative.  */
   cond = fold_build2 (LT_EXPR, boolean_type_node, ncopies,
-                     build_int_cst (TREE_TYPE (ncopies), 0));
+                     build_int_cst (ncopies_type, 0));
   gfc_trans_runtime_check (cond,
                           "Argument NCOPIES of REPEAT intrinsic is negative",
                           &se->pre, &expr->where);
 
+  /* If the source length is zero, any non negative value of NCOPIES
+     is valid, and nothing happens.  */
+  n = gfc_create_var (ncopies_type, "ncopies");
+  cond = fold_build2 (EQ_EXPR, boolean_type_node, slen,
+                     build_int_cst (size_type_node, 0));
+  tmp = fold_build3 (COND_EXPR, ncopies_type, cond,
+                    build_int_cst (ncopies_type, 0), ncopies);
+  gfc_add_modify_expr (&se->pre, n, tmp);
+  ncopies = n;
+
+  /* Check that ncopies is not too large: ncopies should be less than
+     (or equal to) MAX / slen, where MAX is the maximal integer of
+     the gfc_charlen_type_node type.  If slen == 0, we need a special
+     case to avoid the division by zero.  */
+  i = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, false);
+  max = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].huge, gfc_charlen_int_kind);
+  max = fold_build2 (TRUNC_DIV_EXPR, size_type_node,
+                    fold_convert (size_type_node, max), slen);
+  largest = TYPE_PRECISION (size_type_node) > TYPE_PRECISION (ncopies_type)
+             ? size_type_node : ncopies_type;
+  cond = fold_build2 (GT_EXPR, boolean_type_node,
+                     fold_convert (largest, ncopies),
+                     fold_convert (largest, max));
+  tmp = fold_build2 (EQ_EXPR, boolean_type_node, slen,
+                    build_int_cst (size_type_node, 0));
+  cond = fold_build3 (COND_EXPR, boolean_type_node, tmp, boolean_false_node,
+                     cond);
+  gfc_trans_runtime_check (cond,
+                          "Argument NCOPIES of REPEAT intrinsic is too large",
+                          &se->pre, &expr->where);
+
   /* Compute the destination length.  */
-  len = fold_build2 (MULT_EXPR, gfc_int4_type_node, len, ncopies);
+  dlen = fold_build2 (MULT_EXPR, gfc_charlen_type_node, slen, ncopies);
   type = gfc_get_character_type (expr->ts.kind, expr->ts.cl);
-  var = gfc_conv_string_tmp (se, build_pointer_type (type), len);
+  dest = gfc_conv_string_tmp (se, build_pointer_type (type), dlen);
+
+  /* Generate the code to do the repeat operation:
+       for (i = 0; i < ncopies; i++)
+         memmove (dest + (i * slen), src, slen);  */
+  gfc_start_block (&block);
+  count = gfc_create_var (ncopies_type, "count");
+  gfc_add_modify_expr (&block, count, build_int_cst (ncopies_type, 0));
+  exit_label = gfc_build_label_decl (NULL_TREE);
+
+  /* Start the loop body.  */
+  gfc_start_block (&body);
+
+  /* Exit the loop if count >= ncopies.  */
+  cond = fold_build2 (GE_EXPR, boolean_type_node, count, ncopies);
+  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);
+
+  /* Call memmove (dest + (i*slen), src, slen).  */
+  tmp = fold_build2 (MULT_EXPR, gfc_charlen_type_node, slen,
+                    fold_convert (gfc_charlen_type_node, count));
+  tmp = fold_build2 (PLUS_EXPR, pchar_type_node, dest,
+                    fold_convert (pchar_type_node, tmp));
+  tmp = build_call_expr (built_in_decls[BUILT_IN_MEMMOVE], 3,
+                        tmp, src, slen);
+  gfc_add_expr_to_block (&body, tmp);
+
+  /* Increment count.  */
+  tmp = build2 (PLUS_EXPR, ncopies_type, count,
+               build_int_cst (TREE_TYPE (count), 1));
+  gfc_add_modify_expr (&body, count, tmp);
 
-  /* Create the argument list and generate the function call.  */
-  tmp = build_call_expr (gfor_fndecl_string_repeat, 4, var,
-                        TREE_VALUE (args),
-                        TREE_VALUE (TREE_CHAIN (args)), ncopies);
+  /* Build the loop.  */
+  tmp = build1_v (LOOP_EXPR, gfc_finish_block (&body));
+  gfc_add_expr_to_block (&block, tmp);
+
+  /* Add the exit label.  */
+  tmp = build1_v (LABEL_EXPR, exit_label);
+  gfc_add_expr_to_block (&block, tmp);
+
+  /* Finish the block.  */
+  tmp = gfc_finish_block (&block);
   gfc_add_expr_to_block (&se->pre, tmp);
 
-  se->expr = var;
-  se->string_length = len;
+  /* Set the result value.  */
+  se->expr = dest;
+  se->string_length = dlen;
 }
 
 
@@ -3465,7 +3634,7 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
        }
     }
 
-  switch (expr->value.function.isym->generic_id)
+  switch (expr->value.function.isym->id)
     {
     case GFC_ISYM_NONE:
       gcc_unreachable ();
@@ -3771,6 +3940,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_intrinsic_size (se, expr);
       break;
 
+    case GFC_ISYM_SIZEOF:
+      gfc_conv_intrinsic_sizeof (se, expr);
+      break;
+
     case GFC_ISYM_SUM:
       gfc_conv_intrinsic_arith (se, expr, PLUS_EXPR);
       break;
@@ -3862,7 +4035,7 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
 void
 gfc_add_intrinsic_ss_code (gfc_loopinfo * loop ATTRIBUTE_UNUSED, gfc_ss * ss)
 {
-  switch (ss->expr->value.function.isym->generic_id)
+  switch (ss->expr->value.function.isym->id)
     {
     case GFC_ISYM_UBOUND:
     case GFC_ISYM_LBOUND:
@@ -3925,7 +4098,7 @@ gfc_is_intrinsic_libcall (gfc_expr * expr)
   gcc_assert (expr->expr_type == EXPR_FUNCTION && expr->value.function.isym);
   gcc_assert (expr->rank > 0);
 
-  switch (expr->value.function.isym->generic_id)
+  switch (expr->value.function.isym->id)
     {
     case GFC_ISYM_ALL:
     case GFC_ISYM_ANY:
@@ -3973,7 +4146,7 @@ gfc_walk_intrinsic_function (gfc_ss * ss, gfc_expr * expr,
     return gfc_walk_intrinsic_libfunc (ss, expr);
 
   /* Special cases.  */
-  switch (isym->generic_id)
+  switch (isym->id)
     {
     case GFC_ISYM_LBOUND:
     case GFC_ISYM_UBOUND: