[gfortran] Reimplement BLOCK DATA

[Tobias Schlüter <tobias dot schlueter at physik dot uni-muenchen dot de>]

Tobias Schlüter wrote:
> Of course this only makes sense, if there's a reason why we don't use the
> BLOCK DATA's name in the first place. I assume 'SUBROUTINE a' and 'BLOCK DATA
> a' should collide; the frontend doesn't allow them if they're in the same
> file, and I assume it would be a quality of implementation issue to also not
> allow them if they're not in the same file, i.e. by having the linker giving
> an error.

This revised patch addresses those concerns. The gfc_generate_block_data
routine is inspired by similar code in our illegitimate brother project. What
the patch does, is that it translates BLOCK DATA program units separately,
emitting the symbols contained therein, and also emitting a sentinel symbol
which ensures that there is no other global object of the same name.

Doing this required slight changes in the parser, I had to add a field to the
gfc_namespace structure which allows the code generation passes to determine
if a namespace is related to a BLOCK DATA unit. I was tempted to port a more
complete solution of the problem of knowing what kind of program unit a
namespace refers to from a different codebase, but since this might involve
bigger changes to parse.c, I refrained from doing so.

Built and tested. Salvatore's testcase is also fixed by this.

- Tobi

2004-08-30  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>

	* gfortran.h (gfc_namespace): Add new field is_block_data.
	* parse.c (accept_statement): Remove special handling for BLOCK DATA.
	(parse_block_data): Record BLOCK DATA name, set is_block_data field.
	* trans.c (gfc_generate_code): Handle BLOCK DATA units.
	* trans.h (gfc_generate_block_data): Add prototype.
	* trans-decl.c (gfc_generate_block_data): New function.

Index: gfortran.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/gfortran.h,v
retrieving revision 1.32
diff -u -p -r1.32 gfortran.h
--- gfortran.h  29 Aug 2004 16:58:38 -0000      1.32
+++ gfortran.h  30 Aug 2004 13:35:15 -0000
@@ -804,6 +804,9 @@ typedef struct gfc_namespace

   /* A list of all alternate entry points to this procedure (or NULL).  */
   gfc_entry_list *entries;
+
+  /* Set to 1 if namespace is a BLOCK DATA program unit.  */
+  int is_block_data;
 }
 gfc_namespace;

Index: parse.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/parse.c,v
retrieving revision 1.17
diff -u -p -r1.17 parse.c
--- parse.c     17 Aug 2004 15:34:09 -0000      1.17
+++ parse.c     30 Aug 2004 13:35:17 -0000
@@ -1058,24 +1058,6 @@ accept_statement (gfc_statement st)

       break;

-    case ST_BLOCK_DATA:
-      {
-        gfc_symbol *block_data = NULL;
-        symbol_attribute attr;
-
-        gfc_get_symbol ("_BLOCK_DATA__", gfc_current_ns, &block_data);
-        gfc_clear_attr (&attr);
-        attr.flavor = FL_PROCEDURE;
-        attr.proc = PROC_UNKNOWN;
-        attr.subroutine = 1;
-        attr.access = ACCESS_PUBLIC;
-        block_data->attr = attr;
-        gfc_current_ns->proc_name = block_data;
-        gfc_commit_symbols ();
-      }
-
-      break;
-
     case ST_ENTRY:
     case_executable:
     case_exec_markers:
@@ -2410,6 +2392,9 @@ parse_block_data (void)
   static int blank_block=0;
   gfc_gsymbol *s;

+  gfc_current_ns->proc_name = gfc_new_block;
+  gfc_current_ns->is_block_data = 1;
+
   if (gfc_new_block == NULL)
     {
       if (blank_block)
Index: trans.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans.c,v
retrieving revision 1.13
diff -u -p -r1.13 trans.c
--- trans.c     25 Aug 2004 15:50:36 -0000      1.13
+++ trans.c     30 Aug 2004 13:35:17 -0000
@@ -647,6 +647,12 @@ gfc_generate_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)
     {
Index: trans.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans.h,v
retrieving revision 1.14
diff -u -p -r1.14 trans.h
--- trans.h     25 Aug 2004 16:50:07 -0000      1.14
+++ trans.h     30 Aug 2004 13:35:17 -0000
@@ -396,6 +396,8 @@ tree gfc_advance_chain (tree, int);
 void gfc_create_function_decl (gfc_namespace *);
 /* Generate the code for a function.  */
 void gfc_generate_function_code (gfc_namespace *);
+/* Output a BLOCK DATA program unit.  */
+void gfc_generate_block_data (gfc_namespace *);
 /* Output a decl for a module variable.  */
 void gfc_generate_module_vars (gfc_namespace *);

Index: trans-decl.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-decl.c,v
retrieving revision 1.37
diff -u -p -r1.37 trans-decl.c
--- trans-decl.c        25 Aug 2004 15:50:35 -0000      1.37
+++ trans-decl.c        30 Aug 2004 13:35:17 -0000
@@ -2350,4 +2359,30 @@ gfc_generate_constructors (void)
 #endif
 }

+/* Translates a BLOCK DATA program unit. This means emitting the
+   commons contained therein plus their initializations. We also emit
+   a globally visible symbol to make sure that each BLOCK DATA program
+   unit remains unique.  */
+
+void
+gfc_generate_block_data (gfc_namespace * ns)
+{
+  tree decl;
+  tree id;
+
+  gfc_trans_common (ns);
+
+  if (ns->proc_name)
+    id = gfc_sym_mangled_function_id (ns->proc_name);
+  else
+    id = get_identifier ("__BLOCK_DATA__");
+
+  decl = build_decl (VAR_DECL, id, gfc_array_index_type);
+  TREE_PUBLIC (decl) = 1;
+  TREE_STATIC (decl) = 1;
+
+  pushdecl (decl);
+  rest_of_decl_compilation (decl, 1, 0);
+}
+
 #include "gt-fortran-trans-decl.h"