Hi,
On Wed, 20 Jul 2005, Steven Bosscher wrote:
> On Wednesday 20 July 2005 17:22, Paul Brook wrote:
> > To implement (b) this needs to be changed to:
> >
> > - Do everything up until gfc_generate{,_module}_code as normal.
> > - Save the results somewhere and repeat for each PU.
> > - Identify calls for procedures for which we have definitions, and link
> > them together somehow. It 's probably worth maintaining some sort of global
> > symbol table and building these associations incrementally during
> > resolution.
>
> This is what I was working on, but I never finished it. I encountered
> some memory corruption issues (procedure names disappearing underneath
> me) that I never found time for to investigate.
>
> I've appended the last incarnation of my hack that I could find in my
> local mail archive. This was supposed to help implement the first two
> points of (b). Actually linking things together is something I never
> got to do.
And I had once written a hack to make whole-program mode work with
gfortran (which in the end worked well enough for the fortran programs in
SPEC2k). Its purpose is the merging of decls, so that a real call graph
can be generated. As I know not much of Fortran the actual inlining
enabled by this might generate wrong code in cases like Paul mentioned.
If so, then at least spec2k does not contain such ;-) The patch is below,
perhaps it's of use for anyone. It's against an old version of the
tree-profiling branch.
Ciao,
Michael.
--
diff -urp -x CVS -x '*.orig' gcc.jh/gcc/fortran/f95-lang.c
gcc/gcc/fortran/f95-lang.c
--- gcc.jh/gcc/fortran/f95-lang.c 2005-03-12 21:30:09.000000000 +0100
+++ gcc/gcc/fortran/f95-lang.c 2005-03-14 11:50:08.000000000 +0100
@@ -534,6 +534,22 @@ pushdecl_top_level (tree x)
return t;
}
+tree find_fndecl (tree name);
+tree
+find_fndecl (tree name)
+{
+ struct binding_level *b = current_binding_level;
+ while (b)
+ {
+ tree t;
+ for (t = b->names; t; t = TREE_CHAIN (t))
+ if (TREE_CODE (t) == FUNCTION_DECL
+ && DECL_NAME (t) == name)
+ return t;
+ b = b->level_chain;
+ }
+ return NULL_TREE;
+}
/* Clear the binding stack. */
static void
diff -urp -x CVS -x '*.orig' gcc.jh/gcc/fortran/trans.c gcc/gcc/fortran/trans.c
--- gcc.jh/gcc/fortran/trans.c 2005-03-12 21:30:09.000000000 +0100
+++ gcc/gcc/fortran/trans.c 2005-03-14 11:50:10.000000000 +0100
@@ -658,6 +658,8 @@ gfc_generate_code (gfc_namespace * ns)
/* Main program subroutine. */
if (!ns->proc_name)
{
+ /* Let backend know that this is the main entry point to the program. */
+ main_identifier_node = get_identifier ("MAIN__");
/* Lots of things get upset if a subroutine doesn't have a symbol, so we
make one now. Hopefully we've set all the required fields. */
gfc_get_symbol ("MAIN__", ns, &main_program);
diff -urp -x CVS -x '*.orig' gcc.jh/gcc/fortran/trans-decl.c
gcc/gcc/fortran/trans-decl.c
--- gcc.jh/gcc/fortran/trans-decl.c 2005-03-12 21:30:09.000000000 +0100
+++ gcc/gcc/fortran/trans-decl.c 2005-03-14 11:50:09.000000000 +0100
@@ -45,6 +45,7 @@ Software Foundation, 59 Temple Place - S
#define MAX_LABEL_VALUE 99999
+extern tree find_fndecl (tree);
/* Holds the result of the function if no result variable specified. */
@@ -917,54 +918,58 @@ gfc_get_extern_function_decl (gfc_symbol
mangled_name = gfc_sym_mangled_function_id (sym);
}
- type = gfc_get_function_type (sym);
- fndecl = build_decl (FUNCTION_DECL, name, type);
+ fndecl = find_fndecl (name);
+ if (!fndecl || TREE_CODE (fndecl) != FUNCTION_DECL)
+ {
+ type = gfc_get_function_type (sym);
+ fndecl = build_decl (FUNCTION_DECL, name, type);
- SET_DECL_ASSEMBLER_NAME (fndecl, mangled_name);
- /* If the return type is a pointer, avoid alias issues by setting
- DECL_IS_MALLOC to nonzero. This means that the function should be
- treated as if it were a malloc, meaning it returns a pointer that
- is not an alias. */
- if (POINTER_TYPE_P (type))
- DECL_IS_MALLOC (fndecl) = 1;
+ SET_DECL_ASSEMBLER_NAME (fndecl, mangled_name);
+ /* If the return type is a pointer, avoid alias issues by setting
+ DECL_IS_MALLOC to nonzero. This means that the function should be
+ treated as if it were a malloc, meaning it returns a pointer that
+ is not an alias. */
+ if (POINTER_TYPE_P (type))
+ DECL_IS_MALLOC (fndecl) = 1;
- /* Set the context of this decl. */
- if (0 && sym->ns && sym->ns->proc_name)
- {
- /* TODO: Add external decls to the appropriate scope. */
- DECL_CONTEXT (fndecl) = sym->ns->proc_name->backend_decl;
- }
- else
- {
- /* Global declaration, e.g. intrinsic subroutine. */
- DECL_CONTEXT (fndecl) = NULL_TREE;
- }
+ /* Set the context of this decl. */
+ if (0 && sym->ns && sym->ns->proc_name)
+ {
+ /* TODO: Add external decls to the appropriate scope. */
+ DECL_CONTEXT (fndecl) = sym->ns->proc_name->backend_decl;
+ }
+ else
+ {
+ /* Global declaration, e.g. intrinsic subroutine. */
+ DECL_CONTEXT (fndecl) = NULL_TREE;
+ }
- DECL_EXTERNAL (fndecl) = 1;
+ DECL_EXTERNAL (fndecl) = 1;
- /* This specifies if a function is globally addressable, i.e. it is
- the opposite of declaring static in C. */
- TREE_PUBLIC (fndecl) = 1;
+ /* This specifies if a function is globally addressable, i.e. it is
+ the opposite of declaring static in C. */
+ TREE_PUBLIC (fndecl) = 1;
- /* Set attributes for PURE functions. A call to PURE function in the
- Fortran 95 sense is both pure and without side effects in the C
- sense. */
- if (sym->attr.pure || sym->attr.elemental)
- {
- if (sym->attr.function)
- DECL_IS_PURE (fndecl) = 1;
- /* TODO: check if pure SUBROUTINEs don't have INTENT(OUT)
- parameters and don't use alternate returns (is this
- allowed?). In that case, calls to them are meaningless, and
- can be optimized away. See also in build_function_decl(). */
- TREE_SIDE_EFFECTS (fndecl) = 0;
+ /* Set attributes for PURE functions. A call to PURE function in the
+ Fortran 95 sense is both pure and without side effects in the C
+ sense. */
+ if (sym->attr.pure || sym->attr.elemental)
+ {
+ if (sym->attr.function)
+ DECL_IS_PURE (fndecl) = 1;
+ /* TODO: check if pure SUBROUTINEs don't have INTENT(OUT)
+ parameters and don't use alternate returns (is this
+ allowed?). In that case, calls to them are meaningless, and
+ can be optimized away. See also in build_function_decl(). */
+ TREE_SIDE_EFFECTS (fndecl) = 0;
+ }
+
+ if (DECL_CONTEXT (fndecl) == NULL_TREE)
+ pushdecl_top_level (fndecl);
}
sym->backend_decl = fndecl;
- if (DECL_CONTEXT (fndecl) == NULL_TREE)
- pushdecl_top_level (fndecl);
-
return fndecl;
}
@@ -979,6 +984,7 @@ build_function_decl (gfc_symbol * sym)
tree fndecl, type;
symbol_attribute attr;
tree result_decl;
+ tree name;
gfc_formal_arglist *f;
gcc_assert (!sym->backend_decl);
@@ -992,8 +998,24 @@ build_function_decl (gfc_symbol * sym)
gcc_assert (current_function_decl == NULL_TREE
|| DECL_CONTEXT (current_function_decl) == NULL_TREE);
- type = gfc_get_function_type (sym);
- fndecl = build_decl (FUNCTION_DECL, gfc_sym_identifier (sym), type);
+ name = gfc_sym_identifier (sym);
+ fndecl = find_fndecl (name);
+ if (fndecl)
+ {
+ /* type = TREE_TYPE (fndecl); */
+ /* XXX hack to insert the correct type, which is known only
+ with the declaration, not with calls. */
+ type = gfc_get_function_type (sym);
+ TREE_TYPE (fndecl) = type;
+ }
+ else
+ {
+ type = gfc_get_function_type (sym);
+ fndecl = build_decl (FUNCTION_DECL, gfc_sym_identifier (sym), type);
+ /* Layout the function declaration and put it in the binding level
+ of the current function. */
+ pushdecl (fndecl);
+ }
/* Perform name mangling if this is a top level or module procedure. */
if (current_function_decl == NULL_TREE)
@@ -1079,10 +1101,6 @@ build_function_decl (gfc_symbol * sym)
TREE_SIDE_EFFECTS (fndecl) = 0;
}
- /* Layout the function declaration and put it in the binding level
- of the current function. */
- pushdecl (fndecl);
-
sym->backend_decl = fndecl;
}
diff -urp -x CVS -x '*.orig' gcc.jh/gcc/var-tracking.c gcc/gcc/var-tracking.c
--- gcc.jh/gcc/var-tracking.c 2005-03-12 21:30:29.000000000 +0100
+++ gcc/gcc/var-tracking.c 2005-03-14 10:58:52.000000000 +0100
@@ -2514,8 +2514,8 @@ vt_add_function_parameters (void)
{
rtx decl_rtl = DECL_RTL_IF_SET (parm);
rtx incoming = DECL_INCOMING_RTL (parm);
- tree decl;
- HOST_WIDE_INT offset;
+ tree decl = 0;
+ HOST_WIDE_INT offset = 0;
dataflow_set *out;
if (TREE_CODE (parm) != PARM_DECL)
