PR fortran/30947

[pf3gnuchains/gcc-fork.git] / gcc / fortran / iresolve.c

diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index ecb1448..d0a73bf 100644 (file)
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -1,5 +1,5 @@
 /* Intrinsic function resolution.
 /* Intrinsic function resolution.

-   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007

    Free Software Foundation, Inc.
    Contributed by Andy Vaught & Katherine Holcomb
 
    Free Software Foundation, Inc.
    Contributed by Andy Vaught & Katherine Holcomb
 


@@ -7,7 +7,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
 
 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
 version.
 
 GCC is distributed in the hope that it will be useful, but WITHOUT ANY


@@ -16,9 +16,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
 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/>.  */

 
 
 /* Assign name and types to intrinsic procedures.  For functions, the
 
 
 /* Assign name and types to intrinsic procedures.  For functions, the


@@ -35,7 +34,6 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
 #include "gfortran.h"
 #include "intrinsic.h"
 
 #include "gfortran.h"
 #include "intrinsic.h"
 

-

 /* Given printf-like arguments, return a stable version of the result string. 
 
    We already have a working, optimized string hashing table in the form of
 /* Given printf-like arguments, return a stable version of the result string. 
 
    We already have a working, optimized string hashing table in the form of


@@ -51,9 +49,9 @@ gfc_get_string (const char *format, ...)
   tree ident;
 
   va_start (ap, format);
   tree ident;
 
   va_start (ap, format);

-  vsnprintf (temp_name, sizeof(temp_name), format, ap);
+  vsnprintf (temp_name, sizeof (temp_name), format, ap);

   va_end (ap);
   va_end (ap);

-  temp_name[sizeof(temp_name)-1] = 0;
+  temp_name[sizeof (temp_name) - 1] = 0;

 
   ident = get_identifier (temp_name);
   return IDENTIFIER_POINTER (ident);
 
   ident = get_identifier (temp_name);
   return IDENTIFIER_POINTER (ident);


@@ -74,71 +72,133 @@ check_charlen_present (gfc_expr *source)
     }
 }
 
     }
 }
 

+/* Helper function for resolving the "mask" argument.  */
+
+static void
+resolve_mask_arg (gfc_expr *mask)
+{
+  int newkind;
+
+  /* The mask can be kind 4 or 8 for the array case.
+     For the scalar case, coerce it to kind=4 unconditionally
+     (because this is the only kind we have a library function
+     for).  */
+
+  newkind = 0;
+
+  if (mask->rank == 0)
+    {
+      if (mask->ts.kind != 4)
+       newkind = 4;
+    }
+  else
+    {
+      if (mask->ts.kind < 4)
+       newkind = gfc_default_logical_kind;
+    }
+
+  if (newkind)
+    {
+      gfc_typespec ts;
+
+      ts.type = BT_LOGICAL;
+      ts.kind = newkind;
+      gfc_convert_type (mask, &ts, 2);
+    }
+}
+

 /********************** Resolution functions **********************/
 
 
 void
 /********************** Resolution functions **********************/
 
 
 void

