fix libgfortran export prefixes
Richard Henderson
rth@redhat.com
Wed Dec 15 04:12:00 GMT 2004
On Tue, Dec 14, 2004 at 04:43:40PM +0100, Tobias Schlüter wrote:
> ../../gcc-clean/gcc/fortran/iresolve.c:1027: warning: assignment discards
> qualifiers from pointer target type
Fixed thus.
r~
* 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.
Index: gfortran.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/gfortran.h,v
retrieving revision 1.46
diff -u -p -r1.46 gfortran.h
--- gfortran.h 12 Dec 2004 20:27:00 -0000 1.46
+++ gfortran.h 15 Dec 2004 03:50:24 -0000
@@ -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 cha
bool gfc_post_options (const char **);
/* iresolve.c */
-char * gfc_get_string (const char *, ...) ATTRIBUTE_PRINTF_1;
-void gfc_iresolve_init_1 (void);
-void gfc_iresolve_done_1 (void);
+const char * gfc_get_string (const char *, ...) ATTRIBUTE_PRINTF_1;
/* error.c */
Index: iresolve.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/iresolve.c,v
retrieving revision 1.27
diff -u -p -r1.27 iresolve.c
--- iresolve.c 13 Dec 2004 02:47:55 -0000 1.27
+++ iresolve.c 15 Dec 2004 03:50:24 -0000
@@ -29,97 +29,36 @@ Software Foundation, 59 Temple Place - S
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. */
-
-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 stable version of the result string.
-/* Given printf-like arguments, return a static address of the
- resulting string. If the name is not in the table, it is added. */
+ 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. */
-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);
}
-
-
-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 ();
-}
Index: misc.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/misc.c,v
retrieving revision 1.5
diff -u -p -r1.5 misc.c
--- misc.c 16 Sep 2004 16:00:42 -0000 1.5
+++ misc.c 15 Dec 2004 03:50:24 -0000
@@ -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 ();
}
Index: module.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/module.c,v
retrieving revision 1.21
diff -u -p -r1.21 module.c
--- module.c 8 Nov 2004 14:56:39 -0000 1.21
+++ module.c 15 Dec 2004 03:50:24 -0000
@@ -1330,16 +1330,18 @@ mio_integer (int *ip)
/* Read or write a character pointer that points to a string on the
heap. */
-static void
-mio_allocated_string (char **sp)
+static const char *
+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:
Index: resolve.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/resolve.c,v
retrieving revision 1.23
diff -u -p -r1.23 resolve.c
--- resolve.c 12 Dec 2004 20:27:00 -0000 1.23
+++ resolve.c 15 Dec 2004 03:50:24 -0000
@@ -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)
Index: trans-intrinsic.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-intrinsic.c,v
retrieving revision 1.32
diff -u -p -r1.32 trans-intrinsic.c
--- trans-intrinsic.c 2 Dec 2004 04:10:24 -0000 1.32
+++ trans-intrinsic.c 15 Dec 2004 03:50:25 -0000
@@ -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;
More information about the Fortran
mailing list