gfortran.h (gfc_expr.function.name): Make const.

* gfortran.h (gfc_expr.function.name): Make const.
        (gfc_iresolve_init_1, gfc_iresolve_done_1): Remove.
        (gfc_get_string): Update prototype.
        * iresolve.c: Include tree.h.
        (string_node, HASH_SIZE, string_head, hash): Remove.
        (gfc_get_string): Use vsnprintf, get_identifier.
        (free_strings, gfc_iresolve_init_1, gfc_iresolve_done_1): Remove.
        * misc.c (gfc_init_1): Don't call gfc_iresolve_init_1.
        (gfc_done_1): Don't call gfc_iresolve_done_1.
        * module.c (mio_allocated_string): Take and return const char *,
        instead of modifying char**.
        (mio_expr): Update to match.
        * resolve.c (pure_function): Constify name argument.
        (resolve_function): Constify name.
        * trans-intrinsic.c (gfc_conv_intrinsic_function): Likewise.

From-SVN: r92176

gcc/fortran/ChangeLog

@@ -1,3 +1,21 @@
+2004-12-14  Richard Henderson  <rth@redhat.com>
+
+	* gfortran.h (gfc_expr.function.name): Make const.
+	(gfc_iresolve_init_1, gfc_iresolve_done_1): Remove.
+	(gfc_get_string): Update prototype.
+	* iresolve.c: Include tree.h.
+	(string_node, HASH_SIZE, string_head, hash): Remove.
+	(gfc_get_string): Use vsnprintf, get_identifier.
+	(free_strings, gfc_iresolve_init_1, gfc_iresolve_done_1): Remove.
+	* misc.c (gfc_init_1): Don't call gfc_iresolve_init_1.
+	(gfc_done_1): Don't call gfc_iresolve_done_1.
+	* module.c (mio_allocated_string): Take and return const char *,
+	instead of modifying char**.
+	(mio_expr): Update to match.
+	* resolve.c (pure_function): Constify name argument.
+	(resolve_function): Constify name.
+	* trans-intrinsic.c (gfc_conv_intrinsic_function): Likewise.
+
 2004-12-12  Richard Henderson  <rth@redhat.com>
 
 	* iresolve.c (gfc_resolve_all, gfc_resolve_any, gfc_resolve_count,

gcc/fortran/gfortran.h

@@ -1075,7 +1075,7 @@ typedef struct gfc_expr
     struct
     {
       gfc_actual_arglist *actual;
-      char *name;	/* Points to the ultimate name of the function */
+      const char *name;	/* Points to the ultimate name of the function */
       gfc_intrinsic_sym *isym;
       gfc_symbol *esym;
     }
@@ -1509,9 +1509,7 @@ int gfc_handle_option (size_t, const char *, int);
 bool gfc_post_options (const char **);
 
 /* iresolve.c */
-char * gfc_get_string (const char *, ...) ATTRIBUTE_PRINTF_1;
+const char * gfc_get_string (const char *, ...) ATTRIBUTE_PRINTF_1;
-void gfc_iresolve_init_1 (void);
-void gfc_iresolve_done_1 (void);
 
 /* error.c */
 

gcc/fortran/iresolve.c

@@ -29,97 +29,36 @@ Software Foundation, 59 Temple Place - Suite 330, Boston, MA
    are generally set according to the function arguments.  */
 
 #include "config.h"
-#include <string.h>
+#include "system.h"
-#include <stdarg.h>
+#include "coretypes.h"
-
+#include "tree.h"
 #include "gfortran.h"
 #include "intrinsic.h"
 
 
-/* String pool subroutines.  This are used to provide static locations
+/* Given printf-like arguments, return a stable version of the result string. 
-   for the string constants that represent library function names.  */
 
-typedef struct string_node
+   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, 
-  struct string_node *next;
+   since if the function name makes it to the gimple output of the frontend,
-  char string[1];
+   we'll have to create the identifier anyway.  */
-}
-string_node;
 
-#define HASH_SIZE 13
+const char *
-
-static string_node *string_head[HASH_SIZE];
-
-
-/* Return a hash code based on the name.  */
-
-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;
-}
-
-
-/* Given printf-like arguments, return a static address of the
-   resulting string.  If the name is not in the table, it is added.  */
-
-char *
 gfc_get_string (const char *format, ...)
 {
-  char temp_name[50];
+  char temp_name[128];
-  string_node *p;
   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);
+  ident = get_identifier (temp_name);
-
+  return IDENTIFIER_POINTER (ident);
-  /* 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;
 }
 
-
-
-static void
-free_strings (void)
-{
-  string_node *p, *q;
-  int h;
-
-  for (h = 0; h < HASH_SIZE; h++)
-    {
-      for (p = string_head[h]; p; p = q)
-	{
-	  q = p->next;
-	  gfc_free (p);
-	}
-    }
-}
-
-
 /********************** Resolution functions **********************/
 
 
@@ -1785,20 +1724,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 ();
-}

gcc/fortran/misc.c

@@ -278,12 +278,10 @@ gfc_intent_string (sym_intent i)
 void
 gfc_init_1 (void)
 {
-
   gfc_error_init_1 ();
   gfc_scanner_init_1 ();
   gfc_arith_init_1 ();
   gfc_intrinsic_init_1 ();
-  gfc_iresolve_init_1 ();
   gfc_simplify_init_1 ();
 }
 
@@ -306,10 +304,8 @@ gfc_init_2 (void)
 void
 gfc_done_1 (void)
 {
-
   gfc_scanner_done_1 ();
   gfc_intrinsic_done_1 ();
-  gfc_iresolve_done_1 ();
   gfc_arith_done_1 ();
 }
 

gcc/fortran/module.c

@@ -1330,16 +1330,18 @@ mio_integer (int *ip)
 /* Read or write a character pointer that points to a string on the
    heap.  */
 
-static void
+static const char *
-mio_allocated_string (char **sp)
+mio_allocated_string (const char *s)
 {
-
   if (iomode == IO_OUTPUT)
-    write_atom (ATOM_STRING, *sp);
+    {
+      write_atom (ATOM_STRING, s);
+      return s;
+    }
   else
     {
       require_atom (ATOM_STRING);
-      *sp = atom_string;
+      return atom_string;
     }
 }
 
@@ -2449,7 +2451,8 @@ mio_expr (gfc_expr ** ep)
 
       if (iomode == IO_OUTPUT)
 	{
-	  mio_allocated_string (&e->value.function.name);
+	  e->value.function.name
+	    = mio_allocated_string (e->value.function.name);
 	  flag = e->value.function.esym != NULL;
 	  mio_integer (&flag);
 	  if (flag)
@@ -2483,7 +2486,8 @@ mio_expr (gfc_expr ** ep)
       break;
 
     case EXPR_SUBSTRING:
-      mio_allocated_string (&e->value.character.string);
+      e->value.character.string = (char *)
+	mio_allocated_string (e->value.character.string);
       mio_expr (&e->op1);
       mio_expr (&e->op2);
       break;
@@ -2518,7 +2522,8 @@ mio_expr (gfc_expr ** ep)
 
 	case BT_CHARACTER:
 	  mio_integer (&e->value.character.length);
-	  mio_allocated_string (&e->value.character.string);
+	  e->value.character.string = (char *)
+	    mio_allocated_string (e->value.character.string);
 	  break;
 
 	default:

gcc/fortran/resolve.c

@@ -901,7 +901,7 @@ set_type:
    function is PURE, zero if not.  */
 
 static int
-pure_function (gfc_expr * e, char **name)
+pure_function (gfc_expr * e, const char **name)
 {
   int pure;
 
@@ -936,7 +936,7 @@ static try
 resolve_function (gfc_expr * expr)
 {
   gfc_actual_arglist *arg;
-  char *name;
+  const char *name;
   try t;
 
   if (resolve_actual_arglist (expr->value.function.actual) == FAILURE)

gcc/fortran/trans-intrinsic.c

@@ -2663,7 +2663,7 @@ void
 gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
 {
   gfc_intrinsic_sym *isym;
-  char *name;
+  const char *name;
   int lib;
 
   isym = expr->value.function.isym;