-gfc_resolve_abs (gfc_expr * f, gfc_expr * a)
+gfc_resolve_abs (gfc_expr *f, gfc_expr *a)

 {
   f->ts = a->ts;
   if (f->ts.type == BT_COMPLEX)
     f->ts.type = BT_REAL;
 
 {
   f->ts = a->ts;
   if (f->ts.type == BT_COMPLEX)
     f->ts.type = BT_REAL;
 

-  f->value.function.name =
-    gfc_get_string ("__abs_%c%d", gfc_type_letter (a->ts.type), a->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__abs_%c%d", gfc_type_letter (a->ts.type), a->ts.kind);
+}
+
+
+void
+gfc_resolve_access (gfc_expr *f, gfc_expr *name ATTRIBUTE_UNUSED,
+                   gfc_expr *mode ATTRIBUTE_UNUSED)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_c_int_kind;
+  f->value.function.name = PREFIX ("access_func");

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_acos (gfc_expr * f, gfc_expr * x)
+gfc_resolve_achar (gfc_expr *f, gfc_expr *x)
+{
+  
+  f->ts.type = BT_CHARACTER;
+  f->ts.kind = gfc_default_character_kind;
+  f->ts.cl = gfc_get_charlen ();
+  f->ts.cl->next = gfc_current_ns->cl_list;
+  gfc_current_ns->cl_list = f->ts.cl;
+  f->ts.cl->length = gfc_int_expr (1);
+
+  f->value.function.name
+    = gfc_get_string ("__achar_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+}
+
+
+void
+gfc_resolve_acos (gfc_expr *f, gfc_expr *x)

 {
   f->ts = x->ts;
 {
   f->ts = x->ts;

-  f->value.function.name =
-    gfc_get_string ("__acos_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__acos_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_acosh (gfc_expr * f, gfc_expr * x)
+gfc_resolve_acosh (gfc_expr *f, gfc_expr *x)

 {
   f->ts = x->ts;
 {
   f->ts = x->ts;

-  f->value.function.name =
-    gfc_get_string ("__acosh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__acosh_%c%d", gfc_type_letter (x->ts.type),
+                     x->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_aimag (gfc_expr * f, gfc_expr * x)
+gfc_resolve_aimag (gfc_expr *f, gfc_expr *x)

 {
   f->ts.type = BT_REAL;
   f->ts.kind = x->ts.kind;
 {
   f->ts.type = BT_REAL;
   f->ts.kind = x->ts.kind;

-  f->value.function.name =
-    gfc_get_string ("__aimag_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__aimag_%c%d", gfc_type_letter (x->ts.type),
+                     x->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_and (gfc_expr * f, gfc_expr * i, gfc_expr * j)
+gfc_resolve_and (gfc_expr *f, gfc_expr *i, gfc_expr *j)

 {
   f->ts.type = i->ts.type;
 {
   f->ts.type = i->ts.type;

-  f->ts.kind = gfc_kind_max (i,j);
+  f->ts.kind = gfc_kind_max (i, j);

 
   if (i->ts.kind != j->ts.kind)
     {
 
   if (i->ts.kind != j->ts.kind)
     {

-      if (i->ts.kind == gfc_kind_max (i,j))
-       gfc_convert_type(j, &i->ts, 2);
+      if (i->ts.kind == gfc_kind_max (i, j))
+       gfc_convert_type (j, &i->ts, 2);

       else
       else

-       gfc_convert_type(i, &j->ts, 2);
+       gfc_convert_type (i, &j->ts, 2);

     }
 
     }
 

-  f->value.function.name = gfc_get_string ("__and_%c%d",
-                                          gfc_type_letter (i->ts.type),
-                                          f->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__and_%c%d", gfc_type_letter (i->ts.type), f->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_aint (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
+gfc_resolve_aint (gfc_expr *f, gfc_expr *a, gfc_expr *kind)

 {
   gfc_typespec ts;
   
 {
   gfc_typespec ts;
   


@@ -153,20 +213,20 @@ gfc_resolve_aint (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
     }
   /* The resolved name is only used for specific intrinsics where
      the return kind is the same as the arg kind.  */
     }
   /* The resolved name is only used for specific intrinsics where
      the return kind is the same as the arg kind.  */

-  f->value.function.name =
-    gfc_get_string ("__aint_%c%d", gfc_type_letter (a->ts.type), a->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__aint_%c%d", gfc_type_letter (a->ts.type), a->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_dint (gfc_expr * f, gfc_expr * a)
+gfc_resolve_dint (gfc_expr *f, gfc_expr *a)

 {
   gfc_resolve_aint (f, a, NULL);
 }
 
 
 void
 {
   gfc_resolve_aint (f, a, NULL);
 }
 
 
 void

-gfc_resolve_all (gfc_expr * f, gfc_expr * mask, gfc_expr * dim)
+gfc_resolve_all (gfc_expr *f, gfc_expr *mask, gfc_expr *dim)

 {
   f->ts = mask->ts;
 
 {
   f->ts = mask->ts;
 


@@ -177,14 +237,14 @@ gfc_resolve_all (gfc_expr * f, gfc_expr * mask, gfc_expr * dim)
       f->shape = gfc_copy_shape_excluding (mask->shape, mask->rank, dim);
     }
 
       f->shape = gfc_copy_shape_excluding (mask->shape, mask->rank, dim);
     }
 

-  f->value.function.name =
-    gfc_get_string (PREFIX("all_%c%d"), gfc_type_letter (mask->ts.type),
-                   mask->ts.kind);
+  f->value.function.name
+    = gfc_get_string (PREFIX ("all_%c%d"), gfc_type_letter (mask->ts.type),
+                     mask->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_anint (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
+gfc_resolve_anint (gfc_expr *f, gfc_expr *a, gfc_expr *kind)

 {
   gfc_typespec ts;
   
 {
   gfc_typespec ts;
   


@@ -200,20 +260,21 @@ gfc_resolve_anint (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
 
   /* The resolved name is only used for specific intrinsics where
      the return kind is the same as the arg kind.  */
 
   /* The resolved name is only used for specific intrinsics where
      the return kind is the same as the arg kind.  */

-  f->value.function.name =
-    gfc_get_string ("__anint_%c%d", gfc_type_letter (a->ts.type), a->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__anint_%c%d", gfc_type_letter (a->ts.type),
+                     a->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_dnint (gfc_expr * f, gfc_expr * a)
+gfc_resolve_dnint (gfc_expr *f, gfc_expr *a)

 {
   gfc_resolve_anint (f, a, NULL);
 }
 
 
 void
 {
   gfc_resolve_anint (f, a, NULL);
 }
 
 
 void

-gfc_resolve_any (gfc_expr * f, gfc_expr * mask, gfc_expr * dim)
+gfc_resolve_any (gfc_expr *f, gfc_expr *mask, gfc_expr *dim)

 {
   f->ts = mask->ts;
 
 {
   f->ts = mask->ts;
 


@@ -224,58 +285,60 @@ gfc_resolve_any (gfc_expr * f, gfc_expr * mask, gfc_expr * dim)
       f->shape = gfc_copy_shape_excluding (mask->shape, mask->rank, dim);
     }
 
       f->shape = gfc_copy_shape_excluding (mask->shape, mask->rank, dim);
     }
 

-  f->value.function.name =
-    gfc_get_string (PREFIX("any_%c%d"), gfc_type_letter (mask->ts.type),
-                   mask->ts.kind);
+  f->value.function.name
+    = gfc_get_string (PREFIX ("any_%c%d"), gfc_type_letter (mask->ts.type),
+                     mask->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_asin (gfc_expr * f, gfc_expr * x)
+gfc_resolve_asin (gfc_expr *f, gfc_expr *x)

 {
   f->ts = x->ts;
 {
   f->ts = x->ts;

-  f->value.function.name =
-    gfc_get_string ("__asin_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__asin_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);

 }
 
 void
 }
 
 void

-gfc_resolve_asinh (gfc_expr * f, gfc_expr * x)
+gfc_resolve_asinh (gfc_expr *f, gfc_expr *x)

 {
   f->ts = x->ts;
 {
   f->ts = x->ts;

-  f->value.function.name =
-    gfc_get_string ("__asinh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__asinh_%c%d", gfc_type_letter (x->ts.type),
+                     x->ts.kind);

 }
 
 void
 }
 
 void

-gfc_resolve_atan (gfc_expr * f, gfc_expr * x)
+gfc_resolve_atan (gfc_expr *f, gfc_expr *x)

 {
   f->ts = x->ts;
 {
   f->ts = x->ts;

-  f->value.function.name =
-    gfc_get_string ("__atan_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__atan_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);

 }
 
 void
 }
 
 void

-gfc_resolve_atanh (gfc_expr * f, gfc_expr * x)
+gfc_resolve_atanh (gfc_expr *f, gfc_expr *x)

 {
   f->ts = x->ts;
 {
   f->ts = x->ts;

-  f->value.function.name =
-    gfc_get_string ("__atanh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__atanh_%c%d", gfc_type_letter (x->ts.type),
+                     x->ts.kind);

 }
 
 void
 }
 
 void

-gfc_resolve_atan2 (gfc_expr * f, gfc_expr * x,
-                  gfc_expr * y ATTRIBUTE_UNUSED)
+gfc_resolve_atan2 (gfc_expr *f, gfc_expr *x, gfc_expr *y ATTRIBUTE_UNUSED)

 {
   f->ts = x->ts;
 {
   f->ts = x->ts;

-  f->value.function.name =
-    gfc_get_string ("__atan2_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__atan2_%c%d", gfc_type_letter (x->ts.type),
+                     x->ts.kind);

 }
 
 
 /* Resolve the BESYN and BESJN intrinsics.  */
 
 void
 }
 
 
 /* Resolve the BESYN and BESJN intrinsics.  */
 
 void

-gfc_resolve_besn (gfc_expr * f, gfc_expr * n, gfc_expr * x)
+gfc_resolve_besn (gfc_expr *f, gfc_expr *n, gfc_expr *x)

 {
   gfc_typespec ts;
   
 {
   gfc_typespec ts;
   


@@ -291,53 +354,50 @@ gfc_resolve_besn (gfc_expr * f, gfc_expr * n, gfc_expr * x)
 
 
 void
 
 
 void

-gfc_resolve_btest (gfc_expr * f, gfc_expr * i, gfc_expr * pos)
+gfc_resolve_btest (gfc_expr *f, gfc_expr *i, gfc_expr *pos)

 {
   f->ts.type = BT_LOGICAL;
   f->ts.kind = gfc_default_logical_kind;
 {
   f->ts.type = BT_LOGICAL;
   f->ts.kind = gfc_default_logical_kind;

-
-  f->value.function.name = gfc_get_string ("__btest_%d_%d", i->ts.kind,
-                                          pos->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__btest_%d_%d", i->ts.kind, pos->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_ceiling (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
+gfc_resolve_ceiling (gfc_expr *f, gfc_expr *a, gfc_expr *kind)

 {
   f->ts.type = BT_INTEGER;
 {
   f->ts.type = BT_INTEGER;

-  f->ts.kind = (kind == NULL) ? gfc_default_integer_kind
-    : mpz_get_si (kind->value.integer);
-
-  f->value.function.name =
-    gfc_get_string ("__ceiling_%d_%c%d", f->ts.kind,
-                   gfc_type_letter (a->ts.type), a->ts.kind);
+  f->ts.kind = (kind == NULL)
+            ? gfc_default_integer_kind : mpz_get_si (kind->value.integer);
+  f->value.function.name
+    = gfc_get_string ("__ceiling_%d_%c%d", f->ts.kind,
+                     gfc_type_letter (a->ts.type), a->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_char (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
+gfc_resolve_char (gfc_expr *f, gfc_expr *a, gfc_expr *kind)

 {
   f->ts.type = BT_CHARACTER;
 {
   f->ts.type = BT_CHARACTER;

-  f->ts.kind = (kind == NULL) ? gfc_default_character_kind
-    : mpz_get_si (kind->value.integer);
-
-  f->value.function.name =
-    gfc_get_string ("__char_%d_%c%d", f->ts.kind,
-                   gfc_type_letter (a->ts.type), a->ts.kind);
+  f->ts.kind = (kind == NULL)
+            ? gfc_default_character_kind : mpz_get_si (kind->value.integer);
+  f->value.function.name
+    = gfc_get_string ("__char_%d_%c%d", f->ts.kind,
+                     gfc_type_letter (a->ts.type), a->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_chdir (gfc_expr * f, gfc_expr * d ATTRIBUTE_UNUSED)
+gfc_resolve_chdir (gfc_expr *f, gfc_expr *d ATTRIBUTE_UNUSED)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;

-  f->value.function.name = gfc_get_string (PREFIX("chdir_i%d"), f->ts.kind);
+  f->value.function.name = gfc_get_string (PREFIX ("chdir_i%d"), f->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_chdir_sub (gfc_code * c)
+gfc_resolve_chdir_sub (gfc_code *c)

 {
   const char *name;
   int kind;
 {
   const char *name;
   int kind;


@@ -347,37 +407,65 @@ gfc_resolve_chdir_sub (gfc_code * c)
   else
     kind = gfc_default_integer_kind;
 
   else
     kind = gfc_default_integer_kind;
 

-  name = gfc_get_string (PREFIX("chdir_i%d_sub"), kind);
+  name = gfc_get_string (PREFIX ("chdir_i%d_sub"), kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_chmod (gfc_expr *f, gfc_expr *name ATTRIBUTE_UNUSED,
+                  gfc_expr *mode ATTRIBUTE_UNUSED)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_c_int_kind;
+  f->value.function.name = PREFIX ("chmod_func");
+}
+
+
+void
+gfc_resolve_chmod_sub (gfc_code *c)
+{
+  const char *name;
+  int kind;
+
+  if (c->ext.actual->next->next->expr != NULL)
+    kind = c->ext.actual->next->next->expr->ts.kind;
+  else
+    kind = gfc_default_integer_kind;
+
+  name = gfc_get_string (PREFIX ("chmod_i%d_sub"), kind);

   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void

-gfc_resolve_cmplx (gfc_expr * f, gfc_expr * x, gfc_expr * y, gfc_expr * kind)
+gfc_resolve_cmplx (gfc_expr *f, gfc_expr *x, gfc_expr *y, gfc_expr *kind)

 {
   f->ts.type = BT_COMPLEX;
 {
   f->ts.type = BT_COMPLEX;

-  f->ts.kind = (kind == NULL) ? gfc_default_real_kind
-    : mpz_get_si (kind->value.integer);
+  f->ts.kind = (kind == NULL)
+            ? gfc_default_real_kind : mpz_get_si (kind->value.integer);

 
   if (y == NULL)
 
   if (y == NULL)

-    f->value.function.name =
-      gfc_get_string ("__cmplx0_%d_%c%d", f->ts.kind,
-                     gfc_type_letter (x->ts.type), x->ts.kind);
+    f->value.function.name
+      = gfc_get_string ("__cmplx0_%d_%c%d", f->ts.kind,
+                       gfc_type_letter (x->ts.type), x->ts.kind);

   else
   else

-    f->value.function.name =
-      gfc_get_string ("__cmplx1_%d_%c%d_%c%d", f->ts.kind,
-                     gfc_type_letter (x->ts.type), x->ts.kind,
-                     gfc_type_letter (y->ts.type), y->ts.kind);
+    f->value.function.name
+      = gfc_get_string ("__cmplx1_%d_%c%d_%c%d", f->ts.kind,
+                       gfc_type_letter (x->ts.type), x->ts.kind,
+                       gfc_type_letter (y->ts.type), y->ts.kind);

 }
 
 }
 

+

 void
 void

-gfc_resolve_dcmplx (gfc_expr * f, gfc_expr * x, gfc_expr * y)
+gfc_resolve_dcmplx (gfc_expr *f, gfc_expr *x, gfc_expr *y)

 {
   gfc_resolve_cmplx (f, x, y, gfc_int_expr (gfc_default_double_kind));
 }
 
 {
   gfc_resolve_cmplx (f, x, y, gfc_int_expr (gfc_default_double_kind));
 }
 

+

 void
 void

-gfc_resolve_complex (gfc_expr * f, gfc_expr * x, gfc_expr * y)
+gfc_resolve_complex (gfc_expr *f, gfc_expr *x, gfc_expr *y)

 {
   int kind;
 
 {
   int kind;
 


@@ -398,16 +486,15 @@ gfc_resolve_complex (gfc_expr * f, gfc_expr * x, gfc_expr * y)
 
   f->ts.type = BT_COMPLEX;
   f->ts.kind = kind;
 
   f->ts.type = BT_COMPLEX;
   f->ts.kind = kind;

-
-  f->value.function.name =
-    gfc_get_string ("__cmplx1_%d_%c%d_%c%d", f->ts.kind,
-                   gfc_type_letter (x->ts.type), x->ts.kind,
-                   gfc_type_letter (y->ts.type), y->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__cmplx1_%d_%c%d_%c%d", f->ts.kind,
+                     gfc_type_letter (x->ts.type), x->ts.kind,
+                     gfc_type_letter (y->ts.type), y->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_conjg (gfc_expr * f, gfc_expr * x)
+gfc_resolve_conjg (gfc_expr *f, gfc_expr *x)

 {
   f->ts = x->ts;
   f->value.function.name = gfc_get_string ("__conjg_%d", x->ts.kind);
 {
   f->ts = x->ts;
   f->value.function.name = gfc_get_string ("__conjg_%d", x->ts.kind);


@@ -415,25 +502,25 @@ gfc_resolve_conjg (gfc_expr * f, gfc_expr * x)
 
 
 void
 
 
 void

-gfc_resolve_cos (gfc_expr * f, gfc_expr * x)
+gfc_resolve_cos (gfc_expr *f, gfc_expr *x)

 {
   f->ts = x->ts;
 {
   f->ts = x->ts;

-  f->value.function.name =
-    gfc_get_string ("__cos_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__cos_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_cosh (gfc_expr * f, gfc_expr * x)
+gfc_resolve_cosh (gfc_expr *f, gfc_expr *x)

 {
   f->ts = x->ts;
 {
   f->ts = x->ts;

-  f->value.function.name =
-    gfc_get_string ("__cosh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__cosh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_count (gfc_expr * f, gfc_expr * mask, gfc_expr * dim)
+gfc_resolve_count (gfc_expr *f, gfc_expr *mask, gfc_expr *dim)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;


@@ -445,16 +532,15 @@ gfc_resolve_count (gfc_expr * f, gfc_expr * mask, gfc_expr * dim)
       f->shape = gfc_copy_shape_excluding (mask->shape, mask->rank, dim);
     }
 
       f->shape = gfc_copy_shape_excluding (mask->shape, mask->rank, dim);
     }
 

-  f->value.function.name =
-    gfc_get_string (PREFIX("count_%d_%c%d"), f->ts.kind,
-                   gfc_type_letter (mask->ts.type), mask->ts.kind);
+  f->value.function.name
+    = gfc_get_string (PREFIX ("count_%d_%c%d"), f->ts.kind,
+                     gfc_type_letter (mask->ts.type), mask->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_cshift (gfc_expr * f, gfc_expr * array,
-                   gfc_expr * shift,
-                   gfc_expr * dim)
+gfc_resolve_cshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
+                   gfc_expr *dim)

 {
   int n;
 
 {
   int n;
 


@@ -484,14 +570,14 @@ gfc_resolve_cshift (gfc_expr * f, gfc_expr * array,
       if (dim->ts.kind != shift->ts.kind)
        gfc_convert_type_warn (dim, &shift->ts, 2, 0);
     }
       if (dim->ts.kind != shift->ts.kind)
        gfc_convert_type_warn (dim, &shift->ts, 2, 0);
     }

-  f->value.function.name =
-    gfc_get_string (PREFIX("cshift%d_%d%s"), n, shift->ts.kind,
-                   array->ts.type == BT_CHARACTER ? "_char" : "");
+  f->value.function.name
+    = gfc_get_string (PREFIX ("cshift%d_%d%s"), n, shift->ts.kind,
+                     array->ts.type == BT_CHARACTER ? "_char" : "");

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_ctime (gfc_expr * f, gfc_expr * time)
+gfc_resolve_ctime (gfc_expr *f, gfc_expr *time)

 {
   gfc_typespec ts;
   
 {
   gfc_typespec ts;
   


@@ -508,22 +594,22 @@ gfc_resolve_ctime (gfc_expr * f, gfc_expr * time)
       gfc_convert_type (time, &ts, 2);
     }
 
       gfc_convert_type (time, &ts, 2);
     }
 

-  f->value.function.name = gfc_get_string (PREFIX("ctime"));
+  f->value.function.name = gfc_get_string (PREFIX ("ctime"));

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_dble (gfc_expr * f, gfc_expr * a)
+gfc_resolve_dble (gfc_expr *f, gfc_expr *a)

 {
   f->ts.type = BT_REAL;
   f->ts.kind = gfc_default_double_kind;
 {
   f->ts.type = BT_REAL;
   f->ts.kind = gfc_default_double_kind;

-  f->value.function.name =
-    gfc_get_string ("__dble_%c%d", gfc_type_letter (a->ts.type), a->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__dble_%c%d", gfc_type_letter (a->ts.type), a->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_dim (gfc_expr * f, gfc_expr * a, gfc_expr * p)
+gfc_resolve_dim (gfc_expr *f, gfc_expr *a, gfc_expr *p)

 {
   f->ts.type = a->ts.type;
   if (p != NULL)
 {
   f->ts.type = a->ts.type;
   if (p != NULL)


@@ -534,18 +620,18 @@ gfc_resolve_dim (gfc_expr * f, gfc_expr * a, gfc_expr * p)
   if (p != NULL && a->ts.kind != p->ts.kind)
     {
       if (a->ts.kind == gfc_kind_max (a,p))
   if (p != NULL && a->ts.kind != p->ts.kind)
     {
       if (a->ts.kind == gfc_kind_max (a,p))

-       gfc_convert_type(p, &a->ts, 2);
+       gfc_convert_type (p, &a->ts, 2);

       else
       else

-       gfc_convert_type(a, &p->ts, 2);
+       gfc_convert_type (a, &p->ts, 2);

     }
 
     }
 

-  f->value.function.name =
-    gfc_get_string ("__dim_%c%d", gfc_type_letter (f->ts.type), f->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__dim_%c%d", gfc_type_letter (f->ts.type), f->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_dot_product (gfc_expr * f, gfc_expr * a, gfc_expr * b)
+gfc_resolve_dot_product (gfc_expr *f, gfc_expr *a, gfc_expr *b)

 {
   gfc_expr temp;
 
 {
   gfc_expr temp;
 


@@ -556,30 +642,25 @@ gfc_resolve_dot_product (gfc_expr * f, gfc_expr * a, gfc_expr * b)
   temp.value.op.op2 = b;
   gfc_type_convert_binary (&temp);
   f->ts = temp.ts;
   temp.value.op.op2 = b;
   gfc_type_convert_binary (&temp);
   f->ts = temp.ts;

-
-  f->value.function.name =
-    gfc_get_string (PREFIX("dot_product_%c%d"), gfc_type_letter (f->ts.type),
-                   f->ts.kind);
+  f->value.function.name
+    = gfc_get_string (PREFIX ("dot_product_%c%d"),
+                     gfc_type_letter (f->ts.type), f->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_dprod (gfc_expr * f,
-                  gfc_expr * a ATTRIBUTE_UNUSED,
-                  gfc_expr * b ATTRIBUTE_UNUSED)
+gfc_resolve_dprod (gfc_expr *f, gfc_expr *a ATTRIBUTE_UNUSED,
+                  gfc_expr *b ATTRIBUTE_UNUSED)

 {
   f->ts.kind = gfc_default_double_kind;
   f->ts.type = BT_REAL;
 {
   f->ts.kind = gfc_default_double_kind;
   f->ts.type = BT_REAL;

-

   f->value.function.name = gfc_get_string ("__dprod_r%d", f->ts.kind);
 }
 
 
 void
   f->value.function.name = gfc_get_string ("__dprod_r%d", f->ts.kind);
 }
 
 
 void

-gfc_resolve_eoshift (gfc_expr * f, gfc_expr * array,
-                    gfc_expr * shift,
-                    gfc_expr * boundary,
-                    gfc_expr * dim)
+gfc_resolve_eoshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
+                    gfc_expr *boundary, gfc_expr *dim)

 {
   int n;
 
 {
   int n;
 


@@ -611,66 +692,64 @@ gfc_resolve_eoshift (gfc_expr * f, gfc_expr * array,
        gfc_convert_type_warn (dim, &shift->ts, 2, 0);
     }
 
        gfc_convert_type_warn (dim, &shift->ts, 2, 0);
     }
 

-  f->value.function.name =
-    gfc_get_string (PREFIX("eoshift%d_%d%s"), n, shift->ts.kind,
-                   array->ts.type == BT_CHARACTER ? "_char" : "");
+  f->value.function.name
+    = gfc_get_string (PREFIX ("eoshift%d_%d%s"), n, shift->ts.kind,
+                     array->ts.type == BT_CHARACTER ? "_char" : "");

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_exp (gfc_expr * f, gfc_expr * x)
+gfc_resolve_exp (gfc_expr *f, gfc_expr *x)

 {
   f->ts = x->ts;
 {
   f->ts = x->ts;

-  f->value.function.name =
-    gfc_get_string ("__exp_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__exp_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_exponent (gfc_expr * f, gfc_expr * x)
+gfc_resolve_exponent (gfc_expr *f, gfc_expr *x)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;

-

   f->value.function.name = gfc_get_string ("__exponent_%d", x->ts.kind);
 }
 
 
 void
   f->value.function.name = gfc_get_string ("__exponent_%d", x->ts.kind);
 }
 
 
 void

-gfc_resolve_fdate (gfc_expr * f)
+gfc_resolve_fdate (gfc_expr *f)

 {
   f->ts.type = BT_CHARACTER;
   f->ts.kind = gfc_default_character_kind;
 {
   f->ts.type = BT_CHARACTER;
   f->ts.kind = gfc_default_character_kind;

-  f->value.function.name = gfc_get_string (PREFIX("fdate"));
+  f->value.function.name = gfc_get_string (PREFIX ("fdate"));

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_floor (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
+gfc_resolve_floor (gfc_expr *f, gfc_expr *a, gfc_expr *kind)

 {
   f->ts.type = BT_INTEGER;
 {
   f->ts.type = BT_INTEGER;

-  f->ts.kind = (kind == NULL) ? gfc_default_integer_kind
-    : mpz_get_si (kind->value.integer);
-
-  f->value.function.name =
-    gfc_get_string ("__floor%d_%c%d", f->ts.kind,
-                   gfc_type_letter (a->ts.type), a->ts.kind);
+  f->ts.kind = (kind == NULL)
+            ? gfc_default_integer_kind : mpz_get_si (kind->value.integer);
+  f->value.function.name
+    = gfc_get_string ("__floor%d_%c%d", f->ts.kind,
+                     gfc_type_letter (a->ts.type), a->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_fnum (gfc_expr * f, gfc_expr * n)
+gfc_resolve_fnum (gfc_expr *f, gfc_expr *n)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
   if (n->ts.kind != f->ts.kind)
     gfc_convert_type (n, &f->ts, 2);
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
   if (n->ts.kind != f->ts.kind)
     gfc_convert_type (n, &f->ts, 2);

-  f->value.function.name = gfc_get_string (PREFIX("fnum_i%d"), f->ts.kind);
+  f->value.function.name = gfc_get_string (PREFIX ("fnum_i%d"), f->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_fraction (gfc_expr * f, gfc_expr * x)
+gfc_resolve_fraction (gfc_expr *f, gfc_expr *x)

 {
   f->ts = x->ts;
   f->value.function.name = gfc_get_string ("__fraction_%d", x->ts.kind);
 {
   f->ts = x->ts;
   f->value.function.name = gfc_get_string ("__fraction_%d", x->ts.kind);


@@ -680,7 +759,7 @@ gfc_resolve_fraction (gfc_expr * f, gfc_expr * x)
 /* Resolve single-argument g77 math intrinsics, eg BESY0, ERF.  */
 
 void
 /* Resolve single-argument g77 math intrinsics, eg BESY0, ERF.  */
 
 void

-gfc_resolve_g77_math1 (gfc_expr * f, gfc_expr * x)
+gfc_resolve_g77_math1 (gfc_expr *f, gfc_expr *x)

 {
   f->ts = x->ts;
   f->value.function.name = gfc_get_string ("<intrinsic>");
 {
   f->ts = x->ts;
   f->value.function.name = gfc_get_string ("<intrinsic>");


@@ -688,60 +767,62 @@ gfc_resolve_g77_math1 (gfc_expr * f, gfc_expr * x)
 
 
 void
 
 
 void

-gfc_resolve_getcwd (gfc_expr * f, gfc_expr * n ATTRIBUTE_UNUSED)
+gfc_resolve_getcwd (gfc_expr *f, gfc_expr *n ATTRIBUTE_UNUSED)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = 4;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = 4;

-  f->value.function.name = gfc_get_string (PREFIX("getcwd"));
+  f->value.function.name = gfc_get_string (PREFIX ("getcwd"));

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_getgid (gfc_expr * f)
+gfc_resolve_getgid (gfc_expr *f)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = 4;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = 4;

-  f->value.function.name = gfc_get_string (PREFIX("getgid"));
+  f->value.function.name = gfc_get_string (PREFIX ("getgid"));

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_getpid (gfc_expr * f)
+gfc_resolve_getpid (gfc_expr *f)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = 4;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = 4;

-  f->value.function.name = gfc_get_string (PREFIX("getpid"));
+  f->value.function.name = gfc_get_string (PREFIX ("getpid"));

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_getuid (gfc_expr * f)
+gfc_resolve_getuid (gfc_expr *f)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = 4;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = 4;

-  f->value.function.name = gfc_get_string (PREFIX("getuid"));
+  f->value.function.name = gfc_get_string (PREFIX ("getuid"));

 }
 
 }
 

+

 void
 void

-gfc_resolve_hostnm (gfc_expr * f, gfc_expr * n ATTRIBUTE_UNUSED)
+gfc_resolve_hostnm (gfc_expr *f, gfc_expr *n ATTRIBUTE_UNUSED)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = 4;
   f->value.function.name = gfc_get_string (PREFIX ("hostnm"));
 }
 
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = 4;
   f->value.function.name = gfc_get_string (PREFIX ("hostnm"));
 }
 

+

 void
 void

-gfc_resolve_iand (gfc_expr * f, gfc_expr * i, gfc_expr * j)
+gfc_resolve_iand (gfc_expr *f, gfc_expr *i, gfc_expr *j)

 {
   /* If the kind of i and j are different, then g77 cross-promoted the
      kinds to the largest value.  The Fortran 95 standard requires the 
      kinds to match.  */
   if (i->ts.kind != j->ts.kind)
     {
 {
   /* If the kind of i and j are different, then g77 cross-promoted the
      kinds to the largest value.  The Fortran 95 standard requires the 
      kinds to match.  */
   if (i->ts.kind != j->ts.kind)
     {

-      if (i->ts.kind == gfc_kind_max (i,j))
-       gfc_convert_type(j, &i->ts, 2);
+      if (i->ts.kind == gfc_kind_max (i, j))
+       gfc_convert_type (j, &i->ts, 2);

       else
       else

-       gfc_convert_type(i, &j->ts, 2);
+       gfc_convert_type (i, &j->ts, 2);

     }
 
   f->ts = i->ts;
     }
 
   f->ts = i->ts;


@@ -750,7 +831,7 @@ gfc_resolve_iand (gfc_expr * f, gfc_expr * i, gfc_expr * j)
 
 
 void
 
 
 void

-gfc_resolve_ibclr (gfc_expr * f, gfc_expr * i, gfc_expr * pos ATTRIBUTE_UNUSED)
+gfc_resolve_ibclr (gfc_expr *f, gfc_expr *i, gfc_expr *pos ATTRIBUTE_UNUSED)

 {
   f->ts = i->ts;
   f->value.function.name = gfc_get_string ("__ibclr_%d", i->ts.kind);
 {
   f->ts = i->ts;
   f->value.function.name = gfc_get_string ("__ibclr_%d", i->ts.kind);


@@ -758,9 +839,8 @@ gfc_resolve_ibclr (gfc_expr * f, gfc_expr * i, gfc_expr * pos ATTRIBUTE_UNUSED)
 
 
 void
 
 
 void

-gfc_resolve_ibits (gfc_expr * f, gfc_expr * i,
-                  gfc_expr * pos ATTRIBUTE_UNUSED,
-                  gfc_expr * len ATTRIBUTE_UNUSED)
+gfc_resolve_ibits (gfc_expr *f, gfc_expr *i, gfc_expr *pos ATTRIBUTE_UNUSED,
+                  gfc_expr *len ATTRIBUTE_UNUSED)

 {
   f->ts = i->ts;
   f->value.function.name = gfc_get_string ("__ibits_%d", i->ts.kind);
 {
   f->ts = i->ts;
   f->value.function.name = gfc_get_string ("__ibits_%d", i->ts.kind);


@@ -768,8 +848,7 @@ gfc_resolve_ibits (gfc_expr * f, gfc_expr * i,
 
 
 void
 
 
 void

-gfc_resolve_ibset (gfc_expr * f, gfc_expr * i,
-                  gfc_expr * pos ATTRIBUTE_UNUSED)
+gfc_resolve_ibset (gfc_expr *f, gfc_expr *i, gfc_expr *pos ATTRIBUTE_UNUSED)

 {
   f->ts = i->ts;
   f->value.function.name = gfc_get_string ("__ibset_%d", i->ts.kind);
 {
   f->ts = i->ts;
   f->value.function.name = gfc_get_string ("__ibset_%d", i->ts.kind);


@@ -777,43 +856,42 @@ gfc_resolve_ibset (gfc_expr * f, gfc_expr * i,
 
 
 void
 
 
 void

-gfc_resolve_ichar (gfc_expr * f, gfc_expr * c)
+gfc_resolve_ichar (gfc_expr *f, gfc_expr *c)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;

-

   f->value.function.name = gfc_get_string ("__ichar_%d", c->ts.kind);
 }
 
 
 void
   f->value.function.name = gfc_get_string ("__ichar_%d", c->ts.kind);
 }
 
 
 void

-gfc_resolve_idnint (gfc_expr * f, gfc_expr * a)
+gfc_resolve_idnint (gfc_expr *f, gfc_expr *a)

 {
   gfc_resolve_nint (f, a, NULL);
 }
 
 
 void
 {
   gfc_resolve_nint (f, a, NULL);
 }
 
 
 void

-gfc_resolve_ierrno (gfc_expr * f)
+gfc_resolve_ierrno (gfc_expr *f)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;

-  f->value.function.name = gfc_get_string (PREFIX("ierrno_i%d"), f->ts.kind);
+  f->value.function.name = gfc_get_string (PREFIX ("ierrno_i%d"), f->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_ieor (gfc_expr * f, gfc_expr * i, gfc_expr * j)
+gfc_resolve_ieor (gfc_expr *f, gfc_expr *i, gfc_expr *j)

 {
   /* If the kind of i and j are different, then g77 cross-promoted the
      kinds to the largest value.  The Fortran 95 standard requires the 
      kinds to match.  */
   if (i->ts.kind != j->ts.kind)
     {
 {
   /* If the kind of i and j are different, then g77 cross-promoted the
      kinds to the largest value.  The Fortran 95 standard requires the 
      kinds to match.  */
   if (i->ts.kind != j->ts.kind)
     {

-      if (i->ts.kind == gfc_kind_max (i,j))
-       gfc_convert_type(j, &i->ts, 2);
+      if (i->ts.kind == gfc_kind_max (i, j))
+       gfc_convert_type (j, &i->ts, 2);

       else
       else

-       gfc_convert_type(i, &j->ts, 2);
+       gfc_convert_type (i, &j->ts, 2);

     }
 
   f->ts = i->ts;
     }
 
   f->ts = i->ts;


@@ -822,17 +900,17 @@ gfc_resolve_ieor (gfc_expr * f, gfc_expr * i, gfc_expr * j)
 
 
 void
 
 
 void

-gfc_resolve_ior (gfc_expr * f, gfc_expr * i, gfc_expr * j)
+gfc_resolve_ior (gfc_expr *f, gfc_expr *i, gfc_expr *j)

 {
   /* If the kind of i and j are different, then g77 cross-promoted the
      kinds to the largest value.  The Fortran 95 standard requires the 
      kinds to match.  */
   if (i->ts.kind != j->ts.kind)
     {
 {
   /* If the kind of i and j are different, then g77 cross-promoted the
      kinds to the largest value.  The Fortran 95 standard requires the 
      kinds to match.  */
   if (i->ts.kind != j->ts.kind)
     {

-      if (i->ts.kind == gfc_kind_max (i,j))
-       gfc_convert_type(j, &i->ts, 2);
+      if (i->ts.kind == gfc_kind_max (i, j))
+       gfc_convert_type (j, &i->ts, 2);

       else
       else

-       gfc_convert_type(i, &j->ts, 2);
+       gfc_convert_type (i, &j->ts, 2);

     }
 
   f->ts = i->ts;
     }
 
   f->ts = i->ts;


@@ -841,20 +919,75 @@ gfc_resolve_ior (gfc_expr * f, gfc_expr * i, gfc_expr * j)
 
 
 void
 
 
 void

-gfc_resolve_int (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
+gfc_resolve_index_func (gfc_expr *f, gfc_expr *str,
+                       gfc_expr *sub_str ATTRIBUTE_UNUSED, gfc_expr *back)
+{
+  gfc_typespec ts;
+
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+
+  if (back && back->ts.kind != gfc_default_integer_kind)
+    {
+      ts.type = BT_LOGICAL;
+      ts.kind = gfc_default_integer_kind;
+      ts.derived = NULL;
+      ts.cl = NULL;
+      gfc_convert_type (back, &ts, 2);
+    }
+
+  f->value.function.name
+    = gfc_get_string ("__index_%d_i%d", str->ts.kind, f->ts.kind);
+}
+
+
+void
+gfc_resolve_int (gfc_expr *f, gfc_expr *a, gfc_expr *kind)

 {
   f->ts.type = BT_INTEGER;
 {
   f->ts.type = BT_INTEGER;

-  f->ts.kind = (kind == NULL) ? gfc_default_integer_kind
-    : mpz_get_si (kind->value.integer);
+  f->ts.kind = (kind == NULL)
+            ? gfc_default_integer_kind : mpz_get_si (kind->value.integer);
+  f->value.function.name
+    = gfc_get_string ("__int_%d_%c%d", f->ts.kind,
+                     gfc_type_letter (a->ts.type), a->ts.kind);
+}

 
 

-  f->value.function.name =
-    gfc_get_string ("__int_%d_%c%d", f->ts.kind, gfc_type_letter (a->ts.type),
-                   a->ts.kind);
+
+void
+gfc_resolve_int2 (gfc_expr *f, gfc_expr *a)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 2;
+  f->value.function.name
+    = gfc_get_string ("__int_%d_%c%d", f->ts.kind,
+                     gfc_type_letter (a->ts.type), a->ts.kind);
+}
+
+
+void
+gfc_resolve_int8 (gfc_expr *f, gfc_expr *a)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 8;
+  f->value.function.name
+    = gfc_get_string ("__int_%d_%c%d", f->ts.kind,
+                     gfc_type_letter (a->ts.type), a->ts.kind);
+}
+
+
+void
+gfc_resolve_long (gfc_expr *f, gfc_expr *a)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 4;
+  f->value.function.name
+    = gfc_get_string ("__int_%d_%c%d", f->ts.kind,
+                     gfc_type_letter (a->ts.type), a->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_isatty (gfc_expr * f, gfc_expr * u)
+gfc_resolve_isatty (gfc_expr *f, gfc_expr *u)

 {
   gfc_typespec ts;
   
 {
   gfc_typespec ts;
   


@@ -869,47 +1002,62 @@ gfc_resolve_isatty (gfc_expr * f, gfc_expr * u)
       gfc_convert_type (u, &ts, 2);
     }
 
       gfc_convert_type (u, &ts, 2);
     }
 

-  f->value.function.name = gfc_get_string (PREFIX("isatty_l%d"), f->ts.kind);
+  f->value.function.name = gfc_get_string (PREFIX ("isatty_l%d"), f->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_ishft (gfc_expr * f, gfc_expr * i, gfc_expr * shift)
+gfc_resolve_ishft (gfc_expr *f, gfc_expr *i, gfc_expr *shift)

 {
   f->ts = i->ts;
 {
   f->ts = i->ts;

-  f->value.function.name =
-    gfc_get_string ("__ishft_%d_%d", i->ts.kind, shift->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__ishft_%d_%d", i->ts.kind, shift->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_ishftc (gfc_expr * f, gfc_expr * i, gfc_expr * shift,
-                   gfc_expr * size)
+gfc_resolve_rshift (gfc_expr *f, gfc_expr *i, gfc_expr *shift)
+{
+  f->ts = i->ts;
+  f->value.function.name
+    = gfc_get_string ("__rshift_%d_%d", i->ts.kind, shift->ts.kind);
+}
+
+
+void
+gfc_resolve_lshift (gfc_expr *f, gfc_expr *i, gfc_expr *shift)
+{
+  f->ts = i->ts;
+  f->value.function.name
+    = gfc_get_string ("__lshift_%d_%d", i->ts.kind, shift->ts.kind);
+}
+
+
+void
+gfc_resolve_ishftc (gfc_expr *f, gfc_expr *i, gfc_expr *shift, gfc_expr *size)

 {
   int s_kind;
 
 {
   int s_kind;
 

-  s_kind = (size == NULL) ? gfc_default_integer_kind : shift->ts.kind;
+  s_kind = (size == NULL) ? gfc_default_integer_kind : size->ts.kind;

 
   f->ts = i->ts;
 
   f->ts = i->ts;

-  f->value.function.name =
-    gfc_get_string ("__ishftc_%d_%d_%d", i->ts.kind, shift->ts.kind, s_kind);
+  f->value.function.name
+    = gfc_get_string ("__ishftc_%d_%d_%d", i->ts.kind, shift->ts.kind, s_kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_kill (gfc_expr * f, ATTRIBUTE_UNUSED gfc_expr * p,
-                  ATTRIBUTE_UNUSED gfc_expr * s)
+gfc_resolve_kill (gfc_expr *f, gfc_expr *p ATTRIBUTE_UNUSED,
+                 gfc_expr *s ATTRIBUTE_UNUSED)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;

-
-  f->value.function.name = gfc_get_string (PREFIX("kill_i%d"), f->ts.kind);
+  f->value.function.name = gfc_get_string (PREFIX ("kill_i%d"), f->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_lbound (gfc_expr * f, gfc_expr * array,
-                   gfc_expr * dim)
+gfc_resolve_lbound (gfc_expr *f, gfc_expr *array, gfc_expr *dim)

 {
   static char lbound[] = "__lbound";
 
 {
   static char lbound[] = "__lbound";
 


@@ -928,16 +1076,18 @@ gfc_resolve_lbound (gfc_expr * f, gfc_expr * array,
 
 
 void
 
 
 void

-gfc_resolve_len (gfc_expr * f, gfc_expr * string)
+gfc_resolve_len (gfc_expr *f, gfc_expr *string)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;

-  f->value.function.name = gfc_get_string ("__len_%d", string->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__len_%d_i%d", string->ts.kind,
+                     gfc_default_integer_kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_len_trim (gfc_expr * f, gfc_expr * string)
+gfc_resolve_len_trim (gfc_expr *f, gfc_expr *string)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;


@@ -946,12 +1096,12 @@ gfc_resolve_len_trim (gfc_expr * f, gfc_expr * string)
 
 
 void
 
 
 void

-gfc_resolve_link (gfc_expr * f, gfc_expr * p1 ATTRIBUTE_UNUSED,
-                 gfc_expr * p2 ATTRIBUTE_UNUSED)
+gfc_resolve_link (gfc_expr *f, gfc_expr *p1 ATTRIBUTE_UNUSED,
+                 gfc_expr *p2 ATTRIBUTE_UNUSED)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;

-  f->value.function.name = gfc_get_string (PREFIX("link_i%d"), f->ts.kind);
+  f->value.function.name = gfc_get_string (PREFIX ("link_i%d"), f->ts.kind);

 }
 
 
 }
 
 


@@ -965,39 +1115,40 @@ gfc_resolve_loc (gfc_expr *f, gfc_expr *x)
 
 
 void
 
 
 void

-gfc_resolve_log (gfc_expr * f, gfc_expr * x)
+gfc_resolve_log (gfc_expr *f, gfc_expr *x)

 {
   f->ts = x->ts;
 {
   f->ts = x->ts;

-  f->value.function.name =
-    gfc_get_string ("__log_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__log_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_log10 (gfc_expr * f, gfc_expr * x)
+gfc_resolve_log10 (gfc_expr *f, gfc_expr *x)

 {
   f->ts = x->ts;
 {
   f->ts = x->ts;

-  f->value.function.name =
-    gfc_get_string ("__log10_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__log10_%c%d", gfc_type_letter (x->ts.type),
+                     x->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_logical (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
+gfc_resolve_logical (gfc_expr *f, gfc_expr *a, gfc_expr *kind)

 {
   f->ts.type = BT_LOGICAL;
 {
   f->ts.type = BT_LOGICAL;

-  f->ts.kind = (kind == NULL) ? gfc_default_logical_kind
-    : mpz_get_si (kind->value.integer);
+  f->ts.kind = (kind == NULL)
+            ? gfc_default_logical_kind : mpz_get_si (kind->value.integer);

   f->rank = a->rank;
 
   f->rank = a->rank;
 

-  f->value.function.name =
-    gfc_get_string ("__logical_%d_%c%d", f->ts.kind,
-                   gfc_type_letter (a->ts.type), a->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__logical_%d_%c%d", f->ts.kind,
+                     gfc_type_letter (a->ts.type), a->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_malloc (gfc_expr * f, gfc_expr * size)
+gfc_resolve_malloc (gfc_expr *f, gfc_expr *size)

 {
   if (size->ts.kind < gfc_index_integer_kind)
     {
 {
   if (size->ts.kind < gfc_index_integer_kind)
     {


@@ -1010,12 +1161,12 @@ gfc_resolve_malloc (gfc_expr * f, gfc_expr * size)
 
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_index_integer_kind;
 
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_index_integer_kind;

-  f->value.function.name = gfc_get_string (PREFIX("malloc"));
+  f->value.function.name = gfc_get_string (PREFIX ("malloc"));

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_matmul (gfc_expr * f, gfc_expr * a, gfc_expr * b)
+gfc_resolve_matmul (gfc_expr *f, gfc_expr *a, gfc_expr *b)

 {
   gfc_expr temp;
 
 {
   gfc_expr temp;
 


@@ -1037,14 +1188,14 @@ gfc_resolve_matmul (gfc_expr * f, gfc_expr * a, gfc_expr * b)
 
   f->rank = (a->rank == 2 && b->rank == 2) ? 2 : 1;
 
 
   f->rank = (a->rank == 2 && b->rank == 2) ? 2 : 1;
 

-  f->value.function.name =
-    gfc_get_string (PREFIX("matmul_%c%d"), gfc_type_letter (f->ts.type),
-                   f->ts.kind);
+  f->value.function.name
+    = gfc_get_string (PREFIX ("matmul_%c%d"), gfc_type_letter (f->ts.type),
+                     f->ts.kind);

 }
 
 
 static void
 }
 
 
 static void

-gfc_resolve_minmax (const char * name, gfc_expr * f, gfc_actual_arglist * args)
+gfc_resolve_minmax (const char *name, gfc_expr *f, gfc_actual_arglist *args)

 {
   gfc_actual_arglist *a;
 
 {
   gfc_actual_arglist *a;
 


@@ -1054,43 +1205,59 @@ gfc_resolve_minmax (const char * name, gfc_expr * f, gfc_actual_arglist * args)
   for (a = args->next; a; a = a->next)
     {
       if (a->expr->ts.kind > f->ts.kind)
   for (a = args->next; a; a = a->next)
     {
       if (a->expr->ts.kind > f->ts.kind)

-        f->ts.kind = a->expr->ts.kind;
+       f->ts.kind = a->expr->ts.kind;

     }
 
   /* Convert all parameters to the required kind.  */
   for (a = args; a; a = a->next)
     {
       if (a->expr->ts.kind != f->ts.kind)
     }
 
   /* Convert all parameters to the required kind.  */
   for (a = args; a; a = a->next)
     {
       if (a->expr->ts.kind != f->ts.kind)

-        gfc_convert_type (a->expr, &f->ts, 2);
+       gfc_convert_type (a->expr, &f->ts, 2);

     }
 
     }
 

-  f->value.function.name =
-    gfc_get_string (name, gfc_type_letter (f->ts.type), f->ts.kind);
+  f->value.function.name
+    = gfc_get_string (name, gfc_type_letter (f->ts.type), f->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_max (gfc_expr * f, gfc_actual_arglist * args)
+gfc_resolve_max (gfc_expr *f, gfc_actual_arglist *args)

 {
   gfc_resolve_minmax ("__max_%c%d", f, args);
 }
 
 
 void
 {
   gfc_resolve_minmax ("__max_%c%d", f, args);
 }
 
 
 void

-gfc_resolve_maxloc (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
-                   gfc_expr * mask)
+gfc_resolve_maxloc (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
+                   gfc_expr *mask)

 {
   const char *name;
 {
   const char *name;

+  int i, j, idim;

 
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
 
   if (dim == NULL)
 
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
 
   if (dim == NULL)

-    f->rank = 1;
+    {
+      f->rank = 1;
+      f->shape = gfc_get_shape (1);
+      mpz_init_set_si (f->shape[0], array->rank);
+    }

   else
     {
       f->rank = array->rank - 1;
       gfc_resolve_dim_arg (dim);
   else
     {
       f->rank = array->rank - 1;
       gfc_resolve_dim_arg (dim);

+      if (array->shape && dim->expr_type == EXPR_CONSTANT)
+       {
+         idim = (int) mpz_get_si (dim->value.integer);
+         f->shape = gfc_get_shape (f->rank);
+         for (i = 0, j = 0; i < f->rank; i++, j++)
+           {
+             if (i == (idim - 1))
+               j++;
+             mpz_init_set (f->shape[i], array->shape[j]);
+           }
+       }

     }
 
   if (mask)
     }
 
   if (mask)


@@ -1100,31 +1267,23 @@ gfc_resolve_maxloc (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
       else
        name = "mmaxloc";
 
       else
        name = "mmaxloc";
 

-      /* The mask can be kind 4 or 8 for the array case.  For the
-        scalar case, coerce it to default kind unconditionally.  */
-      if ((mask->ts.kind < gfc_default_logical_kind)
-         || (mask->rank == 0 && mask->ts.kind != gfc_default_logical_kind))
-       {
-         gfc_typespec ts;
-         ts.type = BT_LOGICAL;
-         ts.kind = gfc_default_logical_kind;
-         gfc_convert_type_warn (mask, &ts, 2, 0);
-       }
+      resolve_mask_arg (mask);

     }
   else
     name = "maxloc";
 
     }
   else
     name = "maxloc";
 

-  f->value.function.name =
-    gfc_get_string (PREFIX("%s%d_%d_%c%d"), name, dim != NULL, f->ts.kind,
-                    gfc_type_letter (array->ts.type), array->ts.kind);
+  f->value.function.name
+    = gfc_get_string (PREFIX ("%s%d_%d_%c%d"), name, dim != NULL, f->ts.kind,
+                     gfc_type_letter (array->ts.type), array->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_maxval (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
-                   gfc_expr * mask)
+gfc_resolve_maxval (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
+                   gfc_expr *mask)

 {
   const char *name;
 {
   const char *name;

+  int i, j, idim;

 
   f->ts = array->ts;
 
 
   f->ts = array->ts;
 


@@ -1132,6 +1291,18 @@ gfc_resolve_maxval (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
     {
       f->rank = array->rank - 1;
       gfc_resolve_dim_arg (dim);
     {
       f->rank = array->rank - 1;
       gfc_resolve_dim_arg (dim);

+
+      if (f->rank && array->shape && dim->expr_type == EXPR_CONSTANT)
+       {
+         idim = (int) mpz_get_si (dim->value.integer);
+         f->shape = gfc_get_shape (f->rank);
+         for (i = 0, j = 0; i < f->rank; i++, j++)
+           {
+             if (i == (idim - 1))
+               j++;
+             mpz_init_set (f->shape[i], array->shape[j]);
+           }
+       }

     }
 
   if (mask)
     }
 
   if (mask)


@@ -1141,63 +1312,88 @@ gfc_resolve_maxval (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
       else
        name = "mmaxval";
 
       else
        name = "mmaxval";
 

-      /* The mask can be kind 4 or 8 for the array case.  For the
-        scalar case, coerce it to default kind unconditionally.  */
-      if ((mask->ts.kind < gfc_default_logical_kind)
-         || (mask->rank == 0 && mask->ts.kind != gfc_default_logical_kind))
-       {
-         gfc_typespec ts;
-         ts.type = BT_LOGICAL;
-         ts.kind = gfc_default_logical_kind;
-         gfc_convert_type_warn (mask, &ts, 2, 0);
-       }
+      resolve_mask_arg (mask);

     }
   else
     name = "maxval";
 
     }
   else
     name = "maxval";
 

-  f->value.function.name =
-    gfc_get_string (PREFIX("%s_%c%d"), name,
-                   gfc_type_letter (array->ts.type), array->ts.kind);
+  f->value.function.name
+    = gfc_get_string (PREFIX ("%s_%c%d"), name,
+                     gfc_type_letter (array->ts.type), array->ts.kind);
+}
+
+
+void
+gfc_resolve_mclock (gfc_expr *f)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 4;
+  f->value.function.name = PREFIX ("mclock");
+}
+
+
+void
+gfc_resolve_mclock8 (gfc_expr *f)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 8;
+  f->value.function.name = PREFIX ("mclock8");

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_merge (gfc_expr * f, gfc_expr * tsource,
-                  gfc_expr * fsource ATTRIBUTE_UNUSED,
-                  gfc_expr * mask ATTRIBUTE_UNUSED)
+gfc_resolve_merge (gfc_expr *f, gfc_expr *tsource,
+                  gfc_expr *fsource ATTRIBUTE_UNUSED,
+                  gfc_expr *mask ATTRIBUTE_UNUSED)

 {
   if (tsource->ts.type == BT_CHARACTER)
     check_charlen_present (tsource);
 
   f->ts = tsource->ts;
 {
   if (tsource->ts.type == BT_CHARACTER)
     check_charlen_present (tsource);
 
   f->ts = tsource->ts;

-  f->value.function.name =
-    gfc_get_string ("__merge_%c%d", gfc_type_letter (tsource->ts.type),
-                   tsource->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__merge_%c%d", gfc_type_letter (tsource->ts.type),
+                     tsource->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_min (gfc_expr * f, gfc_actual_arglist * args)
+gfc_resolve_min (gfc_expr *f, gfc_actual_arglist *args)

 {
   gfc_resolve_minmax ("__min_%c%d", f, args);
 }
 
 
 void
 {
   gfc_resolve_minmax ("__min_%c%d", f, args);
 }
 
 
 void

-gfc_resolve_minloc (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
-                   gfc_expr * mask)
+gfc_resolve_minloc (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
+                   gfc_expr *mask)

 {
   const char *name;
 {
   const char *name;

+  int i, j, idim;

 
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
 
   if (dim == NULL)
 
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
 
   if (dim == NULL)

-    f->rank = 1;
+    {
+      f->rank = 1;
+      f->shape = gfc_get_shape (1);
+      mpz_init_set_si (f->shape[0], array->rank);
+    }

   else
     {
       f->rank = array->rank - 1;
       gfc_resolve_dim_arg (dim);
   else
     {
       f->rank = array->rank - 1;
       gfc_resolve_dim_arg (dim);

+      if (array->shape && dim->expr_type == EXPR_CONSTANT)
+       {
+         idim = (int) mpz_get_si (dim->value.integer);
+         f->shape = gfc_get_shape (f->rank);
+         for (i = 0, j = 0; i < f->rank; i++, j++)
+           {
+             if (i == (idim - 1))
+               j++;
+             mpz_init_set (f->shape[i], array->shape[j]);
+           }
+       }

     }
 
   if (mask)
     }
 
   if (mask)


@@ -1207,31 +1403,23 @@ gfc_resolve_minloc (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
       else
        name = "mminloc";
 
       else
        name = "mminloc";
 

-      /* The mask can be kind 4 or 8 for the array case.  For the
-        scalar case, coerce it to default kind unconditionally.  */
-      if ((mask->ts.kind < gfc_default_logical_kind)
-         || (mask->rank == 0 && mask->ts.kind != gfc_default_logical_kind))
-       {
-         gfc_typespec ts;
-         ts.type = BT_LOGICAL;
-         ts.kind = gfc_default_logical_kind;
-         gfc_convert_type_warn (mask, &ts, 2, 0);
-       }
+      resolve_mask_arg (mask);

     }
   else
     name = "minloc";
 
     }
   else
     name = "minloc";
 

-  f->value.function.name =
-    gfc_get_string (PREFIX("%s%d_%d_%c%d"), name, dim != NULL, f->ts.kind,
-                    gfc_type_letter (array->ts.type), array->ts.kind);
+  f->value.function.name
+    = gfc_get_string (PREFIX ("%s%d_%d_%c%d"), name, dim != NULL, f->ts.kind,
+                     gfc_type_letter (array->ts.type), array->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_minval (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
-                   gfc_expr * mask)
+gfc_resolve_minval (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
+                   gfc_expr *mask)

 {
   const char *name;
 {
   const char *name;

+  int i, j, idim;

 
   f->ts = array->ts;
 
 
   f->ts = array->ts;
 


@@ -1239,6 +1427,18 @@ gfc_resolve_minval (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
     {
       f->rank = array->rank - 1;
       gfc_resolve_dim_arg (dim);
     {
       f->rank = array->rank - 1;
       gfc_resolve_dim_arg (dim);

+
+      if (f->rank && array->shape && dim->expr_type == EXPR_CONSTANT)
+       {
+         idim = (int) mpz_get_si (dim->value.integer);
+         f->shape = gfc_get_shape (f->rank);
+         for (i = 0, j = 0; i < f->rank; i++, j++)
+           {
+             if (i == (idim - 1))
+               j++;
+             mpz_init_set (f->shape[i], array->shape[j]);
+           }
+       }

     }
 
   if (mask)
     }
 
   if (mask)


@@ -1248,28 +1448,19 @@ gfc_resolve_minval (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
       else
        name = "mminval";
 
       else
        name = "mminval";
 

-      /* The mask can be kind 4 or 8 for the array case.  For the
-        scalar case, coerce it to default kind unconditionally.  */
-      if ((mask->ts.kind < gfc_default_logical_kind)
-         || (mask->rank == 0 && mask->ts.kind != gfc_default_logical_kind))
-       {
-         gfc_typespec ts;
-         ts.type = BT_LOGICAL;
-         ts.kind = gfc_default_logical_kind;
-         gfc_convert_type_warn (mask, &ts, 2, 0);
-       }
+      resolve_mask_arg (mask);

     }
   else
     name = "minval";
 
     }
   else
     name = "minval";
 

-  f->value.function.name =
-    gfc_get_string (PREFIX("%s_%c%d"), name,
-                   gfc_type_letter (array->ts.type), array->ts.kind);
+  f->value.function.name
+    = gfc_get_string (PREFIX ("%s_%c%d"), name,
+                     gfc_type_letter (array->ts.type), array->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_mod (gfc_expr * f, gfc_expr * a, gfc_expr * p)
+gfc_resolve_mod (gfc_expr *f, gfc_expr *a, gfc_expr *p)

 {
   f->ts.type = a->ts.type;
   if (p != NULL)
 {
   f->ts.type = a->ts.type;
   if (p != NULL)


@@ -1280,18 +1471,18 @@ gfc_resolve_mod (gfc_expr * f, gfc_expr * a, gfc_expr * p)
   if (p != NULL && a->ts.kind != p->ts.kind)
     {
       if (a->ts.kind == gfc_kind_max (a,p))
   if (p != NULL && a->ts.kind != p->ts.kind)
     {
       if (a->ts.kind == gfc_kind_max (a,p))

-       gfc_convert_type(p, &a->ts, 2);
+       gfc_convert_type (p, &a->ts, 2);

       else
       else

-       gfc_convert_type(a, &p->ts, 2);
+       gfc_convert_type (a, &p->ts, 2);

     }
 
     }
 

-  f->value.function.name =
-    gfc_get_string ("__mod_%c%d", gfc_type_letter (f->ts.type), f->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__mod_%c%d", gfc_type_letter (f->ts.type), f->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_modulo (gfc_expr * f, gfc_expr * a, gfc_expr * p)
+gfc_resolve_modulo (gfc_expr *f, gfc_expr *a, gfc_expr *p)

 {
   f->ts.type = a->ts.type;
   if (p != NULL)
 {
   f->ts.type = a->ts.type;
   if (p != NULL)


@@ -1302,39 +1493,38 @@ gfc_resolve_modulo (gfc_expr * f, gfc_expr * a, gfc_expr * p)
   if (p != NULL && a->ts.kind != p->ts.kind)
     {
       if (a->ts.kind == gfc_kind_max (a,p))
   if (p != NULL && a->ts.kind != p->ts.kind)
     {
       if (a->ts.kind == gfc_kind_max (a,p))

-       gfc_convert_type(p, &a->ts, 2);
+       gfc_convert_type (p, &a->ts, 2);

       else
       else

-       gfc_convert_type(a, &p->ts, 2);
+       gfc_convert_type (a, &p->ts, 2);

     }
 
     }
 

-  f->value.function.name =
-    gfc_get_string ("__modulo_%c%d", gfc_type_letter (f->ts.type),
-                   f->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__modulo_%c%d", gfc_type_letter (f->ts.type),
+                     f->ts.kind);

 }
 
 void
 }
 
 void

-gfc_resolve_nearest (gfc_expr * f, gfc_expr * a, gfc_expr *p ATTRIBUTE_UNUSED)
+gfc_resolve_nearest (gfc_expr *f, gfc_expr *a, gfc_expr *p ATTRIBUTE_UNUSED)

 {
   f->ts = a->ts;
 {
   f->ts = a->ts;

-  f->value.function.name =
-    gfc_get_string ("__nearest_%c%d", gfc_type_letter (a->ts.type),
-            a->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__nearest_%c%d", gfc_type_letter (a->ts.type),
+                     a->ts.kind);

 }
 
 void
 }
 
 void

-gfc_resolve_nint (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
+gfc_resolve_nint (gfc_expr *f, gfc_expr *a, gfc_expr *kind)

 {
   f->ts.type = BT_INTEGER;
 {
   f->ts.type = BT_INTEGER;

-  f->ts.kind = (kind == NULL) ? gfc_default_integer_kind
-    : mpz_get_si (kind->value.integer);
-
-  f->value.function.name =
-    gfc_get_string ("__nint_%d_%d", f->ts.kind, a->ts.kind);
+  f->ts.kind = (kind == NULL)
+            ? gfc_default_integer_kind : mpz_get_si (kind->value.integer);
+  f->value.function.name
+    = gfc_get_string ("__nint_%d_%d", f->ts.kind, a->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_not (gfc_expr * f, gfc_expr * i)
+gfc_resolve_not (gfc_expr *f, gfc_expr *i)

 {
   f->ts = i->ts;
   f->value.function.name = gfc_get_string ("__not_%d", i->ts.kind);
 {
   f->ts = i->ts;
   f->value.function.name = gfc_get_string ("__not_%d", i->ts.kind);


@@ -1342,60 +1532,45 @@ gfc_resolve_not (gfc_expr * f, gfc_expr * i)
 
 
 void
 
 
 void

-gfc_resolve_or (gfc_expr * f, gfc_expr * i, gfc_expr * j)
+gfc_resolve_or (gfc_expr *f, gfc_expr *i, gfc_expr *j)

 {
   f->ts.type = i->ts.type;
 {
   f->ts.type = i->ts.type;

-  f->ts.kind = gfc_kind_max (i,j);
+  f->ts.kind = gfc_kind_max (i, j);

 
   if (i->ts.kind != j->ts.kind)
     {
 
   if (i->ts.kind != j->ts.kind)
     {

-      if (i->ts.kind == gfc_kind_max (i,j))
-       gfc_convert_type(j, &i->ts, 2);
+      if (i->ts.kind == gfc_kind_max (i, j))
+       gfc_convert_type (j, &i->ts, 2);

       else
       else

-       gfc_convert_type(i, &j->ts, 2);
+       gfc_convert_type (i, &j->ts, 2);

     }
 
     }
 

-  f->value.function.name = gfc_get_string ("__or_%c%d",
-                                          gfc_type_letter (i->ts.type),
-                                          f->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__or_%c%d", gfc_type_letter (i->ts.type), f->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_pack (gfc_expr * f, gfc_expr * array, gfc_expr * mask,
-                 gfc_expr * vector ATTRIBUTE_UNUSED)
+gfc_resolve_pack (gfc_expr *f, gfc_expr *array, gfc_expr *mask,
+                 gfc_expr *vector ATTRIBUTE_UNUSED)

 {
   f->ts = array->ts;
   f->rank = 1;
 
 {
   f->ts = array->ts;
   f->rank = 1;
 

+  resolve_mask_arg (mask);
+

   if (mask->rank != 0)
     f->value.function.name = (array->ts.type == BT_CHARACTER
   if (mask->rank != 0)
     f->value.function.name = (array->ts.type == BT_CHARACTER

-                             ? PREFIX("pack_char")
-                             : PREFIX("pack"));
+                             ? PREFIX ("pack_char") : PREFIX ("pack"));

   else
   else

-    {
-      /* We convert mask to default logical only in the scalar case.
-        In the array case we can simply read the array as if it were
-        of type default logical.  */
-      if (mask->ts.kind != gfc_default_logical_kind)
-       {
-         gfc_typespec ts;
-
-         ts.type = BT_LOGICAL;
-         ts.kind = gfc_default_logical_kind;
-         gfc_convert_type (mask, &ts, 2);
-       }
-
-      f->value.function.name = (array->ts.type == BT_CHARACTER
-                               ? PREFIX("pack_s_char")
-                               : PREFIX("pack_s"));
-    }
+    f->value.function.name = (array->ts.type == BT_CHARACTER
+                             ? PREFIX ("pack_s_char") : PREFIX ("pack_s"));

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_product (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
-                    gfc_expr * mask)
+gfc_resolve_product (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
+                    gfc_expr *mask)

 {
   const char *name;
 
 {
   const char *name;
 


@@ -1414,67 +1589,58 @@ gfc_resolve_product (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
       else
        name = "mproduct";
 
       else
        name = "mproduct";
 

-      /* The mask can be kind 4 or 8 for the array case.  For the
-        scalar case, coerce it to default kind unconditionally.  */
-      if ((mask->ts.kind < gfc_default_logical_kind)
-         || (mask->rank == 0 && mask->ts.kind != gfc_default_logical_kind))
-       {
-         gfc_typespec ts;
-         ts.type = BT_LOGICAL;
-         ts.kind = gfc_default_logical_kind;
-         gfc_convert_type_warn (mask, &ts, 2, 0);
-       }
+      resolve_mask_arg (mask);

     }
   else
     name = "product";
 
     }
   else
     name = "product";
 

-  f->value.function.name =
-    gfc_get_string (PREFIX("%s_%c%d"), name,
-                   gfc_type_letter (array->ts.type), array->ts.kind);
+  f->value.function.name
+    = gfc_get_string (PREFIX ("%s_%c%d"), name,
+                     gfc_type_letter (array->ts.type), array->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_real (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
+gfc_resolve_real (gfc_expr *f, gfc_expr *a, gfc_expr *kind)

 {
   f->ts.type = BT_REAL;
 
   if (kind != NULL)
     f->ts.kind = mpz_get_si (kind->value.integer);
   else
 {
   f->ts.type = BT_REAL;
 
   if (kind != NULL)
     f->ts.kind = mpz_get_si (kind->value.integer);
   else

-    f->ts.kind = (a->ts.type == BT_COMPLEX) ?
-      a->ts.kind : gfc_default_real_kind;
+    f->ts.kind = (a->ts.type == BT_COMPLEX)
+              ? a->ts.kind : gfc_default_real_kind;

 
 

-  f->value.function.name =
-    gfc_get_string ("__real_%d_%c%d", f->ts.kind,
-                   gfc_type_letter (a->ts.type), a->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__real_%d_%c%d", f->ts.kind,
+                     gfc_type_letter (a->ts.type), a->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_realpart (gfc_expr * f, gfc_expr * a)
+gfc_resolve_realpart (gfc_expr *f, gfc_expr *a)

 {
   f->ts.type = BT_REAL;
   f->ts.kind = a->ts.kind;
 {
   f->ts.type = BT_REAL;
   f->ts.kind = a->ts.kind;

-  f->value.function.name =
-    gfc_get_string ("__real_%d_%c%d", f->ts.kind,
-                   gfc_type_letter (a->ts.type), a->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__real_%d_%c%d", f->ts.kind,
+                     gfc_type_letter (a->ts.type), a->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_rename (gfc_expr * f, gfc_expr * p1 ATTRIBUTE_UNUSED,
-                   gfc_expr * p2 ATTRIBUTE_UNUSED)
+gfc_resolve_rename (gfc_expr *f, gfc_expr *p1 ATTRIBUTE_UNUSED,
+                   gfc_expr *p2 ATTRIBUTE_UNUSED)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;

-  f->value.function.name = gfc_get_string (PREFIX("rename_i%d"), f->ts.kind);
+  f->value.function.name = gfc_get_string (PREFIX ("rename_i%d"), f->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_repeat (gfc_expr * f, gfc_expr * string,
-                   gfc_expr * ncopies ATTRIBUTE_UNUSED)
+gfc_resolve_repeat (gfc_expr *f, gfc_expr *string,
+                   gfc_expr *ncopies ATTRIBUTE_UNUSED)

 {
   f->ts.type = BT_CHARACTER;
   f->ts.kind = string->ts.kind;
 {
   f->ts.type = BT_CHARACTER;
   f->ts.kind = string->ts.kind;


@@ -1483,9 +1649,9 @@ gfc_resolve_repeat (gfc_expr * f, gfc_expr * string,
 
 
 void
 
 
 void

-gfc_resolve_reshape (gfc_expr * f, gfc_expr * source, gfc_expr * shape,
-                    gfc_expr * pad ATTRIBUTE_UNUSED,
-                    gfc_expr * order ATTRIBUTE_UNUSED)
+gfc_resolve_reshape (gfc_expr *f, gfc_expr *source, gfc_expr *shape,
+                    gfc_expr *pad ATTRIBUTE_UNUSED,
+                    gfc_expr *order ATTRIBUTE_UNUSED)

 {
   mpz_t rank;
   int kind;
 {
   mpz_t rank;
   int kind;


@@ -1516,24 +1682,20 @@ gfc_resolve_reshape (gfc_expr * f, gfc_expr * source, gfc_expr * shape,
     case 8:
     case 10:
     case 16:
     case 8:
     case 10:
     case 16:

-      if (source->ts.type == BT_COMPLEX)
-       f->value.function.name =
-         gfc_get_string (PREFIX("reshape_%c%d"),
-                         gfc_type_letter (BT_COMPLEX), source->ts.kind);
-      else if (source->ts.type == BT_REAL && (kind == 10 || kind == 16))
-       f->value.function.name =
-         gfc_get_string (PREFIX("reshape_%c%d"),
-                         gfc_type_letter (BT_REAL), source->ts.kind);
+      if (source->ts.type == BT_COMPLEX || source->ts.type == BT_REAL)
+       f->value.function.name
+         = gfc_get_string (PREFIX ("reshape_%c%d"),
+                           gfc_type_letter (source->ts.type),
+                           source->ts.kind);

       else
       else

-       f->value.function.name =
-         gfc_get_string (PREFIX("reshape_%d"), source->ts.kind);
+       f->value.function.name
+         = gfc_get_string (PREFIX ("reshape_%d"), source->ts.kind);

 
       break;
 
     default:
       f->value.function.name = (source->ts.type == BT_CHARACTER
 
       break;
 
     default:
       f->value.function.name = (source->ts.type == BT_CHARACTER

-                               ? PREFIX("reshape_char")
-                               : PREFIX("reshape"));
+                            ? PREFIX ("reshape_char") : PREFIX ("reshape"));

       break;
     }
 
       break;
     }
 


@@ -1566,15 +1728,34 @@ gfc_resolve_reshape (gfc_expr * f, gfc_expr * source, gfc_expr * shape,
 
 
 void
 
 
 void

-gfc_resolve_rrspacing (gfc_expr * f, gfc_expr * x)
+gfc_resolve_rrspacing (gfc_expr *f, gfc_expr *x)

 {
 {

+  int k;
+  gfc_actual_arglist *prec;
+

   f->ts = x->ts;
   f->value.function.name = gfc_get_string ("__rrspacing_%d", x->ts.kind);
   f->ts = x->ts;
   f->value.function.name = gfc_get_string ("__rrspacing_%d", x->ts.kind);

+
+  /* Create a hidden argument to the library routines for rrspacing.  This
+     hidden argument is the precision of x.  */
+  k = gfc_validate_kind (BT_REAL, x->ts.kind, false);
+  prec = gfc_get_actual_arglist ();
+  prec->name = "p";
+  prec->expr = gfc_int_expr (gfc_real_kinds[k].digits);
+  /* The library routine expects INTEGER(4).  */
+  if (prec->expr->ts.kind != gfc_c_int_kind)
+    {
+      gfc_typespec ts;
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_c_int_kind;
+      gfc_convert_type (prec->expr, &ts, 2);
+    }
+  f->value.function.actual->next = prec;

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_scale (gfc_expr * f, gfc_expr * x, gfc_expr * i)
+gfc_resolve_scale (gfc_expr *f, gfc_expr *x, gfc_expr *i)

 {
   f->ts = x->ts;
 
 {
   f->ts = x->ts;
 


@@ -1583,10 +1764,8 @@ gfc_resolve_scale (gfc_expr * f, gfc_expr * x, gfc_expr * i)
   if (i->ts.kind != gfc_c_int_kind)
     {
       gfc_typespec ts;
   if (i->ts.kind != gfc_c_int_kind)
     {
       gfc_typespec ts;

-

       ts.type = BT_INTEGER;
       ts.type = BT_INTEGER;

-      ts.kind = gfc_default_integer_kind;
-
+      ts.kind = gfc_c_int_kind;

       gfc_convert_type_warn (i, &ts, 2, 0);
     }
 
       gfc_convert_type_warn (i, &ts, 2, 0);
     }
 


@@ -1595,9 +1774,9 @@ gfc_resolve_scale (gfc_expr * f, gfc_expr * x, gfc_expr * i)
 
 
 void
 
 
 void

-gfc_resolve_scan (gfc_expr * f, gfc_expr * string,
-                 gfc_expr * set ATTRIBUTE_UNUSED,
-                 gfc_expr * back ATTRIBUTE_UNUSED)
+gfc_resolve_scan (gfc_expr *f, gfc_expr *string,
+                 gfc_expr *set ATTRIBUTE_UNUSED,
+                 gfc_expr *back ATTRIBUTE_UNUSED)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;


@@ -1606,29 +1785,26 @@ gfc_resolve_scan (gfc_expr * f, gfc_expr * string,
 
 
 void
 
 
 void

-gfc_resolve_secnds (gfc_expr * t1, gfc_expr * t0)
+gfc_resolve_secnds (gfc_expr *t1, gfc_expr *t0)

 {
   t1->ts = t0->ts;
 {
   t1->ts = t0->ts;

-  t1->value.function.name =
-    gfc_get_string (PREFIX("secnds"));
+  t1->value.function.name = gfc_get_string (PREFIX ("secnds"));

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_set_exponent (gfc_expr * f, gfc_expr * x, gfc_expr * i)
+gfc_resolve_set_exponent (gfc_expr *f, gfc_expr *x, gfc_expr *i)

 {
   f->ts = x->ts;
 
   /* The library implementation uses GFC_INTEGER_4 unconditionally,
      convert type so we don't have to implement all possible
      permutations.  */
 {
   f->ts = x->ts;
 
   /* The library implementation uses GFC_INTEGER_4 unconditionally,
      convert type so we don't have to implement all possible
      permutations.  */

-  if (i->ts.kind != 4)
+  if (i->ts.kind != gfc_c_int_kind)

     {
       gfc_typespec ts;
     {
       gfc_typespec ts;

-

       ts.type = BT_INTEGER;
       ts.type = BT_INTEGER;

-      ts.kind = gfc_default_integer_kind;
-
+      ts.kind = gfc_c_int_kind;

       gfc_convert_type_warn (i, &ts, 2, 0);
     }
 
       gfc_convert_type_warn (i, &ts, 2, 0);
     }
 


@@ -1637,28 +1813,28 @@ gfc_resolve_set_exponent (gfc_expr * f, gfc_expr * x, gfc_expr * i)
 
 
 void
 
 
 void

-gfc_resolve_shape (gfc_expr * f, gfc_expr * array)
+gfc_resolve_shape (gfc_expr *f, gfc_expr *array)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
   f->rank = 1;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
   f->rank = 1;

-  f->value.function.name = gfc_get_string (PREFIX("shape_%d"), f->ts.kind);

   f->shape = gfc_get_shape (1);
   mpz_init_set_ui (f->shape[0], array->rank);
   f->shape = gfc_get_shape (1);
   mpz_init_set_ui (f->shape[0], array->rank);

+  f->value.function.name = gfc_get_string (PREFIX ("shape_%d"), f->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_sign (gfc_expr * f, gfc_expr * a, gfc_expr * b ATTRIBUTE_UNUSED)
+gfc_resolve_sign (gfc_expr *f, gfc_expr *a, gfc_expr *b ATTRIBUTE_UNUSED)

 {
   f->ts = a->ts;
 {
   f->ts = a->ts;

-  f->value.function.name =
-    gfc_get_string ("__sign_%c%d", gfc_type_letter (a->ts.type), a->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__sign_%c%d", gfc_type_letter (a->ts.type), a->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_signal (gfc_expr * f, gfc_expr *number, gfc_expr *handler)
+gfc_resolve_signal (gfc_expr *f, gfc_expr *number, gfc_expr *handler)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_c_int_kind;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_c_int_kind;


@@ -1668,10 +1844,10 @@ gfc_resolve_signal (gfc_expr * f, gfc_expr *number, gfc_expr *handler)
     {
       if (handler->ts.kind != gfc_c_int_kind)
        gfc_convert_type (handler, &f->ts, 2);
     {
       if (handler->ts.kind != gfc_c_int_kind)
        gfc_convert_type (handler, &f->ts, 2);

-      f->value.function.name = gfc_get_string (PREFIX("signal_func_int"));
+      f->value.function.name = gfc_get_string (PREFIX ("signal_func_int"));

     }
   else
     }
   else

-    f->value.function.name = gfc_get_string (PREFIX("signal_func"));
+    f->value.function.name = gfc_get_string (PREFIX ("signal_func"));

 
   if (number->ts.kind != gfc_c_int_kind)
     gfc_convert_type (number, &f->ts, 2);
 
   if (number->ts.kind != gfc_c_int_kind)
     gfc_convert_type (number, &f->ts, 2);


@@ -1679,35 +1855,83 @@ gfc_resolve_signal (gfc_expr * f, gfc_expr *number, gfc_expr *handler)
 
 
 void
 
 
 void

-gfc_resolve_sin (gfc_expr * f, gfc_expr * x)
+gfc_resolve_sin (gfc_expr *f, gfc_expr *x)

 {
   f->ts = x->ts;
 {
   f->ts = x->ts;

-  f->value.function.name =
-    gfc_get_string ("__sin_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__sin_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_sinh (gfc_expr * f, gfc_expr * x)
+gfc_resolve_sinh (gfc_expr *f, gfc_expr *x)

 {
   f->ts = x->ts;
 {
   f->ts = x->ts;

-  f->value.function.name =
-    gfc_get_string ("__sinh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__sinh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_spacing (gfc_expr * f, gfc_expr * x)
+gfc_resolve_spacing (gfc_expr *f, gfc_expr *x)

 {
 {

+  int k; 
+  gfc_actual_arglist *prec, *tiny, *emin_1;
+ 

   f->ts = x->ts;
   f->value.function.name = gfc_get_string ("__spacing_%d", x->ts.kind);
   f->ts = x->ts;
   f->value.function.name = gfc_get_string ("__spacing_%d", x->ts.kind);

+
+  /* Create hidden arguments to the library routine for spacing.  These
+     hidden arguments are tiny(x), min_exponent - 1,  and the precision
+     of x.  */
+
+  k = gfc_validate_kind (BT_REAL, x->ts.kind, false);
+
+  tiny = gfc_get_actual_arglist ();
+  tiny->name = "tiny";
+  tiny->expr = gfc_get_expr ();
+  tiny->expr->expr_type = EXPR_CONSTANT;
+  tiny->expr->where = gfc_current_locus;
+  tiny->expr->ts.type = x->ts.type;
+  tiny->expr->ts.kind = x->ts.kind;
+  mpfr_init (tiny->expr->value.real);
+  mpfr_set (tiny->expr->value.real, gfc_real_kinds[k].tiny, GFC_RND_MODE);
+
+  emin_1 = gfc_get_actual_arglist ();
+  emin_1->name = "emin";
+  emin_1->expr = gfc_int_expr (gfc_real_kinds[k].min_exponent - 1);
+
+  /* The library routine expects INTEGER(4).  */
+  if (emin_1->expr->ts.kind != gfc_c_int_kind)
+    {
+      gfc_typespec ts;
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_c_int_kind;
+      gfc_convert_type (emin_1->expr, &ts, 2);
+    }
+  emin_1->next = tiny;
+
+  prec = gfc_get_actual_arglist ();
+  prec->name = "prec";
+  prec->expr = gfc_int_expr (gfc_real_kinds[k].digits);
+
+  /* The library routine expects INTEGER(4).  */
+  if (prec->expr->ts.kind != gfc_c_int_kind)
+    {
+      gfc_typespec ts;
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_c_int_kind;
+      gfc_convert_type (prec->expr, &ts, 2);
+    }
+  prec->next = emin_1;
+
+  f->value.function.actual->next = prec;

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_spread (gfc_expr * f, gfc_expr * source,
-                   gfc_expr * dim,
-                   gfc_expr * ncopies)
+gfc_resolve_spread (gfc_expr *f, gfc_expr *source, gfc_expr *dim,
+                   gfc_expr *ncopies)

 {
   if (source->ts.type == BT_CHARACTER)
     check_charlen_present (source);
 {
   if (source->ts.type == BT_CHARACTER)
     check_charlen_present (source);


@@ -1716,12 +1940,28 @@ gfc_resolve_spread (gfc_expr * f, gfc_expr * source,
   f->rank = source->rank + 1;
   if (source->rank == 0)
     f->value.function.name = (source->ts.type == BT_CHARACTER
   f->rank = source->rank + 1;
   if (source->rank == 0)
     f->value.function.name = (source->ts.type == BT_CHARACTER

-                             ? PREFIX("spread_char_scalar")
-                             : PREFIX("spread_scalar"));
+                             ? PREFIX ("spread_char_scalar")
+                             : PREFIX ("spread_scalar"));

   else
     f->value.function.name = (source->ts.type == BT_CHARACTER
   else
     f->value.function.name = (source->ts.type == BT_CHARACTER

-                             ? PREFIX("spread_char")
-                             : PREFIX("spread"));
+                             ? PREFIX ("spread_char")
+                             : PREFIX ("spread"));
+
+  if (dim && gfc_is_constant_expr (dim)
+      && ncopies && gfc_is_constant_expr (ncopies) && source->shape[0])
+    {
+      int i, idim;
+      idim = mpz_get_ui (dim->value.integer);
+      f->shape = gfc_get_shape (f->rank);
+      for (i = 0; i < (idim - 1); i++)
+       mpz_init_set (f->shape[i], source->shape[i]);
+
+      mpz_init_set (f->shape[idim - 1], ncopies->value.integer);
+
+      for (i = idim; i < f->rank ; i++)
+       mpz_init_set (f->shape[i], source->shape[i-1]);
+    }
+

 
   gfc_resolve_dim_arg (dim);
   gfc_resolve_index (ncopies, 1);
 
   gfc_resolve_dim_arg (dim);
   gfc_resolve_index (ncopies, 1);


@@ -1729,40 +1969,50 @@ gfc_resolve_spread (gfc_expr * f, gfc_expr * source,
 
 
 void
 
 
 void

-gfc_resolve_sqrt (gfc_expr * f, gfc_expr * x)
+gfc_resolve_sqrt (gfc_expr *f, gfc_expr *x)

 {
   f->ts = x->ts;
 {
   f->ts = x->ts;

-  f->value.function.name =
-    gfc_get_string ("__sqrt_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__sqrt_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);

 }
 
 
 /* Resolve the g77 compatibility function STAT AND FSTAT.  */
 
 void
 }
 
 
 /* Resolve the g77 compatibility function STAT AND FSTAT.  */
 
 void

-gfc_resolve_stat (gfc_expr * f, gfc_expr * n ATTRIBUTE_UNUSED,
-                 gfc_expr * a ATTRIBUTE_UNUSED)
+gfc_resolve_stat (gfc_expr *f, gfc_expr *n ATTRIBUTE_UNUSED,
+                 gfc_expr *a ATTRIBUTE_UNUSED)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+  f->value.function.name = gfc_get_string (PREFIX ("stat_i%d"), f->ts.kind);
+}
+
+
+void
+gfc_resolve_lstat (gfc_expr *f, gfc_expr *n ATTRIBUTE_UNUSED,
+                  gfc_expr *a ATTRIBUTE_UNUSED)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;

-  f->value.function.name = gfc_get_string (PREFIX("stat_i%d"), f->ts.kind);
+  f->value.function.name = gfc_get_string (PREFIX ("lstat_i%d"), f->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_fstat (gfc_expr * f, gfc_expr * n, gfc_expr * a ATTRIBUTE_UNUSED)
+gfc_resolve_fstat (gfc_expr *f, gfc_expr *n, gfc_expr *a ATTRIBUTE_UNUSED)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
   if (n->ts.kind != f->ts.kind)
     gfc_convert_type (n, &f->ts, 2);
 
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
   if (n->ts.kind != f->ts.kind)
     gfc_convert_type (n, &f->ts, 2);
 

-  f->value.function.name = gfc_get_string (PREFIX("fstat_i%d"), f->ts.kind);
+  f->value.function.name = gfc_get_string (PREFIX ("fstat_i%d"), f->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_fgetc (gfc_expr * f, gfc_expr * u, gfc_expr * c ATTRIBUTE_UNUSED)
+gfc_resolve_fgetc (gfc_expr *f, gfc_expr *u, gfc_expr *c ATTRIBUTE_UNUSED)

 {
   gfc_typespec ts;
 
 {
   gfc_typespec ts;
 


@@ -1777,21 +2027,21 @@ gfc_resolve_fgetc (gfc_expr * f, gfc_expr * u, gfc_expr * c ATTRIBUTE_UNUSED)
       gfc_convert_type (u, &ts, 2);
     }
 
       gfc_convert_type (u, &ts, 2);
     }
 

-  f->value.function.name = gfc_get_string (PREFIX("fgetc"));
+  f->value.function.name = gfc_get_string (PREFIX ("fgetc"));

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_fget (gfc_expr * f, gfc_expr * c ATTRIBUTE_UNUSED)
+gfc_resolve_fget (gfc_expr *f, gfc_expr *c ATTRIBUTE_UNUSED)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_c_int_kind;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_c_int_kind;

-  f->value.function.name = gfc_get_string (PREFIX("fget"));
+  f->value.function.name = gfc_get_string (PREFIX ("fget"));

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_fputc (gfc_expr * f, gfc_expr * u, gfc_expr * c ATTRIBUTE_UNUSED)
+gfc_resolve_fputc (gfc_expr *f, gfc_expr *u, gfc_expr *c ATTRIBUTE_UNUSED)

 {
   gfc_typespec ts;
 
 {
   gfc_typespec ts;
 


@@ -1806,21 +2056,21 @@ gfc_resolve_fputc (gfc_expr * f, gfc_expr * u, gfc_expr * c ATTRIBUTE_UNUSED)
       gfc_convert_type (u, &ts, 2);
     }
 
       gfc_convert_type (u, &ts, 2);
     }
 

-  f->value.function.name = gfc_get_string (PREFIX("fputc"));
+  f->value.function.name = gfc_get_string (PREFIX ("fputc"));

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_fput (gfc_expr * f, gfc_expr * c ATTRIBUTE_UNUSED)
+gfc_resolve_fput (gfc_expr *f, gfc_expr *c ATTRIBUTE_UNUSED)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_c_int_kind;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_c_int_kind;

-  f->value.function.name = gfc_get_string (PREFIX("fput"));
+  f->value.function.name = gfc_get_string (PREFIX ("fput"));

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_ftell (gfc_expr * f, gfc_expr * u)
+gfc_resolve_ftell (gfc_expr *f, gfc_expr *u)

 {
   gfc_typespec ts;
 
 {
   gfc_typespec ts;
 


@@ -1835,13 +2085,12 @@ gfc_resolve_ftell (gfc_expr * f, gfc_expr * u)
       gfc_convert_type (u, &ts, 2);
     }
 
       gfc_convert_type (u, &ts, 2);
     }
 

-  f->value.function.name = gfc_get_string (PREFIX("ftell"));
+  f->value.function.name = gfc_get_string (PREFIX ("ftell"));

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_sum (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
-                gfc_expr * mask)
+gfc_resolve_sum (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *mask)

 {
   const char *name;
 
 {
   const char *name;
 


@@ -1854,16 +2103,7 @@ gfc_resolve_sum (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
       else
        name = "msum";
 
       else
        name = "msum";
 

-      /* The mask can be kind 4 or 8 for the array case.  For the
-        scalar case, coerce it to default kind unconditionally.  */
-      if ((mask->ts.kind < gfc_default_logical_kind)
-         || (mask->rank == 0 && mask->ts.kind != gfc_default_logical_kind))
-       {
-         gfc_typespec ts;
-         ts.type = BT_LOGICAL;
-         ts.kind = gfc_default_logical_kind;
-         gfc_convert_type_warn (mask, &ts, 2, 0);
-       }
+      resolve_mask_arg (mask);

     }
   else
     name = "sum";
     }
   else
     name = "sum";


@@ -1874,72 +2114,72 @@ gfc_resolve_sum (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
       gfc_resolve_dim_arg (dim);
     }
 
       gfc_resolve_dim_arg (dim);
     }
 

-  f->value.function.name =
-    gfc_get_string (PREFIX("%s_%c%d"), name,
+  f->value.function.name
+    = gfc_get_string (PREFIX ("%s_%c%d"), name,

                    gfc_type_letter (array->ts.type), array->ts.kind);
 }
 
 
 void
                    gfc_type_letter (array->ts.type), array->ts.kind);
 }
 
 
 void

-gfc_resolve_symlnk (gfc_expr * f, gfc_expr * p1 ATTRIBUTE_UNUSED,
-                   gfc_expr * p2 ATTRIBUTE_UNUSED)
+gfc_resolve_symlnk (gfc_expr *f, gfc_expr *p1 ATTRIBUTE_UNUSED,
+                   gfc_expr *p2 ATTRIBUTE_UNUSED)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;

-  f->value.function.name = gfc_get_string (PREFIX("symlnk_i%d"), f->ts.kind);
+  f->value.function.name = gfc_get_string (PREFIX ("symlnk_i%d"), f->ts.kind);

 }
 
 
 /* Resolve the g77 compatibility function SYSTEM.  */
 
 void
 }
 
 
 /* Resolve the g77 compatibility function SYSTEM.  */
 
 void

-gfc_resolve_system (gfc_expr * f, gfc_expr * n ATTRIBUTE_UNUSED)
+gfc_resolve_system (gfc_expr *f, gfc_expr *n ATTRIBUTE_UNUSED)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = 4;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = 4;

-  f->value.function.name = gfc_get_string (PREFIX("system"));
+  f->value.function.name = gfc_get_string (PREFIX ("system"));

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_tan (gfc_expr * f, gfc_expr * x)
+gfc_resolve_tan (gfc_expr *f, gfc_expr *x)

 {
   f->ts = x->ts;
 {
   f->ts = x->ts;

-  f->value.function.name =
-    gfc_get_string ("__tan_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__tan_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_tanh (gfc_expr * f, gfc_expr * x)
+gfc_resolve_tanh (gfc_expr *f, gfc_expr *x)

 {
   f->ts = x->ts;
 {
   f->ts = x->ts;

-  f->value.function.name =
-    gfc_get_string ("__tanh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__tanh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_time (gfc_expr * f)
+gfc_resolve_time (gfc_expr *f)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = 4;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = 4;

-  f->value.function.name = gfc_get_string (PREFIX("time_func"));
+  f->value.function.name = gfc_get_string (PREFIX ("time_func"));

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_time8 (gfc_expr * f)
+gfc_resolve_time8 (gfc_expr *f)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = 8;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = 8;

-  f->value.function.name = gfc_get_string (PREFIX("time8_func"));
+  f->value.function.name = gfc_get_string (PREFIX ("time8_func"));

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_transfer (gfc_expr * f, gfc_expr * source ATTRIBUTE_UNUSED,
-                     gfc_expr * mold, gfc_expr * size)
+gfc_resolve_transfer (gfc_expr *f, gfc_expr *source ATTRIBUTE_UNUSED,
+                     gfc_expr *mold, gfc_expr *size)

 {
   /* TODO: Make this do something meaningful.  */
   static char transfer0[] = "__transfer0", transfer1[] = "__transfer1";
 {
   /* TODO: Make this do something meaningful.  */
   static char transfer0[] = "__transfer0", transfer1[] = "__transfer1";


@@ -1965,10 +2205,8 @@ gfc_resolve_transfer (gfc_expr * f, gfc_expr * source ATTRIBUTE_UNUSED,
 
 
 void
 
 
 void

-gfc_resolve_transpose (gfc_expr * f, gfc_expr * matrix)
+gfc_resolve_transpose (gfc_expr *f, gfc_expr *matrix)

 {
 {

-  int kind;
-

   f->ts = matrix->ts;
   f->rank = 2;
   if (matrix->shape)
   f->ts = matrix->ts;
   f->rank = 2;
   if (matrix->shape)


@@ -1978,59 +2216,47 @@ gfc_resolve_transpose (gfc_expr * f, gfc_expr * matrix)
       mpz_init_set (f->shape[1], matrix->shape[0]);
     }
 
       mpz_init_set (f->shape[1], matrix->shape[0]);
     }
 

-  kind = matrix->ts.kind;
-
-  switch (kind)
+  switch (matrix->ts.kind)

     {
     case 4:
     case 8:
     case 10:
     case 16:
       switch (matrix->ts.type)
     {
     case 4:
     case 8:
     case 10:
     case 16:
       switch (matrix->ts.type)

-        {
-        case BT_COMPLEX:
-          f->value.function.name =
-            gfc_get_string (PREFIX("transpose_c%d"), kind);
-          break;
-
-        case BT_REAL:
-         /* There is no kind=10 integer type and on 32-bit targets
-            there is usually no kind=16 integer type.  We need to
-            call the real version.  */
-         if (kind == 10 || kind == 16)
-           {
-             f->value.function.name =
-               gfc_get_string (PREFIX("transpose_r%d"), kind);
-             break;
-           }
-
-         /* Fall through */
-
-        case BT_INTEGER:
-        case BT_LOGICAL:
+       {
+       case BT_REAL:
+       case BT_COMPLEX:
+         f->value.function.name
+           = gfc_get_string (PREFIX ("transpose_%c%d"),
+                             gfc_type_letter (matrix->ts.type),
+                             matrix->ts.kind);
+         break;
+
+       case BT_INTEGER:
+       case BT_LOGICAL:

          /* Use the integer routines for real and logical cases.  This
             assumes they all have the same alignment requirements.  */
          /* Use the integer routines for real and logical cases.  This
             assumes they all have the same alignment requirements.  */

-          f->value.function.name =
-            gfc_get_string (PREFIX("transpose_i%d"), kind);
-          break;
-
-        default:
-          f->value.function.name = PREFIX("transpose");
-          break;
-        }
+         f->value.function.name
+           = gfc_get_string (PREFIX ("transpose_i%d"), matrix->ts.kind);
+         break;
+
+       default:
+         f->value.function.name = PREFIX ("transpose");
+         break;
+       }

       break;
 
     default:
       f->value.function.name = (matrix->ts.type == BT_CHARACTER
       break;
 
     default:
       f->value.function.name = (matrix->ts.type == BT_CHARACTER

-                               ? PREFIX("transpose_char")
-                               : PREFIX("transpose"));
+                               ? PREFIX ("transpose_char")
+                               : PREFIX ("transpose"));

       break;
     }
 }
 
 
 void
       break;
     }
 }
 
 
 void

-gfc_resolve_trim (gfc_expr * f, gfc_expr * string)
+gfc_resolve_trim (gfc_expr *f, gfc_expr *string)

 {
   f->ts.type = BT_CHARACTER;
   f->ts.kind = string->ts.kind;
 {
   f->ts.type = BT_CHARACTER;
   f->ts.kind = string->ts.kind;


@@ -2039,8 +2265,7 @@ gfc_resolve_trim (gfc_expr * f, gfc_expr * string)
 
 
 void
 
 
 void

-gfc_resolve_ubound (gfc_expr * f, gfc_expr * array,
-                   gfc_expr * dim)
+gfc_resolve_ubound (gfc_expr *f, gfc_expr *array, gfc_expr *dim)

 {
   static char ubound[] = "__ubound";
 
 {
   static char ubound[] = "__ubound";
 


@@ -2061,27 +2286,27 @@ gfc_resolve_ubound (gfc_expr * f, gfc_expr * array,
 /* Resolve the g77 compatibility function UMASK.  */
 
 void
 /* Resolve the g77 compatibility function UMASK.  */
 
 void

-gfc_resolve_umask (gfc_expr * f, gfc_expr * n)
+gfc_resolve_umask (gfc_expr *f, gfc_expr *n)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = n->ts.kind;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = n->ts.kind;

-  f->value.function.name = gfc_get_string (PREFIX("umask_i%d"), n->ts.kind);
+  f->value.function.name = gfc_get_string (PREFIX ("umask_i%d"), n->ts.kind);

 }
 
 
 /* Resolve the g77 compatibility function UNLINK.  */
 
 void
 }
 
 
 /* Resolve the g77 compatibility function UNLINK.  */
 
 void

-gfc_resolve_unlink (gfc_expr * f, gfc_expr * n ATTRIBUTE_UNUSED)
+gfc_resolve_unlink (gfc_expr *f, gfc_expr *n ATTRIBUTE_UNUSED)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = 4;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = 4;

-  f->value.function.name = gfc_get_string (PREFIX("unlink"));
+  f->value.function.name = gfc_get_string (PREFIX ("unlink"));

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_ttynam (gfc_expr * f, gfc_expr * unit)
+gfc_resolve_ttynam (gfc_expr *f, gfc_expr *unit)

 {
   gfc_typespec ts;
   
 {
   gfc_typespec ts;
   


@@ -2097,27 +2322,28 @@ gfc_resolve_ttynam (gfc_expr * f, gfc_expr * unit)
       gfc_convert_type (unit, &ts, 2);
     }
 
       gfc_convert_type (unit, &ts, 2);
     }
 

-  f->value.function.name = gfc_get_string (PREFIX("ttynam"));
+  f->value.function.name = gfc_get_string (PREFIX ("ttynam"));

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_unpack (gfc_expr * f, gfc_expr * vector, gfc_expr * mask,
-                   gfc_expr * field ATTRIBUTE_UNUSED)
+gfc_resolve_unpack (gfc_expr *f, gfc_expr *vector, gfc_expr *mask,
+                   gfc_expr *field ATTRIBUTE_UNUSED)

 {
   f->ts = vector->ts;
   f->rank = mask->rank;
 {
   f->ts = vector->ts;
   f->rank = mask->rank;

+  resolve_mask_arg (mask);

 
 

-  f->value.function.name =
-    gfc_get_string (PREFIX("unpack%d%s"), field->rank > 0 ? 1 : 0,
-                   vector->ts.type == BT_CHARACTER ? "_char" : "");
+  f->value.function.name
+    = gfc_get_string (PREFIX ("unpack%d%s"), field->rank > 0 ? 1 : 0,
+                     vector->ts.type == BT_CHARACTER ? "_char" : "");

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_verify (gfc_expr * f, gfc_expr * string,
-                   gfc_expr * set ATTRIBUTE_UNUSED,
-                   gfc_expr * back ATTRIBUTE_UNUSED)
+gfc_resolve_verify (gfc_expr *f, gfc_expr *string,
+                   gfc_expr *set ATTRIBUTE_UNUSED,
+                   gfc_expr *back ATTRIBUTE_UNUSED)

 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
 {
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;


@@ -2126,29 +2352,28 @@ gfc_resolve_verify (gfc_expr * f, gfc_expr * string,
 
 
 void
 
 
 void

-gfc_resolve_xor (gfc_expr * f, gfc_expr * i, gfc_expr * j)
+gfc_resolve_xor (gfc_expr *f, gfc_expr *i, gfc_expr *j)

 {
   f->ts.type = i->ts.type;
 {
   f->ts.type = i->ts.type;

-  f->ts.kind = gfc_kind_max (i,j);
+  f->ts.kind = gfc_kind_max (i, j);

 
   if (i->ts.kind != j->ts.kind)
     {
 
   if (i->ts.kind != j->ts.kind)
     {

-      if (i->ts.kind == gfc_kind_max (i,j))
-       gfc_convert_type(j, &i->ts, 2);
+      if (i->ts.kind == gfc_kind_max (i, j))
+       gfc_convert_type (j, &i->ts, 2);

       else
       else

-       gfc_convert_type(i, &j->ts, 2);
+       gfc_convert_type (i, &j->ts, 2);

     }
 
     }
 

-  f->value.function.name = gfc_get_string ("__xor_%c%d",
-                                          gfc_type_letter (i->ts.type),
-                                          f->ts.kind);
+  f->value.function.name
+    = gfc_get_string ("__xor_%c%d", gfc_type_letter (i->ts.type), f->ts.kind);

 }
 
 
 /* Intrinsic subroutine resolution.  */
 
 void
 }
 
 
 /* Intrinsic subroutine resolution.  */
 
 void

-gfc_resolve_alarm_sub (gfc_code * c)
+gfc_resolve_alarm_sub (gfc_code *c)

 {
   const char *name;
   gfc_expr *seconds, *handler, *status;
 {
   const char *name;
   gfc_expr *seconds, *handler, *status;


@@ -2160,66 +2385,77 @@ gfc_resolve_alarm_sub (gfc_code * c)
   ts.type = BT_INTEGER;
   ts.kind = gfc_c_int_kind;
 
   ts.type = BT_INTEGER;
   ts.kind = gfc_c_int_kind;
 

-  /* handler can be either BT_INTEGER or BT_PROCEDURE  */
+  /* handler can be either BT_INTEGER or BT_PROCEDURE.
+     In all cases, the status argument is of default integer kind
+     (enforced in check.c) so that the function suffix is fixed.  */

   if (handler->ts.type == BT_INTEGER)
     {
       if (handler->ts.kind != gfc_c_int_kind)
        gfc_convert_type (handler, &ts, 2);
   if (handler->ts.type == BT_INTEGER)
     {
       if (handler->ts.kind != gfc_c_int_kind)
        gfc_convert_type (handler, &ts, 2);

-      name = gfc_get_string (PREFIX("alarm_sub_int"));
+      name = gfc_get_string (PREFIX ("alarm_sub_int_i%d"),
+                            gfc_default_integer_kind);

     }
   else
     }
   else

-    name = gfc_get_string (PREFIX("alarm_sub"));
+    name = gfc_get_string (PREFIX ("alarm_sub_i%d"),
+                          gfc_default_integer_kind);

 
   if (seconds->ts.kind != gfc_c_int_kind)
     gfc_convert_type (seconds, &ts, 2);
 
   if (seconds->ts.kind != gfc_c_int_kind)
     gfc_convert_type (seconds, &ts, 2);

-  if (status != NULL && status->ts.kind != gfc_c_int_kind)
-    gfc_convert_type (status, &ts, 2);

 
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 void
 
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 void

-gfc_resolve_cpu_time (gfc_code * c ATTRIBUTE_UNUSED)
+gfc_resolve_cpu_time (gfc_code *c)

 {
   const char *name;
 {
   const char *name;

-
-  name = gfc_get_string (PREFIX("cpu_time_%d"),
-                        c->ext.actual->expr->ts.kind);
+  name = gfc_get_string (PREFIX ("cpu_time_%d"), c->ext.actual->expr->ts.kind);

   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void

-gfc_resolve_mvbits (gfc_code * c)
+gfc_resolve_mvbits (gfc_code *c)

 {
   const char *name;
 {
   const char *name;

-  int kind;
-
-  kind = c->ext.actual->expr->ts.kind;
-  name = gfc_get_string (PREFIX("mvbits_i%d"), kind);
+  gfc_typespec ts;

 
 

+  /* FROMPOS, LEN and TOPOS are restricted to small values.  As such,
+     they will be converted so that they fit into a C int.  */
+  ts.type = BT_INTEGER;
+  ts.kind = gfc_c_int_kind;
+  if (c->ext.actual->next->expr->ts.kind != gfc_c_int_kind)
+    gfc_convert_type (c->ext.actual->next->expr, &ts, 2);
+  if (c->ext.actual->next->next->expr->ts.kind != gfc_c_int_kind)
+    gfc_convert_type (c->ext.actual->next->next->expr, &ts, 2);
+  if (c->ext.actual->next->next->next->next->expr->ts.kind != gfc_c_int_kind)
+    gfc_convert_type (c->ext.actual->next->next->next->next->expr, &ts, 2);
+
+  /* TO and FROM are guaranteed to have the same kind parameter.  */
+  name = gfc_get_string (PREFIX ("mvbits_i%d"),
+                        c->ext.actual->expr->ts.kind);

   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void

-gfc_resolve_random_number (gfc_code * c ATTRIBUTE_UNUSED)
+gfc_resolve_random_number (gfc_code *c)

 {
   const char *name;
   int kind;
 
   kind = c->ext.actual->expr->ts.kind;
   if (c->ext.actual->expr->rank == 0)
 {
   const char *name;
   int kind;
 
   kind = c->ext.actual->expr->ts.kind;
   if (c->ext.actual->expr->rank == 0)

-    name = gfc_get_string (PREFIX("random_r%d"), kind);
+    name = gfc_get_string (PREFIX ("random_r%d"), kind);

   else
   else

-    name = gfc_get_string (PREFIX("arandom_r%d"), kind);
+    name = gfc_get_string (PREFIX ("arandom_r%d"), kind);

   
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void
   
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void

-gfc_resolve_rename_sub (gfc_code * c)
+gfc_resolve_rename_sub (gfc_code *c)

 {
   const char *name;
   int kind;
 {
   const char *name;
   int kind;


@@ -2229,13 +2465,13 @@ gfc_resolve_rename_sub (gfc_code * c)
   else
     kind = gfc_default_integer_kind;
 
   else
     kind = gfc_default_integer_kind;
 

-  name = gfc_get_string (PREFIX("rename_i%d_sub"), kind);
+  name = gfc_get_string (PREFIX ("rename_i%d_sub"), kind);

   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void

-gfc_resolve_kill_sub (gfc_code * c)
+gfc_resolve_kill_sub (gfc_code *c)

 {
   const char *name;
   int kind;
 {
   const char *name;
   int kind;


@@ -2245,13 +2481,13 @@ gfc_resolve_kill_sub (gfc_code * c)
   else
     kind = gfc_default_integer_kind;
 
   else
     kind = gfc_default_integer_kind;
 

-  name = gfc_get_string (PREFIX("kill_i%d_sub"), kind);
+  name = gfc_get_string (PREFIX ("kill_i%d_sub"), kind);

   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
     
 
 void
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
     
 
 void

-gfc_resolve_link_sub (gfc_code * c)
+gfc_resolve_link_sub (gfc_code *c)

 {
   const char *name;
   int kind;
 {
   const char *name;
   int kind;


@@ -2261,13 +2497,13 @@ gfc_resolve_link_sub (gfc_code * c)
   else
     kind = gfc_default_integer_kind;
 
   else
     kind = gfc_default_integer_kind;
 

-  name = gfc_get_string (PREFIX("link_i%d_sub"), kind);
+  name = gfc_get_string (PREFIX ("link_i%d_sub"), kind);

   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void

-gfc_resolve_symlnk_sub (gfc_code * c)
+gfc_resolve_symlnk_sub (gfc_code *c)

 {
   const char *name;
   int kind;
 {
   const char *name;
   int kind;


@@ -2277,7 +2513,7 @@ gfc_resolve_symlnk_sub (gfc_code * c)
   else
     kind = gfc_default_integer_kind;
 
   else
     kind = gfc_default_integer_kind;
 

-  name = gfc_get_string (PREFIX("symlnk_i%d_sub"), kind);
+  name = gfc_get_string (PREFIX ("symlnk_i%d_sub"), kind);

   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 


@@ -2285,29 +2521,62 @@ gfc_resolve_symlnk_sub (gfc_code * c)
 /* G77 compatibility subroutines etime() and dtime().  */
 
 void
 /* G77 compatibility subroutines etime() and dtime().  */
 
 void

-gfc_resolve_etime_sub (gfc_code * c)
+gfc_resolve_etime_sub (gfc_code *c)

 {
   const char *name;
 {
   const char *name;

-
-  name = gfc_get_string (PREFIX("etime_sub"));
+  name = gfc_get_string (PREFIX ("etime_sub"));

   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 

+/* G77 compatibility subroutines itime(), idate(), ltime() and gmtime().  */
+
+void
+gfc_resolve_itime (gfc_code *c)
+{
+  c->resolved_sym
+    = gfc_get_intrinsic_sub_symbol (gfc_get_string (PREFIX ("itime_i%d"),
+                                                   gfc_default_integer_kind));
+}
+
+void
+gfc_resolve_idate (gfc_code *c)
+{
+  c->resolved_sym
+    = gfc_get_intrinsic_sub_symbol (gfc_get_string (PREFIX ("idate_i%d"),
+                                                   gfc_default_integer_kind));
+}
+
+void
+gfc_resolve_ltime (gfc_code *c)
+{
+  c->resolved_sym
+    = gfc_get_intrinsic_sub_symbol (gfc_get_string (PREFIX ("ltime_i%d"),
+                                                   gfc_default_integer_kind));
+}
+
+void
+gfc_resolve_gmtime (gfc_code *c)
+{
+  c->resolved_sym
+    = gfc_get_intrinsic_sub_symbol (gfc_get_string (PREFIX ("gmtime_i%d"),
+                                                   gfc_default_integer_kind));
+}
+
+

 /* G77 compatibility subroutine second().  */
 
 void
 /* G77 compatibility subroutine second().  */
 
 void

-gfc_resolve_second_sub (gfc_code * c)
+gfc_resolve_second_sub (gfc_code *c)

 {
   const char *name;
 {
   const char *name;

-
-  name = gfc_get_string (PREFIX("second_sub"));
+  name = gfc_get_string (PREFIX ("second_sub"));

   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void

-gfc_resolve_sleep_sub (gfc_code * c)
+gfc_resolve_sleep_sub (gfc_code *c)

 {
   const char *name;
   int kind;
 {
   const char *name;
   int kind;


@@ -2317,7 +2586,7 @@ gfc_resolve_sleep_sub (gfc_code * c)
   else
     kind = gfc_default_integer_kind;
 
   else
     kind = gfc_default_integer_kind;
 

-  name = gfc_get_string (PREFIX("sleep_i%d_sub"), kind);
+  name = gfc_get_string (PREFIX ("sleep_i%d_sub"), kind);

   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 


@@ -2325,10 +2594,10 @@ gfc_resolve_sleep_sub (gfc_code * c)
 /* G77 compatibility function srand().  */
 
 void
 /* G77 compatibility function srand().  */
 
 void

-gfc_resolve_srand (gfc_code * c)
+gfc_resolve_srand (gfc_code *c)

 {
   const char *name;
 {
   const char *name;

-  name = gfc_get_string (PREFIX("srand"));
+  name = gfc_get_string (PREFIX ("srand"));

   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 


@@ -2336,20 +2605,20 @@ gfc_resolve_srand (gfc_code * c)
 /* Resolve the getarg intrinsic subroutine.  */
 
 void
 /* Resolve the getarg intrinsic subroutine.  */
 
 void

-gfc_resolve_getarg (gfc_code * c)
+gfc_resolve_getarg (gfc_code *c)

 {
   const char *name;
   int kind;
 {
   const char *name;
   int kind;

-

   kind = gfc_default_integer_kind;
   kind = gfc_default_integer_kind;

-  name = gfc_get_string (PREFIX("getarg_i%d"), kind);
+  name = gfc_get_string (PREFIX ("getarg_i%d"), kind);

   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 

+

 /* Resolve the getcwd intrinsic subroutine.  */
 
 void
 /* Resolve the getcwd intrinsic subroutine.  */
 
 void

-gfc_resolve_getcwd_sub (gfc_code * c)
+gfc_resolve_getcwd_sub (gfc_code *c)

 {
   const char *name;
   int kind;
 {
   const char *name;
   int kind;


@@ -2359,7 +2628,7 @@ gfc_resolve_getcwd_sub (gfc_code * c)
   else
     kind = gfc_default_integer_kind;
 
   else
     kind = gfc_default_integer_kind;
 

-  name = gfc_get_string (PREFIX("getcwd_i%d_sub"), kind);
+  name = gfc_get_string (PREFIX ("getcwd_i%d_sub"), kind);

   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 


@@ -2367,13 +2636,12 @@ gfc_resolve_getcwd_sub (gfc_code * c)
 /* Resolve the get_command intrinsic subroutine.  */
 
 void
 /* Resolve the get_command intrinsic subroutine.  */
 
 void

-gfc_resolve_get_command (gfc_code * c)
+gfc_resolve_get_command (gfc_code *c)

 {
   const char *name;
   int kind;
 {
   const char *name;
   int kind;

-

   kind = gfc_default_integer_kind;
   kind = gfc_default_integer_kind;

-  name = gfc_get_string (PREFIX("get_command_i%d"), kind);
+  name = gfc_get_string (PREFIX ("get_command_i%d"), kind);

   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 


@@ -2381,31 +2649,31 @@ gfc_resolve_get_command (gfc_code * c)
 /* Resolve the get_command_argument intrinsic subroutine.  */
 
 void
 /* Resolve the get_command_argument intrinsic subroutine.  */
 
 void

-gfc_resolve_get_command_argument (gfc_code * c)
+gfc_resolve_get_command_argument (gfc_code *c)

 {
   const char *name;
   int kind;
 {
   const char *name;
   int kind;

-

   kind = gfc_default_integer_kind;
   kind = gfc_default_integer_kind;

-  name = gfc_get_string (PREFIX("get_command_argument_i%d"), kind);
+  name = gfc_get_string (PREFIX ("get_command_argument_i%d"), kind);

   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 

+

 /* Resolve the get_environment_variable intrinsic subroutine.  */
 
 void
 /* Resolve the get_environment_variable intrinsic subroutine.  */
 
 void

-gfc_resolve_get_environment_variable (gfc_code * code)
+gfc_resolve_get_environment_variable (gfc_code *code)

 {
   const char *name;
   int kind;
 {
   const char *name;
   int kind;

-

   kind = gfc_default_integer_kind;
   kind = gfc_default_integer_kind;

-  name = gfc_get_string (PREFIX("get_environment_variable_i%d"), kind);
+  name = gfc_get_string (PREFIX ("get_environment_variable_i%d"), kind);

   code->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
   code->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 

+

 void
 void

-gfc_resolve_signal_sub (gfc_code * c)
+gfc_resolve_signal_sub (gfc_code *c)

 {
   const char *name;
   gfc_expr *number, *handler, *status;
 {
   const char *name;
   gfc_expr *number, *handler, *status;


@@ -2422,10 +2690,10 @@ gfc_resolve_signal_sub (gfc_code * c)
     {
       if (handler->ts.kind != gfc_c_int_kind)
        gfc_convert_type (handler, &ts, 2);
     {
       if (handler->ts.kind != gfc_c_int_kind)
        gfc_convert_type (handler, &ts, 2);

-      name = gfc_get_string (PREFIX("signal_sub_int"));
+      name = gfc_get_string (PREFIX ("signal_sub_int"));

     }
   else
     }
   else

-    name = gfc_get_string (PREFIX("signal_sub"));
+    name = gfc_get_string (PREFIX ("signal_sub"));

 
   if (number->ts.kind != gfc_c_int_kind)
     gfc_convert_type (number, &ts, 2);
 
   if (number->ts.kind != gfc_c_int_kind)
     gfc_convert_type (number, &ts, 2);


@@ -2435,21 +2703,22 @@ gfc_resolve_signal_sub (gfc_code * c)
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 

+

 /* Resolve the SYSTEM intrinsic subroutine.  */
 
 void
 /* Resolve the SYSTEM intrinsic subroutine.  */
 
 void

-gfc_resolve_system_sub (gfc_code * c)
+gfc_resolve_system_sub (gfc_code *c)

 {
   const char *name;
 {
   const char *name;

-
-  name = gfc_get_string (PREFIX("system_sub"));
+  name = gfc_get_string (PREFIX ("system_sub"));

   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 

+

 /* Determine if the arguments to SYSTEM_CLOCK are INTEGER(4) or INTEGER(8) */
 
 void
 /* Determine if the arguments to SYSTEM_CLOCK are INTEGER(4) or INTEGER(8) */
 
 void

-gfc_resolve_system_clock (gfc_code * c)
+gfc_resolve_system_clock (gfc_code *c)

 {
   const char *name;
   int kind;
 {
   const char *name;
   int kind;


@@ -2463,31 +2732,37 @@ gfc_resolve_system_clock (gfc_code * c)
   else
     kind = gfc_default_integer_kind;
 
   else
     kind = gfc_default_integer_kind;
 

-  name = gfc_get_string (PREFIX("system_clock_%d"), kind);
+  name = gfc_get_string (PREFIX ("system_clock_%d"), kind);

   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 

+

 /* Resolve the EXIT intrinsic subroutine.  */
 
 void
 /* Resolve the EXIT intrinsic subroutine.  */
 
 void

-gfc_resolve_exit (gfc_code * c)
+gfc_resolve_exit (gfc_code *c)

 {
   const char *name;
 {
   const char *name;

-  int kind;
+  gfc_typespec ts;
+  gfc_expr *n;

 
 

-  if (c->ext.actual->expr != NULL)
-    kind = c->ext.actual->expr->ts.kind;
-  else
-    kind = gfc_default_integer_kind;
+  /* The STATUS argument has to be of default kind.  If it is not,
+     we convert it.  */
+  ts.type = BT_INTEGER;
+  ts.kind = gfc_default_integer_kind;
+  n = c->ext.actual->expr;
+  if (n != NULL && n->ts.kind != ts.kind)
+    gfc_convert_type (n, &ts, 2);

 
 

-  name = gfc_get_string (PREFIX("exit_i%d"), kind);
+  name = gfc_get_string (PREFIX ("exit_i%d"), ts.kind);

   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 

+

 /* Resolve the FLUSH intrinsic subroutine.  */
 
 void
 /* Resolve the FLUSH intrinsic subroutine.  */
 
 void

-gfc_resolve_flush (gfc_code * c)
+gfc_resolve_flush (gfc_code *c)

 {
   const char *name;
   gfc_typespec ts;
 {
   const char *name;
   gfc_typespec ts;


@@ -2496,17 +2771,16 @@ gfc_resolve_flush (gfc_code * c)
   ts.type = BT_INTEGER;
   ts.kind = gfc_default_integer_kind;
   n = c->ext.actual->expr;
   ts.type = BT_INTEGER;
   ts.kind = gfc_default_integer_kind;
   n = c->ext.actual->expr;

-  if (n != NULL
-      && n->ts.kind != ts.kind)
+  if (n != NULL && n->ts.kind != ts.kind)

     gfc_convert_type (n, &ts, 2);
 
     gfc_convert_type (n, &ts, 2);
 

-  name = gfc_get_string (PREFIX("flush_i%d"), ts.kind);
+  name = gfc_get_string (PREFIX ("flush_i%d"), ts.kind);

   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void

-gfc_resolve_free (gfc_code * c)
+gfc_resolve_free (gfc_code *c)

 {
   gfc_typespec ts;
   gfc_expr *n;
 {
   gfc_typespec ts;
   gfc_expr *n;


@@ -2517,12 +2791,12 @@ gfc_resolve_free (gfc_code * c)
   if (n->ts.kind != ts.kind)
     gfc_convert_type (n, &ts, 2);
 
   if (n->ts.kind != ts.kind)
     gfc_convert_type (n, &ts, 2);
 

-  c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX("free"));
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("free"));

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_ctime_sub (gfc_code * c)
+gfc_resolve_ctime_sub (gfc_code *c)

 {
   gfc_typespec ts;
   
 {
   gfc_typespec ts;
   


@@ -2536,33 +2810,33 @@ gfc_resolve_ctime_sub (gfc_code * c)
       gfc_convert_type (c->ext.actual->expr, &ts, 2);
     }
 
       gfc_convert_type (c->ext.actual->expr, &ts, 2);
     }
 

-  c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX("ctime_sub"));
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("ctime_sub"));

 }
 
 
 void
 }
 
 
 void

-gfc_resolve_fdate_sub (gfc_code * c)
+gfc_resolve_fdate_sub (gfc_code *c)

 {
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("fdate_sub"));
 }
 
 
 void
 {
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("fdate_sub"));
 }
 
 
 void

-gfc_resolve_gerror (gfc_code * c)
+gfc_resolve_gerror (gfc_code *c)

 {
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("gerror"));
 }
 
 
 void
 {
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("gerror"));
 }
 
 
 void

-gfc_resolve_getlog (gfc_code * c)
+gfc_resolve_getlog (gfc_code *c)

 {
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("getlog"));
 }
 
 
 void
 {
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("getlog"));
 }
 
 
 void

-gfc_resolve_hostnm_sub (gfc_code * c)
+gfc_resolve_hostnm_sub (gfc_code *c)

 {
   const char *name;
   int kind;
 {
   const char *name;
   int kind;


@@ -2572,13 +2846,13 @@ gfc_resolve_hostnm_sub (gfc_code * c)
   else
     kind = gfc_default_integer_kind;
 
   else
     kind = gfc_default_integer_kind;
 

-  name = gfc_get_string (PREFIX("hostnm_i%d_sub"), kind);
+  name = gfc_get_string (PREFIX ("hostnm_i%d_sub"), kind);

   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void

-gfc_resolve_perror (gfc_code * c)
+gfc_resolve_perror (gfc_code *c)

 {
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("perror_sub"));
 }
 {
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("perror_sub"));
 }


@@ -2586,17 +2860,25 @@ gfc_resolve_perror (gfc_code * c)
 /* Resolve the STAT and FSTAT intrinsic subroutines.  */
 
 void
 /* Resolve the STAT and FSTAT intrinsic subroutines.  */
 
 void

-gfc_resolve_stat_sub (gfc_code * c)
+gfc_resolve_stat_sub (gfc_code *c)

 {
   const char *name;
 {
   const char *name;

+  name = gfc_get_string (PREFIX ("stat_i%d_sub"), gfc_default_integer_kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+

 
 

-  name = gfc_get_string (PREFIX("stat_i%d_sub"), gfc_default_integer_kind);
+void
+gfc_resolve_lstat_sub (gfc_code *c)
+{
+  const char *name;
+  name = gfc_get_string (PREFIX ("lstat_i%d_sub"), gfc_default_integer_kind);

   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void

-gfc_resolve_fstat_sub (gfc_code * c)
+gfc_resolve_fstat_sub (gfc_code *c)

 {
   const char *name;
   gfc_expr *u;
 {
   const char *name;
   gfc_expr *u;


@@ -2606,13 +2888,13 @@ gfc_resolve_fstat_sub (gfc_code * c)
   ts = &c->ext.actual->next->expr->ts;
   if (u->ts.kind != ts->kind)
     gfc_convert_type (u, ts, 2);
   ts = &c->ext.actual->next->expr->ts;
   if (u->ts.kind != ts->kind)
     gfc_convert_type (u, ts, 2);

-  name = gfc_get_string (PREFIX("fstat_i%d_sub"), ts->kind);
+  name = gfc_get_string (PREFIX ("fstat_i%d_sub"), ts->kind);

   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void

-gfc_resolve_fgetc_sub (gfc_code * c)
+gfc_resolve_fgetc_sub (gfc_code *c)

 {
   const char *name;
   gfc_typespec ts;
 {
   const char *name;
   gfc_typespec ts;


@@ -2631,32 +2913,32 @@ gfc_resolve_fgetc_sub (gfc_code * c)
     }
 
   if (st != NULL)
     }
 
   if (st != NULL)

-    name = gfc_get_string (PREFIX("fgetc_i%d_sub"), st->ts.kind);
+    name = gfc_get_string (PREFIX ("fgetc_i%d_sub"), st->ts.kind);

   else
   else

-    name = gfc_get_string (PREFIX("fgetc_i%d_sub"), gfc_default_integer_kind);
+    name = gfc_get_string (PREFIX ("fgetc_i%d_sub"), gfc_default_integer_kind);

 
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void
 
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void

-gfc_resolve_fget_sub (gfc_code * c)
+gfc_resolve_fget_sub (gfc_code *c)

 {
   const char *name;
   gfc_expr *st;
 
   st = c->ext.actual->next->expr;
   if (st != NULL)
 {
   const char *name;
   gfc_expr *st;
 
   st = c->ext.actual->next->expr;
   if (st != NULL)

-    name = gfc_get_string (PREFIX("fget_i%d_sub"), st->ts.kind);
+    name = gfc_get_string (PREFIX ("fget_i%d_sub"), st->ts.kind);

   else
   else

-    name = gfc_get_string (PREFIX("fget_i%d_sub"), gfc_default_integer_kind);
+    name = gfc_get_string (PREFIX ("fget_i%d_sub"), gfc_default_integer_kind);

 
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void
 
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void

-gfc_resolve_fputc_sub (gfc_code * c)
+gfc_resolve_fputc_sub (gfc_code *c)

 {
   const char *name;
   gfc_typespec ts;
 {
   const char *name;
   gfc_typespec ts;


@@ -2675,32 +2957,76 @@ gfc_resolve_fputc_sub (gfc_code * c)
     }
 
   if (st != NULL)
     }
 
   if (st != NULL)

-    name = gfc_get_string (PREFIX("fputc_i%d_sub"), st->ts.kind);
+    name = gfc_get_string (PREFIX ("fputc_i%d_sub"), st->ts.kind);

   else
   else

-    name = gfc_get_string (PREFIX("fputc_i%d_sub"), gfc_default_integer_kind);
+    name = gfc_get_string (PREFIX ("fputc_i%d_sub"), gfc_default_integer_kind);

 
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void
 
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void

-gfc_resolve_fput_sub (gfc_code * c)
+gfc_resolve_fput_sub (gfc_code *c)

 {
   const char *name;
   gfc_expr *st;
 
   st = c->ext.actual->next->expr;
   if (st != NULL)
 {
   const char *name;
   gfc_expr *st;
 
   st = c->ext.actual->next->expr;
   if (st != NULL)

-    name = gfc_get_string (PREFIX("fput_i%d_sub"), st->ts.kind);
+    name = gfc_get_string (PREFIX ("fput_i%d_sub"), st->ts.kind);

   else
   else

-    name = gfc_get_string (PREFIX("fput_i%d_sub"), gfc_default_integer_kind);
+    name = gfc_get_string (PREFIX ("fput_i%d_sub"), gfc_default_integer_kind);

 
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 

+void 
+gfc_resolve_fseek_sub (gfc_code *c)
+{
+  gfc_expr *unit;
+  gfc_expr *offset;
+  gfc_expr *whence;
+  gfc_expr *status;
+  gfc_typespec ts;
+
+  unit   = c->ext.actual->expr;
+  offset = c->ext.actual->next->expr;
+  whence = c->ext.actual->next->next->expr;
+  status = c->ext.actual->next->next->next->expr;
+
+  if (unit->ts.kind != gfc_c_int_kind)
+    {
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_c_int_kind;
+      ts.derived = NULL;
+      ts.cl = NULL;
+      gfc_convert_type (unit, &ts, 2);
+    }
+
+  if (offset->ts.kind != gfc_intio_kind)
+    {
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_intio_kind;
+      ts.derived = NULL;
+      ts.cl = NULL;
+      gfc_convert_type (offset, &ts, 2);
+    }
+
+  if (whence->ts.kind != gfc_c_int_kind)
+    {
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_c_int_kind;
+      ts.derived = NULL;
+      ts.cl = NULL;
+      gfc_convert_type (whence, &ts, 2);
+    }
+
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("fseek_sub"));
+}
+

 void
 void

-gfc_resolve_ftell_sub (gfc_code * c)
+gfc_resolve_ftell_sub (gfc_code *c)

 {
   const char *name;
   gfc_expr *unit;
 {
   const char *name;
   gfc_expr *unit;


@@ -2719,13 +3045,13 @@ gfc_resolve_ftell_sub (gfc_code * c)
       gfc_convert_type (unit, &ts, 2);
     }
 
       gfc_convert_type (unit, &ts, 2);
     }
 

-  name = gfc_get_string (PREFIX("ftell_i%d_sub"), offset->ts.kind);
+  name = gfc_get_string (PREFIX ("ftell_i%d_sub"), offset->ts.kind);

   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 
 void

-gfc_resolve_ttynam_sub (gfc_code * c)
+gfc_resolve_ttynam_sub (gfc_code *c)

 {
   gfc_typespec ts;
   
 {
   gfc_typespec ts;
   


@@ -2738,14 +3064,14 @@ gfc_resolve_ttynam_sub (gfc_code * c)
       gfc_convert_type (c->ext.actual->expr, &ts, 2);
     }
 
       gfc_convert_type (c->ext.actual->expr, &ts, 2);
     }
 

-  c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX("ttynam_sub"));
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("ttynam_sub"));

 }
 
 
 /* Resolve the UMASK intrinsic subroutine.  */
 
 void
 }
 
 
 /* Resolve the UMASK intrinsic subroutine.  */
 
 void

-gfc_resolve_umask_sub (gfc_code * c)
+gfc_resolve_umask_sub (gfc_code *c)

 {
   const char *name;
   int kind;
 {
   const char *name;
   int kind;


@@ -2755,14 +3081,14 @@ gfc_resolve_umask_sub (gfc_code * c)
   else
     kind = gfc_default_integer_kind;
 
   else
     kind = gfc_default_integer_kind;
 

-  name = gfc_get_string (PREFIX("umask_i%d_sub"), kind);
+  name = gfc_get_string (PREFIX ("umask_i%d_sub"), kind);

   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 /* Resolve the UNLINK intrinsic subroutine.  */
 
 void
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
 /* Resolve the UNLINK intrinsic subroutine.  */
 
 void

-gfc_resolve_unlink_sub (gfc_code * c)
+gfc_resolve_unlink_sub (gfc_code *c)

 {
   const char *name;
   int kind;
 {
   const char *name;
   int kind;


@@ -2772,6 +3098,6 @@ gfc_resolve_unlink_sub (gfc_code * c)
   else
     kind = gfc_default_integer_kind;
 
   else
     kind = gfc_default_integer_kind;
 

-  name = gfc_get_string (PREFIX("unlink_i%d_sub"), kind);
+  name = gfc_get_string (PREFIX ("unlink_i%d_sub"), kind);

   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }