X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Ffortran%2Firesolve.c;h=e154a34f6355e245b6e1df2f5e7bfc6129d88f0b;hb=eb6e0f89020fbe1457af2af310cb6dd51f813f22;hp=7a4602872f1b8df408127e8def3e465b3720b558;hpb=201e10b402dcaee58fc2dfd3bba7fcf580be5d97;p=pf3gnuchains%2Fgcc-fork.git

diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 7a4602872f1..e154a34f635 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -1,5 +1,5 @@
 /* Intrinsic function resolution.
-   Copyright (C) 2000, 2001, 2002, 2003, 2004 Free Software Foundation,
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation,
    Inc.
    Contributed by Andy Vaught & Katherine Holcomb
 
@@ -17,8 +17,8 @@ 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, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.  */
+Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA.  */
 
 
 /* Assign name and types to intrinsic procedures.  For functions, the
@@ -29,104 +29,57 @@ Software Foundation, 59 Temple Place - Suite 330, Boston, MA
    are generally set according to the function arguments.  */
 
 #include "config.h"
-#include <string.h>
-#include <stdarg.h>
-
+#include "system.h"
+#include "coretypes.h"
+#include "tree.h"
 #include "gfortran.h"
 #include "intrinsic.h"
 
 
-/* String pool subroutines.  This are used to provide static locations
-   for the string constants that represent library function names.  */
-
-typedef struct string_node
-{
-  struct string_node *next;
-  char string[1];
-}
-string_node;
-
-#define HASH_SIZE 13
-
-static string_node *string_head[HASH_SIZE];
-
-
-/* Return a hash code based on the name.  */
+/* Given printf-like arguments, return a stable version of the result string. 
 
-static int
-hash (const char *name)
-{
-  int h;
-
-  h = 1;
-  while (*name)
-    h = 5311966 * h + *name++;
-
-  if (h < 0)
-    h = -h;
-  return h % HASH_SIZE;
-}
+   We already have a working, optimized string hashing table in the form of
+   the identifier table.  Reusing this table is likely not to be wasted, 
+   since if the function name makes it to the gimple output of the frontend,
+   we'll have to create the identifier anyway.  */
 
-
-/* Given printf-like arguments, return a static address of the
-   resulting string.  If the name is not in the table, it is added.  */
-
-char *
+const char *
 gfc_get_string (const char *format, ...)
 {
-  char temp_name[50];
-  string_node *p;
+  char temp_name[128];
   va_list ap;
-  int h;
+  tree ident;
 
   va_start (ap, format);
-  vsprintf (temp_name, format, ap);
+  vsnprintf (temp_name, sizeof(temp_name), format, ap);
   va_end (ap);
+  temp_name[sizeof(temp_name)-1] = 0;
 
-  h = hash (temp_name);
-
-  /* Search */
-  for (p = string_head[h]; p; p = p->next)
-    if (strcmp (p->string, temp_name) == 0)
-      return p->string;
-
-  /* Add */
-  p = gfc_getmem (sizeof (string_node) + strlen (temp_name));
-
-  strcpy (p->string, temp_name);
-
-  p->next = string_head[h];
-  string_head[h] = p;
-
-  return p->string;
+  ident = get_identifier (temp_name);
+  return IDENTIFIER_POINTER (ident);
 }
 
-
-
+/* MERGE and SPREAD need to have source charlen's present for passing
+   to the result expression.  */
 static void
-free_strings (void)
+check_charlen_present (gfc_expr *source)
 {
-  string_node *p, *q;
-  int h;
-
-  for (h = 0; h < HASH_SIZE; h++)
+  if (source->expr_type == EXPR_CONSTANT && source->ts.cl == NULL)
     {
-      for (p = string_head[h]; p; p = q)
-	{
-	  q = p->next;
-	  gfc_free (p);
-	}
+      source->ts.cl = gfc_get_charlen ();
+      source->ts.cl->next = gfc_current_ns->cl_list;
+      gfc_current_ns->cl_list = source->ts.cl;
+      source->ts.cl->length = gfc_int_expr (source->value.character.length);
+      source->rank = 0;
     }
 }
 
