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.
Gr.
Steven
Index: f95-lang.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/f95-lang.c,v
retrieving revision 1.26
diff -u -3 -p -r1.26 f95-lang.c
--- f95-lang.c 25 Nov 2004 11:13:35 -0000 1.26
+++ f95-lang.c 11 Dec 2004 20:34:40 -0000
@@ -45,6 +45,7 @@ Software Foundation, 59 Temple Place - S
#include "cgraph.h"
#include "gfortran.h"
+#include "gfc-toplev.h"
#include "trans.h"
#include "trans-types.h"
#include "trans-const.h"
@@ -262,17 +263,36 @@ gfc_be_parse_file (int set_yydebug ATTRI
int errors;
int warnings;
- gfc_create_decls ();
- gfc_parse_file ();
- gfc_generate_constructors ();
+ /* Set up the module and subprogram queues for the parser. */
+ gfc_initialize_module_and_subprogram_queues ();
- cgraph_finalize_compilation_unit ();
- cgraph_optimize ();
+ /* Parse the whole input file, queueing up things as we see them. */
+ gfc_parse_file ();
/* Tell the frontent about any errors. */
gfc_get_errors (&warnings, &errors);
errorcount += errors;
warningcount += warnings;
+
+ /* If there were no errors and we not asked to skip code generation,
+ generate code for all queued modules and subprograms. */
+ if (errors == 0 && ! gfc_option.flag_no_backend)
+ {
+ gfc_create_decls ();
+ gfc_generate_code ();
+ gfc_generate_constructors ();
+
+ /* We've now generated code for everything, so we can free up
+ all the parsing data structures and queues. */
+ gfc_finalize_module_and_subprogram_queues ();
+
+ /* Hand over control to the middle-end. */
+ cgraph_finalize_compilation_unit ();
+ cgraph_optimize ();
+ }
+ else
+ /* Just free the queues. */
+ gfc_finalize_module_and_subprogram_queues ();
}
/* Initialize everything. */
Index: gfc-toplev.h
===================================================================
RCS file: gfc-toplev.h
diff -N gfc-toplev.h
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ gfc-toplev.h 11 Dec 2004 20:34:40 -0000
@@ -0,0 +1,106 @@
+/* Header for toplevel translation functions.
+ Copyright (C) 2004 Free Software Foundation, Inc.
+
+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
+Software Foundation; either version 2, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+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
+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. */
+
+#ifndef GFC_TOPLEV_H
+#define GFC_TOPLEV_H
+
+#include "vec.h"
+#include "gfortran.h"
+
+/* This header defines the interface between the parser and the
+ inter-subprogram name resolution and code generation phases.
+ The "driver" for the compilation process is in f95-lang.c, from where
+ we call the parser which queues up all modules and subprograms, then
+ the ip-resolve pass, and finally the code generator (trans*.[ch]).
+ The interface consists of two queues, one for modules and one for all
+ possible kinds of subprograms, including the main PROGRAM, for which
+ we produce a dummy function subprogram called __MAIN. */
+
+/* The queues are vectors of gfc_namespace pointers. Unfortunately we
+ need a new typedef for that. */
+typedef gfc_namespace * gfc_namespace_p;
+DEF_VEC_MALLOC_P(gfc_namespace_p);
+extern VEC(gfc_namespace_p) *gfc_module_queue;
+extern VEC(gfc_namespace_p) *gfc_subprogram_queue;
+
+
+/* Add module M to the queue of modules to generate code for.
+ Note that the .mod files are generated from the parser, because they
+ might be needed in other subprograms. */
+
+static inline void
+gfc_queue_module (gfc_namespace *m)
+{
+ VEC_safe_push (gfc_namespace_p, gfc_module_queue, m);
+}
+
+
+/* Add subprogram P to the queue of subprograms to generate code for. */
+
+static inline void
+gfc_queue_subprogram (gfc_namespace *p)
+{
+ VEC_safe_push (gfc_namespace_p, gfc_subprogram_queue, p);
+}
+
+
+/* Construct the queues. */
+
+static inline void
+gfc_initialize_module_and_subprogram_queues (void)
+{
+ /* Don't be cheap, use large queues. */
+ gfc_module_queue = VEC_alloc (gfc_namespace_p, 200);
+ gfc_subprogram_queue = VEC_alloc (gfc_namespace_p, 1000);
+}
+
+
+/* Return the queue length of Q. */
+
+static inline int
+gfc_queue_length (VEC(gfc_namespace_p) *q)
+{
+ return VEC_length (gfc_namespace_p, q);
+}
+
+/* Destruct the queues _and_ everything in them. */
+
+static inline void
+gfc_finalize_module_and_subprogram_queues (void)
+{
+ int i;
+
+ for (i = 0; i < gfc_queue_length (gfc_module_queue); i++)
+ {
+ gfc_namespace *ns = VEC_index (gfc_namespace_p, gfc_module_queue, i);
+ gfc_free_namespace (ns);
+ }
+
+ for (i = 0; i < gfc_queue_length (gfc_subprogram_queue); i++)
+ {
+ gfc_namespace *ns = VEC_index (gfc_namespace_p, gfc_subprogram_queue, i);
+ gfc_free_namespace (ns);
+ }
+
+ VEC_free (gfc_namespace_p, gfc_module_queue);
+ VEC_free (gfc_namespace_p, gfc_subprogram_queue);
+}
+
+#endif /* GFC_TOPLEV_H */
Index: gfortran.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/gfortran.h,v
retrieving revision 1.44
diff -u -3 -p -r1.44 gfortran.h
--- gfortran.h 2 Dec 2004 04:10:24 -0000 1.44
+++ gfortran.h 11 Dec 2004 20:34:40 -0000
@@ -1480,6 +1480,7 @@ try gfc_new_file (const char *, gfc_sour
extern gfc_source_form gfc_current_form;
extern char *gfc_source_file;
extern locus gfc_current_locus;
+extern locus gfc_null_locus;
/* misc.c */
void *gfc_getmem (size_t) ATTRIBUTE_MALLOC;
@@ -1815,8 +1816,7 @@ symbol_attribute gfc_variable_attr (gfc_
symbol_attribute gfc_expr_attr (gfc_expr *);
/* trans.c */
-void gfc_generate_code (gfc_namespace *);
-void gfc_generate_module_code (gfc_namespace *);
+void gfc_generate_code (void);
/* bbt.c */
typedef int (*compare_fn) (void *, void *);
@@ -1827,6 +1827,6 @@ void gfc_delete_bbt (void *, void *, com
void gfc_show_namespace (gfc_namespace *);
/* parse.c */
-try gfc_parse_file (void);
+void gfc_parse_file (void);
#endif /* GCC_GFORTRAN_H */
Index: parse.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/parse.c,v
retrieving revision 1.21
diff -u -3 -p -r1.21 parse.c
--- parse.c 8 Nov 2004 14:56:39 -0000 1.21
+++ parse.c 11 Dec 2004 20:34:41 -0000
@@ -28,6 +28,7 @@ Software Foundation, 59 Temple Place - S
#include "gfortran.h"
#include "match.h"
#include "parse.h"
+#include "gfc-toplev.h"
/* Current statement label. Zero means no statement label. Because
new_st can get wiped during statement matching, we have to keep it
@@ -2498,6 +2499,29 @@ add_global_procedure (int sub)
}
+/* Lots of things in the middle-end get upset if a subroutine doesn't
+ have a symbol, so we make one now. Hopefully we've set all the
+ required fields. */
+
+static void
+create_dummy_main_program_symbol (locus prog_locus)
+{
+ symbol_attribute attr;
+ gfc_symbol *main_program = NULL;
+
+ gfc_get_symbol ("MAIN__", gfc_current_ns, &main_program);
+ gfc_clear_attr (&attr);
+ attr.flavor = FL_PROCEDURE;
+ attr.proc = PROC_UNKNOWN;
+ attr.subroutine = 1;
+ attr.access = ACCESS_PUBLIC;
+ main_program->attr = attr;
+ main_program->declared_at = prog_locus;
+ gfc_current_ns->proc_name = main_program;
+ gfc_commit_symbols ();
+}
+
+
/* Add a program to the global symbol table. */
static void
@@ -2521,7 +2545,7 @@ add_global_program (void)
/* Top level parser. */
-try
+void
gfc_parse_file (void)
{
int seen_program, errors_before, errors;
@@ -2542,13 +2566,21 @@ gfc_parse_file (void)
gfc_statement_label = NULL;
if (setjmp (eof_buf))
- return FAILURE; /* Come here on unexpected EOF */
+ return; /* Come here on unexpected EOF */
seen_program = 0;
loop:
gfc_init_2 ();
st = next_statement ();
+
+ /* For entities that need a locus, but we have no good place to store
+ it (e.g. the location of BLOCK DATA tokens). The proper solution is
+ to give everything a meaningful locus. In the mean time, we just
+ give such objects the locus of the first statement we see. */
+ if (gfc_null_locus.lb == NULL)
+ gfc_null_locus = gfc_current_locus;
+
switch (st)
{
case ST_NONE:
@@ -2565,6 +2597,7 @@ loop:
accept_statement (st);
add_global_program ();
parse_progunit (ST_NONE);
+ create_dummy_main_program_symbol (prog_locus);
break;
case ST_SUBROUTINE:
@@ -2601,9 +2634,9 @@ loop:
goto duplicate_main;
seen_program = 1;
prog_locus = gfc_current_locus;
-
push_state (&s, COMP_PROGRAM, gfc_new_block);
parse_progunit (st);
+ create_dummy_main_program_symbol (prog_locus);
break;
}
@@ -2619,22 +2652,15 @@ loop:
if (s.state == COMP_MODULE)
{
gfc_dump_module (s.sym->name, errors_before == errors);
- if (errors == 0 && ! gfc_option.flag_no_backend)
- gfc_generate_module_code (gfc_current_ns);
+ gfc_queue_module (gfc_current_ns);
}
else
- {
- if (errors == 0 && ! gfc_option.flag_no_backend)
- gfc_generate_code (gfc_current_ns);
- }
+ gfc_queue_subprogram (gfc_current_ns);
pop_state ();
gfc_done_2 ();
goto loop;
-done:
- return SUCCESS;
-
duplicate_main:
/* If we see a duplicate main program, shut down. If the second
instance is an implied main program, ie data decls or executable
@@ -2642,5 +2668,7 @@ duplicate_main:
gfc_error ("Two main PROGRAMs at %L and %C", &prog_locus);
reject_statement ();
gfc_done_2 ();
- return SUCCESS;
+
+done:
+ return;
}
Index: scanner.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/scanner.c,v
retrieving revision 1.13
diff -u -3 -p -r1.13 scanner.c
--- scanner.c 8 Nov 2004 14:56:40 -0000 1.13
+++ scanner.c 11 Dec 2004 20:34:41 -0000
@@ -70,6 +70,7 @@ static gfc_linebuf *line_head, *line_tai
locus gfc_current_locus;
char *gfc_source_file;
+locus gfc_null_locus = { NULL, NULL };
/* Main scanner initialization. */
Index: symbol.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/symbol.c,v
retrieving revision 1.16
diff -u -3 -p -r1.16 symbol.c
--- symbol.c 8 Sep 2004 14:33:02 -0000 1.16
+++ symbol.c 11 Dec 2004 20:34:42 -0000
@@ -2253,8 +2253,6 @@ gfc_symbol_init_2 (void)
void
gfc_symbol_done_2 (void)
{
-
- gfc_free_namespace (gfc_current_ns);
gfc_current_ns = NULL;
}
Index: trans-common.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-common.c,v
retrieving revision 1.18
diff -u -3 -p -r1.18 trans-common.c
--- trans-common.c 16 Sep 2004 16:00:43 -0000 1.18
+++ trans-common.c 11 Dec 2004 20:34:42 -0000
@@ -271,7 +271,7 @@ build_equiv_decl (tree union_type, bool
/* The source location has been lost, and doesn't really matter.
We need to set it to something though. */
- gfc_set_decl_location (decl, &gfc_current_locus);
+ gfc_set_decl_location (decl, &gfc_null_locus);
gfc_add_decl_to_function (decl);
Index: trans-decl.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-decl.c,v
retrieving revision 1.49
diff -u -3 -p -r1.49 trans-decl.c
--- trans-decl.c 25 Nov 2004 11:13:35 -0000 1.49
+++ trans-decl.c 11 Dec 2004 20:34:43 -0000
@@ -1298,17 +1298,12 @@ trans_function_start (gfc_symbol * sym)
rest_of_decl_compilation (fndecl, 1, 0);
}
+ /* Initialize the RTL code for the function. */
+ allocate_struct_function (fndecl);
+
/* Create RTL for function definition. */
make_decl_rtl (fndecl);
- init_function_start (fndecl);
-
- /* Even though we're inside a function body, we still don't want to
- call expand_expr to calculate the size of a variable-sized array.
- We haven't necessarily assigned RTL to all variables yet, so it's
- not safe to try to expand expressions involving them. */
- cfun->x_dont_save_pending_sizes_p = 1;
-
/* function.c requires a push at the start of the function. */
pushlevel (0);
}
@@ -2374,7 +2369,7 @@ gfc_generate_block_data (gfc_namespace *
if (ns->proc_name)
gfc_set_backend_locus (&ns->proc_name->declared_at);
else
- gfc_set_backend_locus (&gfc_current_locus);
+ gfc_set_backend_locus (&gfc_null_locus);
/* Process the DATA statements. */
gfc_trans_common (ns);
Index: trans.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans.c,v
retrieving revision 1.19
diff -u -3 -p -r1.19 trans.c
--- trans.c 30 Oct 2004 14:35:23 -0000 1.19
+++ trans.c 11 Dec 2004 20:34:43 -0000
@@ -31,6 +31,7 @@ Software Foundation, 59 Temple Place - S
#include "real.h"
#include <gmp.h>
#include "gfortran.h"
+#include "gfc-toplev.h"
#include "trans.h"
#include "trans-stmt.h"
#include "trans-array.h"
@@ -45,8 +46,14 @@ Software Foundation, 59 Temple Place - S
gfc_get_* get a backend tree representation of a decl or type */
+
+/* The file we are currently compiling. */
static gfc_file *gfc_current_backend_file;
+/* Modules and subprograms (and also the main program) that we have
+ queued up for code generation. */
+VEC(gfc_namespace_p) *gfc_module_queue, *gfc_subprogram_queue;
+
/* Advance along TREE_CHAIN n times. */
@@ -185,35 +192,6 @@ gfc_init_block (stmtblock_t * block)
}
-/* Sometimes we create a scope but it turns out that we don't actually
- need it. This function merges the scope of BLOCK with its parent.
- Only variable decls will be merged, you still need to add the code. */
-
-void
-gfc_merge_block_scope (stmtblock_t * block)
-{
- tree decl;
- tree next;
-
- gcc_assert (block->has_scope);
- block->has_scope = 0;
-
- /* Remember the decls in this scope. */
- decl = getdecls ();
- poplevel (0, 0, 0);
-
- /* Add them to the parent scope. */
- while (decl != NULL_TREE)
- {
- next = TREE_CHAIN (decl);
- TREE_CHAIN (decl) = NULL_TREE;
-
- pushdecl (decl);
- decl = next;
- }
-}
-
-
/* Finish a scope containing a block of statements. */
tree
@@ -645,37 +623,15 @@ gfc_trans_code (gfc_code * code)
/* This function is called after a complete program unit has been parsed
and resolved. */
-void
-gfc_generate_code (gfc_namespace * ns)
+static void
+gfc_generate_subprogram_code (gfc_namespace * ns)
{
- gfc_symbol *main_program = NULL;
- symbol_attribute attr;
-
if (ns->is_block_data)
{
gfc_generate_block_data (ns);
return;
}
- /* Main program subroutine. */
- if (!ns->proc_name)
- {
- /* 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);
- gfc_clear_attr (&attr);
- attr.flavor = FL_PROCEDURE;
- attr.proc = PROC_UNKNOWN;
- attr.subroutine = 1;
- attr.access = ACCESS_PUBLIC;
- main_program->attr = attr;
- /* Set the location to the first line of code. */
- if (ns->code)
- main_program->declared_at = ns->code->loc;
- ns->proc_name = main_program;
- gfc_commit_symbols ();
- }
-
gfc_generate_function_code (ns);
}
@@ -683,7 +639,7 @@ gfc_generate_code (gfc_namespace * ns)
/* This function is called after a complete module has been parsed
and resolved. */
-void
+static void
gfc_generate_module_code (gfc_namespace * ns)
{
gfc_namespace *n;
@@ -709,3 +665,24 @@ gfc_generate_module_code (gfc_namespace
}
}
+
+/* Generate code for all queued up entities. */
+
+void
+gfc_generate_code (void)
+{
+ int i;
+
+ for (i = 0; i < gfc_queue_length (gfc_module_queue); i++)
+ {
+ gfc_namespace *ns = VEC_index (gfc_namespace_p, gfc_module_queue, i);
+ gfc_generate_module_code (ns);
+ }
+
+ for (i = 0; i < gfc_queue_length (gfc_subprogram_queue); i++)
+ {
+ gfc_namespace *ns = VEC_index (gfc_namespace_p, gfc_subprogram_queue, i);
+ gfc_generate_subprogram_code (ns);
+ }
+}
+
Index: trans.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans.h,v
retrieving revision 1.21
diff -u -3 -p -r1.21 trans.h
--- trans.h 16 Nov 2004 02:02:37 -0000 1.21
+++ trans.h 11 Dec 2004 20:34:43 -0000
@@ -336,8 +336,6 @@ void gfc_start_block (stmtblock_t *);
/* Finish a statement block. Also closes the scope if the block was created
with gfc_start_block. */
tree gfc_finish_block (stmtblock_t *);
-/* Merge the scope of a block with its parent. */
-void gfc_merge_block_scope (stmtblock_t * block);
/* Return the backend label decl. */
tree gfc_get_label_decl (gfc_st_label *);