-
 /********************** Resolution functions **********************/
 
 
 void
 gfc_resolve_abs (gfc_expr * f, gfc_expr * a)
 {
-
   f->ts = a->ts;
   if (f->ts.type == BT_COMPLEX)
     f->ts.type = BT_REAL;
@@ -139,7 +92,6 @@ gfc_resolve_abs (gfc_expr * f, gfc_expr * a)
 void
 gfc_resolve_acos (gfc_expr * f, gfc_expr * x)
 {
-
   f->ts = x->ts;
   f->value.function.name =
     gfc_get_string ("__acos_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
@@ -147,9 +99,17 @@ gfc_resolve_acos (gfc_expr * f, gfc_expr * x)
 
 
 void
-gfc_resolve_aimag (gfc_expr * f, gfc_expr * x)
+gfc_resolve_acosh (gfc_expr * f, gfc_expr * x)
 {
+  f->ts = x->ts;
+  f->value.function.name =
+    gfc_get_string ("__acosh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+}
+
 
+void
+gfc_resolve_aimag (gfc_expr * f, gfc_expr * x)
+{
   f->ts.type = BT_REAL;
   f->ts.kind = x->ts.kind;
   f->value.function.name =
@@ -158,12 +118,39 @@ gfc_resolve_aimag (gfc_expr * f, gfc_expr * x)
 
 
 void
-gfc_resolve_aint (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
+gfc_resolve_and (gfc_expr * f, gfc_expr * i, gfc_expr * j)
 {
+  f->ts.type = i->ts.type;
+  f->ts.kind = gfc_kind_max (i,j);
+
+  if (i->ts.kind != j->ts.kind)
+    {
+      if (i->ts.kind == gfc_kind_max (i,j))
+	gfc_convert_type(j, &i->ts, 2);
+      else
+	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);
+}
+
 
+void
+gfc_resolve_aint (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
+{
+  gfc_typespec ts;
+  
   f->ts.type = a->ts.type;
   f->ts.kind = (kind == NULL) ? a->ts.kind : mpz_get_si (kind->value.integer);
 
+  if (a->ts.kind != f->ts.kind)
+    {
+      ts.type = f->ts.type;
+      ts.kind = f->ts.kind;
+      gfc_convert_type (a, &ts, 2);
+    }
   /* The resolved name is only used for specific intrinsics where
      the return kind is the same as the arg kind.  */
   f->value.function.name =
@@ -181,18 +168,17 @@ gfc_resolve_dint (gfc_expr * f, gfc_expr * a)
 void
 gfc_resolve_all (gfc_expr * f, gfc_expr * mask, gfc_expr * dim)
 {
-
   f->ts = mask->ts;
 
   if (dim != NULL)
     {
-      gfc_resolve_index (dim, 1);
+      gfc_resolve_dim_arg (dim);
       f->rank = mask->rank - 1;
       f->shape = gfc_copy_shape_excluding (mask->shape, mask->rank, dim);
     }
 
   f->value.function.name =
-    gfc_get_string ("__all_%c%d", gfc_type_letter (mask->ts.type),
+    gfc_get_string (PREFIX("all_%c%d"), gfc_type_letter (mask->ts.type),
 		    mask->ts.kind);
 }
 
@@ -200,10 +186,18 @@ gfc_resolve_all (gfc_expr * f, gfc_expr * mask, gfc_expr * dim)
 void
 gfc_resolve_anint (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
 {
-
+  gfc_typespec ts;
+  
   f->ts.type = a->ts.type;
   f->ts.kind = (kind == NULL) ? a->ts.kind : mpz_get_si (kind->value.integer);
 
+  if (a->ts.kind != f->ts.kind)
+    {
+      ts.type = f->ts.type;
+      ts.kind = f->ts.kind;
+      gfc_convert_type (a, &ts, 2);
+    }
+
   /* The resolved name is only used for specific intrinsics where
      the return kind is the same as the arg kind.  */
   f->value.function.name =
@@ -221,18 +215,17 @@ gfc_resolve_dnint (gfc_expr * f, gfc_expr * a)
 void
 gfc_resolve_any (gfc_expr * f, gfc_expr * mask, gfc_expr * dim)
 {
-
   f->ts = mask->ts;
 
   if (dim != NULL)
     {
-      gfc_resolve_index (dim, 1);
+      gfc_resolve_dim_arg (dim);
       f->rank = mask->rank - 1;
       f->shape = gfc_copy_shape_excluding (mask->shape, mask->rank, dim);
     }
 
   f->value.function.name =
-    gfc_get_string ("__any_%c%d", gfc_type_letter (mask->ts.type),
+    gfc_get_string (PREFIX("any_%c%d"), gfc_type_letter (mask->ts.type),
 		    mask->ts.kind);
 }
 
@@ -240,28 +233,39 @@ gfc_resolve_any (gfc_expr * f, gfc_expr * mask, gfc_expr * dim)
 void
 gfc_resolve_asin (gfc_expr * f, gfc_expr * x)
 {
-
   f->ts = x->ts;
   f->value.function.name =
     gfc_get_string ("__asin_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
 }
 
+void
+gfc_resolve_asinh (gfc_expr * f, gfc_expr * x)
+{
+  f->ts = x->ts;
+  f->value.function.name =
+    gfc_get_string ("__asinh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+}
 
 void
 gfc_resolve_atan (gfc_expr * f, gfc_expr * x)
 {
-
   f->ts = x->ts;
   f->value.function.name =
     gfc_get_string ("__atan_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
 }
 
+void
+gfc_resolve_atanh (gfc_expr * f, gfc_expr * x)
+{
+  f->ts = x->ts;
+  f->value.function.name =
+    gfc_get_string ("__atanh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+}
 
 void
 gfc_resolve_atan2 (gfc_expr * f, gfc_expr * x,
 		   gfc_expr * y ATTRIBUTE_UNUSED)
 {
-
   f->ts = x->ts;
   f->value.function.name =
     gfc_get_string ("__atan2_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
@@ -289,7 +293,6 @@ gfc_resolve_besn (gfc_expr * f, gfc_expr * n, gfc_expr * x)
 void
 gfc_resolve_btest (gfc_expr * f, gfc_expr * i, gfc_expr * pos)
 {
-
   f->ts.type = BT_LOGICAL;
   f->ts.kind = gfc_default_logical_kind;
 
@@ -301,7 +304,6 @@ gfc_resolve_btest (gfc_expr * f, gfc_expr * i, gfc_expr * pos)
 void
 gfc_resolve_ceiling (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
 {
-
   f->ts.type = BT_INTEGER;
   f->ts.kind = (kind == NULL) ? gfc_default_integer_kind
     : mpz_get_si (kind->value.integer);
@@ -315,7 +317,6 @@ gfc_resolve_ceiling (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
 void
 gfc_resolve_char (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
 {
-
   f->ts.type = BT_CHARACTER;
   f->ts.kind = (kind == NULL) ? gfc_default_character_kind
     : mpz_get_si (kind->value.integer);
@@ -327,9 +328,33 @@ gfc_resolve_char (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
 
 
 void
-gfc_resolve_cmplx (gfc_expr * f, gfc_expr * x, gfc_expr * y, gfc_expr * kind)
+gfc_resolve_chdir (gfc_expr * f, gfc_expr * d ATTRIBUTE_UNUSED)
+{
+  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);
+}
+
+
+void
+gfc_resolve_chdir_sub (gfc_code * c)
 {
+  const char *name;
+  int kind;
+
+  if (c->ext.actual->next->expr != NULL)
+    kind = c->ext.actual->next->expr->ts.kind;
+  else
+    kind = gfc_default_integer_kind;
 
+  name = gfc_get_string (PREFIX("chdir_i%d_sub"), kind);
+  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)
+{
   f->ts.type = BT_COMPLEX;
   f->ts.kind = (kind == NULL) ? gfc_default_real_kind
     : mpz_get_si (kind->value.integer);
@@ -352,9 +377,38 @@ gfc_resolve_dcmplx (gfc_expr * f, gfc_expr * x, gfc_expr * y)
 }
 
 void
-gfc_resolve_conjg (gfc_expr * f, gfc_expr * x)
+gfc_resolve_complex (gfc_expr * f, gfc_expr * x, gfc_expr * y)
 {
+  int kind;
+
+  if (x->ts.type == BT_INTEGER)
+    {
+      if (y->ts.type == BT_INTEGER)
+	kind = gfc_default_real_kind;
+      else
+	kind = y->ts.kind;
+    }
+  else
+    {
+      if (y->ts.type == BT_REAL)
+	kind = (x->ts.kind > y->ts.kind) ? x->ts.kind : y->ts.kind;
+      else
+	kind = x->ts.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);
+}
 
+
+void
+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);
 }
@@ -363,7 +417,6 @@ gfc_resolve_conjg (gfc_expr * f, gfc_expr * x)
 void
 gfc_resolve_cos (gfc_expr * f, gfc_expr * x)
 {
-
   f->ts = x->ts;
   f->value.function.name =
     gfc_get_string ("__cos_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
@@ -373,7 +426,6 @@ gfc_resolve_cos (gfc_expr * f, gfc_expr * x)
 void
 gfc_resolve_cosh (gfc_expr * f, gfc_expr * x)
 {
-
   f->ts = x->ts;
   f->value.function.name =
     gfc_get_string ("__cosh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
@@ -383,19 +435,18 @@ gfc_resolve_cosh (gfc_expr * f, gfc_expr * x)
 void
 gfc_resolve_count (gfc_expr * f, gfc_expr * mask, gfc_expr * dim)
 {
-
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
 
   if (dim != NULL)
     {
       f->rank = mask->rank - 1;
-      gfc_resolve_index (dim, 1);
+      gfc_resolve_dim_arg (dim);
       f->shape = gfc_copy_shape_excluding (mask->shape, mask->rank, dim);
     }
 
   f->value.function.name =
-    gfc_get_string ("__count_%d_%c%d", f->ts.kind,
+    gfc_get_string (PREFIX("count_%d_%c%d"), f->ts.kind,
 		    gfc_type_letter (mask->ts.type), mask->ts.kind);
 }
 
@@ -416,22 +467,54 @@ gfc_resolve_cshift (gfc_expr * f, gfc_expr * array,
   else
     n = 0;
 
+  /* Convert shift to at least gfc_default_integer_kind, so we don't need
+     kind=1 and kind=2 versions of the library functions.  */
+  if (shift->ts.kind < gfc_default_integer_kind)
+    {
+      gfc_typespec ts;
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_default_integer_kind;
+      gfc_convert_type_warn (shift, &ts, 2, 0);
+    }
+
   if (dim != NULL)
     {
-      gfc_resolve_index (dim, 1);
+      gfc_resolve_dim_arg (dim);
       /* Convert dim to shift's kind, so we don't need so many variations.  */
       if (dim->ts.kind != shift->ts.kind)
 	gfc_convert_type_warn (dim, &shift->ts, 2, 0);
     }
   f->value.function.name =
-    gfc_get_string ("__cshift%d_%d", n, shift->ts.kind);
+    gfc_get_string (PREFIX("cshift%d_%d%s"), n, shift->ts.kind,
+		    array->ts.type == BT_CHARACTER ? "_char" : "");
 }
 
 
 void
-gfc_resolve_dble (gfc_expr * f, gfc_expr * a)
+gfc_resolve_ctime (gfc_expr * f, gfc_expr * time)
 {
+  gfc_typespec ts;
+  
+  f->ts.type = BT_CHARACTER;
+  f->ts.kind = gfc_default_character_kind;
+
+  /* ctime TIME argument is a INTEGER(KIND=8), says the doc */
+  if (time->ts.kind != 8)
+    {
+      ts.type = BT_INTEGER;
+      ts.kind = 8;
+      ts.derived = NULL;
+      ts.cl = NULL;
+      gfc_convert_type (time, &ts, 2);
+    }
+
+  f->value.function.name = gfc_get_string (PREFIX("ctime"));
+}
+
 
+void
+gfc_resolve_dble (gfc_expr * f, gfc_expr * a)
+{
   f->ts.type = BT_REAL;
   f->ts.kind = gfc_default_double_kind;
   f->value.function.name =
@@ -440,13 +523,24 @@ gfc_resolve_dble (gfc_expr * f, gfc_expr * a)
 
 
 void
-gfc_resolve_dim (gfc_expr * f, gfc_expr * x,
-		 gfc_expr * y ATTRIBUTE_UNUSED)
+gfc_resolve_dim (gfc_expr * f, gfc_expr * a, gfc_expr * p)
 {
+  f->ts.type = a->ts.type;
+  if (p != NULL)
+    f->ts.kind = gfc_kind_max (a,p);
+  else
+    f->ts.kind = a->ts.kind;
+
+  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);
+      else
+	gfc_convert_type(a, &p->ts, 2);
+    }
 
-  f->ts = x->ts;
   f->value.function.name =
-    gfc_get_string ("__dim_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+    gfc_get_string ("__dim_%c%d", gfc_type_letter (f->ts.type), f->ts.kind);
 }
 
 
@@ -464,15 +558,15 @@ gfc_resolve_dot_product (gfc_expr * f, gfc_expr * a, gfc_expr * b)
     {
       temp.expr_type = EXPR_OP;
       gfc_clear_ts (&temp.ts);
-      temp.operator = INTRINSIC_NONE;
-      temp.op1 = a;
-      temp.op2 = b;
+      temp.value.op.operator = INTRINSIC_NONE;
+      temp.value.op.op1 = a;
+      temp.value.op.op2 = b;
       gfc_type_convert_binary (&temp);
       f->ts = temp.ts;
     }
 
   f->value.function.name =
-    gfc_get_string ("__dot_product_%c%d", gfc_type_letter (f->ts.type),
+    gfc_get_string (PREFIX("dot_product_%c%d"), gfc_type_letter (f->ts.type),
 		    f->ts.kind);
 }
 
@@ -507,20 +601,33 @@ gfc_resolve_eoshift (gfc_expr * f, gfc_expr * array,
   if (boundary && boundary->rank > 0)
     n = n | 2;
 
-  /* Convert dim to the same type as shift, so we don't need quite so many
-     variations.  */
-  if (dim != NULL && dim->ts.kind != shift->ts.kind)
-    gfc_convert_type_warn (dim, &shift->ts, 2, 0);
+  /* Convert shift to at least gfc_default_integer_kind, so we don't need
+     kind=1 and kind=2 versions of the library functions.  */
+  if (shift->ts.kind < gfc_default_integer_kind)
+    {
+      gfc_typespec ts;
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_default_integer_kind;
+      gfc_convert_type_warn (shift, &ts, 2, 0);
+    }
+
+  if (dim != NULL)
+    {
+      gfc_resolve_dim_arg (dim);
+      /* Convert dim to shift's kind, so we don't need so many variations.  */
+      if (dim->ts.kind != shift->ts.kind)
+	gfc_convert_type_warn (dim, &shift->ts, 2, 0);
+    }
 
   f->value.function.name =
-    gfc_get_string ("__eoshift%d_%d", n, shift->ts.kind);
+    gfc_get_string (PREFIX("eoshift%d_%d%s"), n, shift->ts.kind,
+		    array->ts.type == BT_CHARACTER ? "_char" : "");
 }
 
 
 void
 gfc_resolve_exp (gfc_expr * f, gfc_expr * x)
 {
-
   f->ts = x->ts;
   f->value.function.name =
     gfc_get_string ("__exp_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
@@ -530,7 +637,6 @@ gfc_resolve_exp (gfc_expr * f, gfc_expr * x)
 void
 gfc_resolve_exponent (gfc_expr * f, gfc_expr * x)
 {
-
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
 
@@ -539,9 +645,17 @@ gfc_resolve_exponent (gfc_expr * f, gfc_expr * x)
 
 
 void
-gfc_resolve_floor (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
+gfc_resolve_fdate (gfc_expr * f)
 {
+  f->ts.type = BT_CHARACTER;
+  f->ts.kind = gfc_default_character_kind;
+  f->value.function.name = gfc_get_string (PREFIX("fdate"));
+}
 
+
+void
+gfc_resolve_floor (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
+{
   f->ts.type = BT_INTEGER;
   f->ts.kind = (kind == NULL) ? gfc_default_integer_kind
     : mpz_get_si (kind->value.integer);
@@ -555,7 +669,6 @@ gfc_resolve_floor (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
 void
 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)
@@ -567,7 +680,6 @@ gfc_resolve_fnum (gfc_expr * f, gfc_expr * n)
 void
 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);
 }
@@ -619,8 +731,26 @@ gfc_resolve_getuid (gfc_expr * f)
 }
 
 void
-gfc_resolve_iand (gfc_expr * f, gfc_expr * i, gfc_expr * j 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"));
+}
+
+void
+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 (i->ts.kind == gfc_kind_max (i,j))
+	gfc_convert_type(j, &i->ts, 2);
+      else
+	gfc_convert_type(i, &j->ts, 2);
+    }
 
   f->ts = i->ts;
   f->value.function.name = gfc_get_string ("__iand_%d", i->ts.kind);
@@ -630,7 +760,6 @@ gfc_resolve_iand (gfc_expr * f, gfc_expr * i, gfc_expr * j ATTRIBUTE_UNUSED)
 void
 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);
 }
@@ -641,7 +770,6 @@ 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);
 }
@@ -651,7 +779,6 @@ void
 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);
 }
@@ -660,7 +787,6 @@ gfc_resolve_ibset (gfc_expr * f, gfc_expr * i,
 void
 gfc_resolve_ichar (gfc_expr * f, gfc_expr * c)
 {
-
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
 
@@ -676,9 +802,27 @@ gfc_resolve_idnint (gfc_expr * f, gfc_expr * a)
 
 
 void
-gfc_resolve_ieor (gfc_expr * f, gfc_expr * i,
-		  gfc_expr * j ATTRIBUTE_UNUSED)
+gfc_resolve_ierrno (gfc_expr * f)
 {
+  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);
+}
+
+
+void
+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 (i->ts.kind == gfc_kind_max (i,j))
+	gfc_convert_type(j, &i->ts, 2);
+      else
+	gfc_convert_type(i, &j->ts, 2);
+    }
 
   f->ts = i->ts;
   f->value.function.name = gfc_get_string ("__ieor_%d", i->ts.kind);
@@ -686,9 +830,18 @@ gfc_resolve_ieor (gfc_expr * f, gfc_expr * i,
 
 
 void
-gfc_resolve_ior (gfc_expr * f, gfc_expr * i,
-		 gfc_expr * j ATTRIBUTE_UNUSED)
+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 (i->ts.kind == gfc_kind_max (i,j))
+	gfc_convert_type(j, &i->ts, 2);
+      else
+	gfc_convert_type(i, &j->ts, 2);
+    }
 
   f->ts = i->ts;
   f->value.function.name = gfc_get_string ("__ior_%d", i->ts.kind);
@@ -698,7 +851,6 @@ gfc_resolve_ior (gfc_expr * f, gfc_expr * i,
 void
 gfc_resolve_int (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
 {
-
   f->ts.type = BT_INTEGER;
   f->ts.kind = (kind == NULL) ? gfc_default_integer_kind
     : mpz_get_si (kind->value.integer);
@@ -710,9 +862,28 @@ gfc_resolve_int (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
 
 
 void
-gfc_resolve_ishft (gfc_expr * f, gfc_expr * i, gfc_expr * shift)
+gfc_resolve_isatty (gfc_expr * f, gfc_expr * u)
 {
+  gfc_typespec ts;
+  
+  f->ts.type = BT_LOGICAL;
+  f->ts.kind = gfc_default_integer_kind;
+  if (u->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 (u, &ts, 2);
+    }
+
+  f->value.function.name = gfc_get_string (PREFIX("isatty_l%d"), f->ts.kind);
+}
+
 
+void
+gfc_resolve_ishft (gfc_expr * f, gfc_expr * i, gfc_expr * shift)
+{
   f->ts = i->ts;
   f->value.function.name =
     gfc_get_string ("__ishft_%d_%d", i->ts.kind, shift->ts.kind);
@@ -734,6 +905,17 @@ gfc_resolve_ishftc (gfc_expr * f, gfc_expr * i, gfc_expr * shift,
 
 
 void
+gfc_resolve_kill (gfc_expr * f, ATTRIBUTE_UNUSED gfc_expr * p,
+                  ATTRIBUTE_UNUSED gfc_expr * s)
+{
+  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);
+}
+
+
+void
 gfc_resolve_lbound (gfc_expr * f, gfc_expr * array,
 		    gfc_expr * dim)
 {
@@ -756,7 +938,6 @@ gfc_resolve_lbound (gfc_expr * f, gfc_expr * array,
 void
 gfc_resolve_len (gfc_expr * f, gfc_expr * string)
 {
-
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
   f->value.function.name = gfc_get_string ("__len_%d", string->ts.kind);
@@ -766,7 +947,6 @@ gfc_resolve_len (gfc_expr * f, gfc_expr * string)
 void
 gfc_resolve_len_trim (gfc_expr * f, gfc_expr * string)
 {
-
   f->ts.type = BT_INTEGER;
   f->ts.kind = gfc_default_integer_kind;
   f->value.function.name = gfc_get_string ("__len_trim%d", string->ts.kind);
@@ -774,9 +954,27 @@ gfc_resolve_len_trim (gfc_expr * f, gfc_expr * string)
 
 
 void
-gfc_resolve_log (gfc_expr * f, gfc_expr * x)
+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->value.function.name = gfc_get_string (PREFIX("link_i%d"), f->ts.kind);
+}
+
+
+void
+gfc_resolve_loc (gfc_expr *f, gfc_expr *x)
 {
+  f->ts.type= BT_INTEGER;
+  f->ts.kind = gfc_index_integer_kind;
+  f->value.function.name = gfc_get_string ("__loc_%d", x->ts.kind);
+}
 
+
+void
+gfc_resolve_log (gfc_expr * f, gfc_expr * x)
+{
   f->ts = x->ts;
   f->value.function.name =
     gfc_get_string ("__log_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
@@ -786,7 +984,6 @@ gfc_resolve_log (gfc_expr * f, gfc_expr * x)
 void
 gfc_resolve_log10 (gfc_expr * f, gfc_expr * x)
 {
-
   f->ts = x->ts;
   f->value.function.name =
     gfc_get_string ("__log10_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
@@ -796,7 +993,6 @@ gfc_resolve_log10 (gfc_expr * f, gfc_expr * x)
 void
 gfc_resolve_logical (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
 {
-
   f->ts.type = BT_LOGICAL;
   f->ts.kind = (kind == NULL) ? gfc_default_logical_kind
     : mpz_get_si (kind->value.integer);
@@ -809,6 +1005,24 @@ gfc_resolve_logical (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
 
 
 void
+gfc_resolve_malloc (gfc_expr * f, gfc_expr * size)
+{
+  if (size->ts.kind < gfc_index_integer_kind)
+    {
+      gfc_typespec ts;
+
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_index_integer_kind;
+      gfc_convert_type_warn (size, &ts, 2, 0);
+    }
+
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_index_integer_kind;
+  f->value.function.name = gfc_get_string (PREFIX("malloc"));
+}
+
+
+void
 gfc_resolve_matmul (gfc_expr * f, gfc_expr * a, gfc_expr * b)
 {
   gfc_expr temp;
@@ -822,9 +1036,9 @@ gfc_resolve_matmul (gfc_expr * f, gfc_expr * a, gfc_expr * b)
     {
       temp.expr_type = EXPR_OP;
       gfc_clear_ts (&temp.ts);
-      temp.operator = INTRINSIC_NONE;
-      temp.op1 = a;
-      temp.op2 = b;
+      temp.value.op.operator = INTRINSIC_NONE;
+      temp.value.op.op1 = a;
+      temp.value.op.op2 = b;
       gfc_type_convert_binary (&temp);
       f->ts = temp.ts;
     }
@@ -832,7 +1046,7 @@ gfc_resolve_matmul (gfc_expr * f, gfc_expr * a, gfc_expr * b)
   f->rank = (a->rank == 2 && b->rank == 2) ? 2 : 1;
 
   f->value.function.name =
-    gfc_get_string ("__matmul_%c%d", gfc_type_letter (f->ts.type),
+    gfc_get_string (PREFIX("matmul_%c%d"), gfc_type_letter (f->ts.type),
 		    f->ts.kind);
 }
 
@@ -884,12 +1098,12 @@ gfc_resolve_maxloc (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
   else
     {
       f->rank = array->rank - 1;
-      gfc_resolve_index (dim, 1);
+      gfc_resolve_dim_arg (dim);
     }
 
   name = mask ? "mmaxloc" : "maxloc";
   f->value.function.name =
-    gfc_get_string ("__%s%d_%d_%c%d", name, dim != NULL, f->ts.kind,
+    gfc_get_string (PREFIX("%s%d_%d_%c%d"), name, dim != NULL, f->ts.kind,
                     gfc_type_letter (array->ts.type), array->ts.kind);
 }
 
@@ -898,17 +1112,16 @@ void
 gfc_resolve_maxval (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
 		    gfc_expr * mask)
 {
-
   f->ts = array->ts;
 
   if (dim != NULL)
     {
       f->rank = array->rank - 1;
-      gfc_resolve_index (dim, 1);
+      gfc_resolve_dim_arg (dim);
     }
 
   f->value.function.name =
-    gfc_get_string ("__%s_%c%d", mask ? "mmaxval" : "maxval",
+    gfc_get_string (PREFIX("%s_%c%d"), mask ? "mmaxval" : "maxval",
 		    gfc_type_letter (array->ts.type), array->ts.kind);
 }
 
@@ -918,6 +1131,8 @@ 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;
   f->value.function.name =
@@ -947,12 +1162,12 @@ gfc_resolve_minloc (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
   else
     {
       f->rank = array->rank - 1;
-      gfc_resolve_index (dim, 1);
+      gfc_resolve_dim_arg (dim);
     }
 
   name = mask ? "mminloc" : "minloc";
   f->value.function.name =
-    gfc_get_string ("__%s%d_%d_%c%d", name, dim != NULL, f->ts.kind,
+    gfc_get_string (PREFIX("%s%d_%d_%c%d"), name, dim != NULL, f->ts.kind,
                     gfc_type_letter (array->ts.type), array->ts.kind);
 }
 
@@ -961,48 +1176,67 @@ void
 gfc_resolve_minval (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
 		    gfc_expr * mask)
 {
-
   f->ts = array->ts;
 
   if (dim != NULL)
     {
       f->rank = array->rank - 1;
-      gfc_resolve_index (dim, 1);
+      gfc_resolve_dim_arg (dim);
     }
 
   f->value.function.name =
-    gfc_get_string ("__%s_%c%d", mask ? "mminval" : "minval",
+    gfc_get_string (PREFIX("%s_%c%d"), mask ? "mminval" : "minval",
 		    gfc_type_letter (array->ts.type), array->ts.kind);
 }
 
 
 void
-gfc_resolve_mod (gfc_expr * f, gfc_expr * a,
-		 gfc_expr * p ATTRIBUTE_UNUSED)
+gfc_resolve_mod (gfc_expr * f, gfc_expr * a, gfc_expr * p)
 {
+  f->ts.type = a->ts.type;
+  if (p != NULL)
+    f->ts.kind = gfc_kind_max (a,p);
+  else
+    f->ts.kind = a->ts.kind;
+
+  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);
+      else
+	gfc_convert_type(a, &p->ts, 2);
+    }
 
-  f->ts = a->ts;
   f->value.function.name =
-    gfc_get_string ("__mod_%c%d", gfc_type_letter (a->ts.type), a->ts.kind);
+    gfc_get_string ("__mod_%c%d", gfc_type_letter (f->ts.type), f->ts.kind);
 }
 
 
 void
-gfc_resolve_modulo (gfc_expr * f, gfc_expr * a,
-		    gfc_expr * p ATTRIBUTE_UNUSED)
+gfc_resolve_modulo (gfc_expr * f, gfc_expr * a, gfc_expr * p)
 {
+  f->ts.type = a->ts.type;
+  if (p != NULL)
+    f->ts.kind = gfc_kind_max (a,p);
+  else
+    f->ts.kind = a->ts.kind;
+
+  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);
+      else
+	gfc_convert_type(a, &p->ts, 2);
+    }
 
-  f->ts = a->ts;
   f->value.function.name =
-    gfc_get_string ("__modulo_%c%d", gfc_type_letter (a->ts.type),
-		    a->ts.kind);
+    gfc_get_string ("__modulo_%c%d", gfc_type_letter (f->ts.type),
+		    f->ts.kind);
 }
 
 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->value.function.name =
     gfc_get_string ("__nearest_%c%d", gfc_type_letter (a->ts.type),
@@ -1012,7 +1246,6 @@ gfc_resolve_nearest (gfc_expr * f, gfc_expr * a,
 void
 gfc_resolve_nint (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
 {
-
   f->ts.type = BT_INTEGER;
   f->ts.kind = (kind == NULL) ? gfc_default_integer_kind
     : mpz_get_si (kind->value.integer);
@@ -1025,26 +1258,42 @@ gfc_resolve_nint (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
 void
 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);
 }
 
 
 void
-gfc_resolve_pack (gfc_expr * f,
-                  gfc_expr * array ATTRIBUTE_UNUSED,
-		  gfc_expr * mask,
-		  gfc_expr * vector ATTRIBUTE_UNUSED)
+gfc_resolve_or (gfc_expr * f, gfc_expr * i, gfc_expr * j)
 {
-  static char pack[] = "__pack",
-    pack_s[] = "__pack_s";
+  f->ts.type = i->ts.type;
+  f->ts.kind = gfc_kind_max (i,j);
+
+  if (i->ts.kind != j->ts.kind)
+    {
+      if (i->ts.kind == gfc_kind_max (i,j))
+	gfc_convert_type(j, &i->ts, 2);
+      else
+	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);
+}
+
 
+void
+gfc_resolve_pack (gfc_expr * f, gfc_expr * array, gfc_expr * mask,
+		  gfc_expr * vector ATTRIBUTE_UNUSED)
+{
   f->ts = array->ts;
   f->rank = 1;
 
   if (mask->rank != 0)
-    f->value.function.name = pack;
+    f->value.function.name = (array->ts.type == BT_CHARACTER
+			      ? PREFIX("pack_char")
+			      : PREFIX("pack"));
   else
     {
       /* We convert mask to default logical only in the scalar case.
@@ -1059,7 +1308,9 @@ gfc_resolve_pack (gfc_expr * f,
 	  gfc_convert_type (mask, &ts, 2);
 	}
 
-      f->value.function.name = pack_s;
+      f->value.function.name = (array->ts.type == BT_CHARACTER
+				? PREFIX("pack_s_char")
+				: PREFIX("pack_s"));
     }
 }
 
@@ -1068,17 +1319,16 @@ void
 gfc_resolve_product (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
 		     gfc_expr * mask)
 {
-
   f->ts = array->ts;
 
   if (dim != NULL)
     {
       f->rank = array->rank - 1;
-      gfc_resolve_index (dim, 1);
+      gfc_resolve_dim_arg (dim);
     }
 
   f->value.function.name =
-    gfc_get_string ("__%s_%c%d", mask ? "mproduct" : "product",
+    gfc_get_string (PREFIX("%s_%c%d"), mask ? "mproduct" : "product",
 		    gfc_type_letter (array->ts.type), array->ts.kind);
 }
 
@@ -1086,7 +1336,6 @@ gfc_resolve_product (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
 void
 gfc_resolve_real (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
 {
-
   f->ts.type = BT_REAL;
 
   if (kind != NULL)
@@ -1102,10 +1351,30 @@ gfc_resolve_real (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
 
 
 void
-gfc_resolve_repeat (gfc_expr * f, gfc_expr * string,
-		   gfc_expr * ncopies ATTRIBUTE_UNUSED)
+gfc_resolve_realpart (gfc_expr * f, gfc_expr * a)
 {
+  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);
+}
+
+
+void
+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->value.function.name = gfc_get_string (PREFIX("rename_i%d"), f->ts.kind);
+}
 
+
+void
+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->value.function.name = gfc_get_string ("__repeat_%d", string->ts.kind);
@@ -1117,7 +1386,6 @@ gfc_resolve_reshape (gfc_expr * f, gfc_expr * source, gfc_expr * shape,
 		     gfc_expr * pad ATTRIBUTE_UNUSED,
 		     gfc_expr * order ATTRIBUTE_UNUSED)
 {
-  static char reshape0[] = "__reshape";
   mpz_t rank;
   int kind;
   int i;
@@ -1148,13 +1416,22 @@ gfc_resolve_reshape (gfc_expr * f, gfc_expr * source, gfc_expr * shape,
     {
     case 4:
     case 8:
-    /* case 16: */
-      f->value.function.name =
-	gfc_get_string ("__reshape_%d", source->ts.kind);
+    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
+	f->value.function.name =
+	  gfc_get_string (PREFIX("reshape_%d"), source->ts.kind);
+
       break;
 
     default:
-      f->value.function.name = reshape0;
+      f->value.function.name = (source->ts.type == BT_CHARACTER
+				? PREFIX("reshape_char")
+				: PREFIX("reshape"));
       break;
     }
 
@@ -1189,7 +1466,6 @@ gfc_resolve_reshape (gfc_expr * f, gfc_expr * source, gfc_expr * shape,
 void
 gfc_resolve_rrspacing (gfc_expr * f, gfc_expr * x)
 {
-
   f->ts = x->ts;
   f->value.function.name = gfc_get_string ("__rrspacing_%d", x->ts.kind);
 }
@@ -1198,7 +1474,6 @@ gfc_resolve_rrspacing (gfc_expr * f, gfc_expr * x)
 void
 gfc_resolve_scale (gfc_expr * f, gfc_expr * x, gfc_expr * i)
 {
-
   f->ts = x->ts;
 
   /* The implementation calls scalbn which takes an int as the
@@ -1222,7 +1497,6 @@ 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->value.function.name = gfc_get_string ("__scan_%d", string->ts.kind);
@@ -1230,13 +1504,21 @@ gfc_resolve_scan (gfc_expr * f, gfc_expr * string,
 
 
 void
-gfc_resolve_set_exponent (gfc_expr * f, gfc_expr * x, gfc_expr * i)
+gfc_resolve_secnds (gfc_expr * t1, gfc_expr * t0)
 {
+  t1->ts = t0->ts;
+  t1->value.function.name =
+    gfc_get_string (PREFIX("secnds"));
+}
+
 
+void
+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 implment all possible
+     convert type so we don't have to implement all possible
      permutations.  */
   if (i->ts.kind != 4)
     {
@@ -1255,11 +1537,10 @@ gfc_resolve_set_exponent (gfc_expr * f, gfc_expr * x, gfc_expr * i)
 void
 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->value.function.name = gfc_get_string ("__shape_%d", f->ts.kind);
+  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);
 }
@@ -1268,7 +1549,6 @@ gfc_resolve_shape (gfc_expr * f, gfc_expr * array)
 void
 gfc_resolve_sign (gfc_expr * f, gfc_expr * a, gfc_expr * b ATTRIBUTE_UNUSED)
 {
-
   f->ts = a->ts;
   f->value.function.name =
     gfc_get_string ("__sign_%c%d", gfc_type_letter (a->ts.type), a->ts.kind);
@@ -1276,9 +1556,29 @@ gfc_resolve_sign (gfc_expr * f, gfc_expr * a, gfc_expr * b ATTRIBUTE_UNUSED)
 
 
 void
-gfc_resolve_sin (gfc_expr * f, gfc_expr * x)
+gfc_resolve_signal (gfc_expr * f, gfc_expr *number, gfc_expr *handler)
 {
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_c_int_kind;
+
+  /* handler can be either BT_INTEGER or BT_PROCEDURE  */
+  if (handler->ts.type == BT_INTEGER)
+    {
+      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"));
+    }
+  else
+    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);
+}
+
 
+void
+gfc_resolve_sin (gfc_expr * f, gfc_expr * x)
+{
   f->ts = x->ts;
   f->value.function.name =
     gfc_get_string ("__sin_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
@@ -1288,7 +1588,6 @@ gfc_resolve_sin (gfc_expr * f, gfc_expr * x)
 void
 gfc_resolve_sinh (gfc_expr * f, gfc_expr * x)
 {
-
   f->ts = x->ts;
   f->value.function.name =
     gfc_get_string ("__sinh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
@@ -1298,7 +1597,6 @@ gfc_resolve_sinh (gfc_expr * f, gfc_expr * x)
 void
 gfc_resolve_spacing (gfc_expr * f, gfc_expr * x)
 {
-
   f->ts = x->ts;
   f->value.function.name = gfc_get_string ("__spacing_%d", x->ts.kind);
 }
@@ -1309,13 +1607,21 @@ gfc_resolve_spread (gfc_expr * f, gfc_expr * source,
 		    gfc_expr * dim,
 		    gfc_expr * ncopies)
 {
-  static char spread[] = "__spread";
+  if (source->ts.type == BT_CHARACTER)
+    check_charlen_present (source);
 
   f->ts = source->ts;
   f->rank = source->rank + 1;
-  f->value.function.name = spread;
+  if (source->rank == 0)
+    f->value.function.name = (source->ts.type == BT_CHARACTER
+			      ? PREFIX("spread_char_scalar")
+			      : PREFIX("spread_scalar"));
+  else
+    f->value.function.name = (source->ts.type == BT_CHARACTER
+			      ? PREFIX("spread_char")
+			      : PREFIX("spread"));
 
-  gfc_resolve_index (dim, 1);
+  gfc_resolve_dim_arg (dim);
   gfc_resolve_index (ncopies, 1);
 }
 
@@ -1323,7 +1629,6 @@ gfc_resolve_spread (gfc_expr * f, gfc_expr * source,
 void
 gfc_resolve_sqrt (gfc_expr * f, gfc_expr * x)
 {
-
   f->ts = x->ts;
   f->value.function.name =
     gfc_get_string ("__sqrt_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
@@ -1336,7 +1641,6 @@ void
 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);
@@ -1346,7 +1650,6 @@ gfc_resolve_stat (gfc_expr * f, gfc_expr * n ATTRIBUTE_UNUSED,
 void
 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)
@@ -1357,24 +1660,111 @@ gfc_resolve_fstat (gfc_expr * f, gfc_expr * n, gfc_expr * a ATTRIBUTE_UNUSED)
 
 
 void
+gfc_resolve_fgetc (gfc_expr * f, gfc_expr * u, gfc_expr * c ATTRIBUTE_UNUSED)
+{
+  gfc_typespec ts;
+
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_c_int_kind;
+  if (u->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 (u, &ts, 2);
+    }
+
+  f->value.function.name = gfc_get_string (PREFIX("fgetc"));
+}
+
+
+void
+gfc_resolve_fget (gfc_expr * f, gfc_expr * c ATTRIBUTE_UNUSED)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_c_int_kind;
+  f->value.function.name = gfc_get_string (PREFIX("fget"));
+}
+
+
+void
+gfc_resolve_fputc (gfc_expr * f, gfc_expr * u, gfc_expr * c ATTRIBUTE_UNUSED)
+{
+  gfc_typespec ts;
+
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_c_int_kind;
+  if (u->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 (u, &ts, 2);
+    }
+
+  f->value.function.name = gfc_get_string (PREFIX("fputc"));
+}
+
+
+void
+gfc_resolve_fput (gfc_expr * f, gfc_expr * c ATTRIBUTE_UNUSED)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_c_int_kind;
+  f->value.function.name = gfc_get_string (PREFIX("fput"));
+}
+
+
+void
+gfc_resolve_ftell (gfc_expr * f, gfc_expr * u)
+{
+  gfc_typespec ts;
+
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_index_integer_kind;
+  if (u->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 (u, &ts, 2);
+    }
+
+  f->value.function.name = gfc_get_string (PREFIX("ftell"));
+}
+
+
+void
 gfc_resolve_sum (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
 		 gfc_expr * mask)
 {
-
   f->ts = array->ts;
 
   if (dim != NULL)
     {
       f->rank = array->rank - 1;
-      gfc_resolve_index (dim, 1);
+      gfc_resolve_dim_arg (dim);
     }
 
   f->value.function.name =
-    gfc_get_string ("__%s_%c%d", mask ? "msum" : "sum",
+    gfc_get_string (PREFIX("%s_%c%d"), mask ? "msum" : "sum",
 		    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)
+{
+  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);
+}
+
+
 /* Resolve the g77 compatibility function SYSTEM.  */
 
 void
@@ -1389,7 +1779,6 @@ gfc_resolve_system (gfc_expr * f, gfc_expr * n ATTRIBUTE_UNUSED)
 void
 gfc_resolve_tan (gfc_expr * f, gfc_expr * x)
 {
-
   f->ts = x->ts;
   f->value.function.name =
     gfc_get_string ("__tan_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
@@ -1399,7 +1788,6 @@ gfc_resolve_tan (gfc_expr * f, gfc_expr * x)
 void
 gfc_resolve_tanh (gfc_expr * f, gfc_expr * x)
 {
-
   f->ts = x->ts;
   f->value.function.name =
     gfc_get_string ("__tanh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
@@ -1407,6 +1795,24 @@ gfc_resolve_tanh (gfc_expr * f, gfc_expr * x)
 
 
 void
+gfc_resolve_time (gfc_expr * f)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 4;
+  f->value.function.name = gfc_get_string (PREFIX("time_func"));
+}
+
+
+void
+gfc_resolve_time8 (gfc_expr * f)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 8;
+  f->value.function.name = gfc_get_string (PREFIX("time8_func"));
+}
+
+
+void
 gfc_resolve_transfer (gfc_expr * f, gfc_expr * source ATTRIBUTE_UNUSED,
 		      gfc_expr * mold, gfc_expr * size)
 {
@@ -1431,7 +1837,6 @@ gfc_resolve_transfer (gfc_expr * f, gfc_expr * source ATTRIBUTE_UNUSED,
 void
 gfc_resolve_transpose (gfc_expr * f, gfc_expr * matrix)
 {
-  static char transpose0[] = "__transpose";
   int kind;
 
   f->ts = matrix->ts;
@@ -1443,35 +1848,41 @@ gfc_resolve_transpose (gfc_expr * f, gfc_expr * matrix)
       mpz_init_set (f->shape[1], matrix->shape[0]);
     }
 
-  switch (matrix->ts.type)
-    {
-    case BT_COMPLEX:
-      kind = matrix->ts.kind * 2;
-      break;
-
-    case BT_REAL:
-    case BT_INTEGER:
-    case BT_LOGICAL:
-      kind = matrix->ts.kind;
-      break;
-
-    default:
-      kind = 0;
-      break;
-
-    }
+  kind = matrix->ts.kind;
 
   switch (kind)
     {
     case 4:
     case 8:
-    /* case 16: */
-      f->value.function.name =
-        gfc_get_string ("__transpose_%d", kind);
+    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_INTEGER:
+        case BT_REAL:
+        case BT_LOGICAL:
+	  /* 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;
+        }
       break;
 
     default:
-      f->value.function.name = transpose0;
+      f->value.function.name = (matrix->ts.type == BT_CHARACTER
+				? PREFIX("transpose_char")
+				: PREFIX("transpose"));
+      break;
     }
 }
 
@@ -1479,7 +1890,6 @@ gfc_resolve_transpose (gfc_expr * f, gfc_expr * matrix)
 void
 gfc_resolve_trim (gfc_expr * f, gfc_expr * string)
 {
-
   f->ts.type = BT_CHARACTER;
   f->ts.kind = string->ts.kind;
   f->value.function.name = gfc_get_string ("__trim_%d", string->ts.kind);
@@ -1511,7 +1921,6 @@ gfc_resolve_ubound (gfc_expr * f, gfc_expr * array,
 void
 gfc_resolve_umask (gfc_expr * f, gfc_expr * n)
 {
-
   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);
@@ -1523,23 +1932,43 @@ gfc_resolve_umask (gfc_expr * f, gfc_expr * n)
 void
 gfc_resolve_unlink (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("unlink"));
 }
 
+
+void
+gfc_resolve_ttynam (gfc_expr * f, gfc_expr * unit)
+{
+  gfc_typespec ts;
+  
+  f->ts.type = BT_CHARACTER;
+  f->ts.kind = gfc_default_character_kind;
+
+  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);
+    }
+
+  f->value.function.name = gfc_get_string (PREFIX("ttynam"));
+}
+
+
 void
 gfc_resolve_unpack (gfc_expr * f, gfc_expr * vector, gfc_expr * mask,
 		    gfc_expr * field ATTRIBUTE_UNUSED)
 {
-
-  f->ts.type = vector->ts.type;
-  f->ts.kind = vector->ts.kind;
+  f->ts = vector->ts;
   f->rank = mask->rank;
 
   f->value.function.name =
-    gfc_get_string ("__unpack%d", field->rank > 0 ? 1 : 0);
+    gfc_get_string (PREFIX("unpack%d%s"), field->rank > 0 ? 1 : 0,
+		    vector->ts.type == BT_CHARACTER ? "_char" : "");
 }
 
 
@@ -1548,16 +1977,66 @@ 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->value.function.name = gfc_get_string ("__verify_%d", string->ts.kind);
 }
 
 
+void
+gfc_resolve_xor (gfc_expr * f, gfc_expr * i, gfc_expr * j)
+{
+  f->ts.type = i->ts.type;
+  f->ts.kind = gfc_kind_max (i,j);
+
+  if (i->ts.kind != j->ts.kind)
+    {
+      if (i->ts.kind == gfc_kind_max (i,j))
+	gfc_convert_type(j, &i->ts, 2);
+      else
+	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);
+}
+
+
 /* Intrinsic subroutine resolution.  */
 
 void
+gfc_resolve_alarm_sub (gfc_code * c)
+{
+  const char *name;
+  gfc_expr *seconds, *handler, *status;
+  gfc_typespec ts;
+
+  seconds = c->ext.actual->expr;
+  handler = c->ext.actual->next->expr;
+  status = c->ext.actual->next->next->expr;
+  ts.type = BT_INTEGER;
+  ts.kind = gfc_c_int_kind;
+
+  /* handler can be either BT_INTEGER or BT_PROCEDURE  */
+  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"));
+    }
+  else
+    name = gfc_get_string (PREFIX("alarm_sub"));
+
+  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
 gfc_resolve_cpu_time (gfc_code * c ATTRIBUTE_UNUSED)
 {
   const char *name;
@@ -1597,6 +2076,70 @@ gfc_resolve_random_number (gfc_code * c ATTRIBUTE_UNUSED)
 }
 
 
+void
+gfc_resolve_rename_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("rename_i%d_sub"), kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_kill_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("kill_i%d_sub"), kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+    
+
+void
+gfc_resolve_link_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("link_i%d_sub"), kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_symlnk_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("symlnk_i%d_sub"), kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
 /* G77 compatibility subroutines etime() and dtime().  */
 
 void
@@ -1621,6 +2164,22 @@ gfc_resolve_second_sub (gfc_code * c)
 }
 
 
+void
+gfc_resolve_sleep_sub (gfc_code * c)
+{
+  const char *name;
+  int kind;
+
+  if (c->ext.actual->expr != NULL)
+    kind = c->ext.actual->expr->ts.kind;
+  else
+    kind = gfc_default_integer_kind;
+
+  name = gfc_get_string (PREFIX("sleep_i%d_sub"), kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
 /* G77 compatibility function srand().  */
 
 void
@@ -1703,6 +2262,37 @@ gfc_resolve_get_environment_variable (gfc_code * code)
   code->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
+void
+gfc_resolve_signal_sub (gfc_code * c)
+{
+  const char *name;
+  gfc_expr *number, *handler, *status;
+  gfc_typespec ts;
+
+  number = c->ext.actual->expr;
+  handler = c->ext.actual->next->expr;
+  status = c->ext.actual->next->next->expr;
+  ts.type = BT_INTEGER;
+  ts.kind = gfc_c_int_kind;
+
+  /* handler can be either BT_INTEGER or BT_PROCEDURE  */
+  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("signal_sub_int"));
+    }
+  else
+    name = gfc_get_string (PREFIX("signal_sub"));
+
+  if (number->ts.kind != gfc_c_int_kind)
+    gfc_convert_type (number, &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);
+}
+
 /* Resolve the SYSTEM intrinsic subroutine.  */
 
 void
@@ -1772,6 +2362,85 @@ gfc_resolve_flush (gfc_code * c)
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
+
+void
+gfc_resolve_free (gfc_code * c)
+{
+  gfc_typespec ts;
+  gfc_expr *n;
+
+  ts.type = BT_INTEGER;
+  ts.kind = gfc_index_integer_kind;
+  n = c->ext.actual->expr;
+  if (n->ts.kind != ts.kind)
+    gfc_convert_type (n, &ts, 2);
+
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX("free"));
+}
+
+
+void
+gfc_resolve_ctime_sub (gfc_code * c)
+{
+  gfc_typespec ts;
+  
+  /* ctime TIME argument is a INTEGER(KIND=8), says the doc */
+  if (c->ext.actual->expr->ts.kind != 8)
+    {
+      ts.type = BT_INTEGER;
+      ts.kind = 8;
+      ts.derived = NULL;
+      ts.cl = NULL;
+      gfc_convert_type (c->ext.actual->expr, &ts, 2);
+    }
+
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX("ctime_sub"));
+}
+
+
+void
+gfc_resolve_fdate_sub (gfc_code * c)
+{
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("fdate_sub"));
+}
+
+
+void
+gfc_resolve_gerror (gfc_code * c)
+{
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("gerror"));
+}
+
+
+void
+gfc_resolve_getlog (gfc_code * c)
+{
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("getlog"));
+}
+
+
+void
+gfc_resolve_hostnm_sub (gfc_code * c)
+{
+  const char *name;
+  int kind;
+
+  if (c->ext.actual->next->expr != NULL)
+    kind = c->ext.actual->next->expr->ts.kind;
+  else
+    kind = gfc_default_integer_kind;
+
+  name = gfc_get_string (PREFIX("hostnm_i%d_sub"), kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_perror (gfc_code * c)
+{
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("perror_sub"));
+}
+
 /* Resolve the STAT and FSTAT intrinsic subroutines.  */
 
 void
@@ -1799,6 +2468,138 @@ gfc_resolve_fstat_sub (gfc_code * c)
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
+
+void
+gfc_resolve_fgetc_sub (gfc_code * c)
+{
+  const char *name;
+  gfc_typespec ts;
+  gfc_expr *u, *st;
+
+  u = c->ext.actual->expr;
+  st = c->ext.actual->next->next->expr;
+
+  if (u->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 (u, &ts, 2);
+    }
+
+  if (st != NULL)
+    name = gfc_get_string (PREFIX("fgetc_i%d_sub"), st->ts.kind);
+  else
+    name = gfc_get_string (PREFIX("fgetc_i%d_sub"), gfc_default_integer_kind);
+
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_fget_sub (gfc_code * c)
+{
+  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);
+  else
+    name = gfc_get_string (PREFIX("fget_i%d_sub"), gfc_default_integer_kind);
+
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_fputc_sub (gfc_code * c)
+{
+  const char *name;
+  gfc_typespec ts;
+  gfc_expr *u, *st;
+
+  u = c->ext.actual->expr;
+  st = c->ext.actual->next->next->expr;
+
+  if (u->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 (u, &ts, 2);
+    }
+
+  if (st != NULL)
+    name = gfc_get_string (PREFIX("fputc_i%d_sub"), st->ts.kind);
+  else
+    name = gfc_get_string (PREFIX("fputc_i%d_sub"), gfc_default_integer_kind);
+
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_fput_sub (gfc_code * c)
+{
+  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);
+  else
+    name = gfc_get_string (PREFIX("fput_i%d_sub"), gfc_default_integer_kind);
+
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_ftell_sub (gfc_code * c)
+{
+  const char *name;
+  gfc_expr *unit;
+  gfc_expr *offset;
+  gfc_typespec ts;
+
+  unit = c->ext.actual->expr;
+  offset = c->ext.actual->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);
+    }
+
+  name = gfc_get_string (PREFIX("ftell_i%d_sub"), offset->ts.kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_ttynam_sub (gfc_code * c)
+{
+  gfc_typespec ts;
+  
+  if (c->ext.actual->expr->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 (c->ext.actual->expr, &ts, 2);
+    }
+
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX("ttynam_sub"));
+}
+
+
 /* Resolve the UMASK intrinsic subroutine.  */
 
 void
@@ -1832,21 +2633,3 @@ gfc_resolve_unlink_sub (gfc_code * c)
   name = gfc_get_string (PREFIX("unlink_i%d_sub"), kind);
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
-
-
-void
-gfc_iresolve_init_1 (void)
-{
-  int i;
-
-  for (i = 0; i < HASH_SIZE; i++)
-    string_head[i] = NULL;
-}
-
-
-void
-gfc_iresolve_done_1 (void)
-{
-
-  free_strings ();
-}