This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[gfortran] Make frontend record entries
- From: Tobias Schlüter <tobias dot schlueter at physik dot uni-muenchen dot de>
- To: GCC Fortran mailing list <fortran at gcc dot gnu dot org>,patch <gcc-patches at gcc dot gnu dot org>
- Date: Wed, 16 Jun 2004 15:21:25 +0200
- Subject: [gfortran] Make frontend record entries
This is mostly a port from Andy's tree (1). What it does is that it adds
a new statement type EXEC_ENTRY which is used to record the location of
an ENTRY inside a procedure. Before, we didn't keep that information. We
now also disallow the ENTRY statement inside internal procedures, as
mandated by the standard.
This should fix the wrong-code part of PR13082, as all programs with
entries should now generate a todo-error.
- Tobi
(1) his March 17th sources to be precise, he keeps violating copyright
law. I have asked him for his sources over a month ago.
2004-06-16 Tobias Schlüter <tobias.schlueter@physik.uni-muenchen.de>
Andrew Vaught <andyv@firstinter.net>
PR fortran/13082
* decl.c (gfc_match_entry): Verify that ENTRY does not appear in
an internal subroutine/function. Copy aprent properties.
Generate EXEC_ENTRY statement.
* dump-parse-tree (gfc_show_code_node): Dump EXEC_ENTRYs.
* gfortran.h (gfc_exec_op): New element EXEC_ENTRY.
* parse.c (accept_statemnt): Add statement for ST_ENTRY.
* st.c (gfc_free_statment): Handle ST_ENTRY.
* trans.c (gfc_trans_code): Issue todo error in case of ENTRY.
Index: decl.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/decl.c,v
retrieving revision 1.9
diff -u -p -r1.9 decl.c
--- decl.c 12 Jun 2004 15:01:59 -0000 1.9
+++ decl.c 16 Jun 2004 13:05:43 -0000
@@ -1642,40 +1642,49 @@ gfc_match_entry (void)
{
gfc_symbol *function, *result, *entry;
char name[GFC_MAX_SYMBOL_LEN + 1];
- gfc_compile_state state;
match m;
m = gfc_match_name (name);
if (m != MATCH_YES)
return m;
+ if (gfc_current_state () != COMP_SUBROUTINE
+ && gfc_current_state () != COMP_FUNCTION)
+ {
+ gfc_error ("ENTRY statement at %C cannot appear within %s",
+ gfc_state_name (gfc_current_state ()));
+ return MATCH_ERROR;
+ }
+
+ if (gfc_current_ns->parent != NULL
+ && gfc_current_ns->parent->proc_name->attr.flavor != FL_MODULE)
+ {
+ gfc_error("ENTRY statement at %C cannot appear in a "
+ "contained procedure");
+ return MATCH_ERROR;
+ }
+
if (get_proc_name (name, &entry))
return MATCH_ERROR;
- gfc_enclosing_unit (&state);
- switch (state)
+ if (gfc_current_ns->proc_name->attr.subroutine)
{
- case COMP_SUBROUTINE:
+ /* subroutine entry. */
m = gfc_match_formal_arglist (entry, 0, 1);
if (m != MATCH_YES)
return MATCH_ERROR;
- if (gfc_current_state () != COMP_SUBROUTINE)
- goto exec_construct;
-
if (gfc_add_entry (&entry->attr, NULL) == FAILURE
|| gfc_add_subroutine (&entry->attr, NULL) == FAILURE)
return MATCH_ERROR;
-
- break;
-
- case COMP_FUNCTION:
+ }
+ else
+ {
+ /* function entry. */
m = gfc_match_formal_arglist (entry, 0, 0);
if (m != MATCH_YES)
return MATCH_ERROR;
- if (gfc_current_state () != COMP_FUNCTION)
- goto exec_construct;
function = gfc_state_stack->sym;
result = NULL;
@@ -1708,26 +1717,26 @@ gfc_match_entry (void)
gfc_error ("RESULT attribute required in ENTRY statement at %C");
return MATCH_ERROR;
}
-
- break;
-
- default:
- goto exec_construct;
}
+ if (gfc_current_ns->parent != NULL
+ && gfc_add_procedure(&entry->attr, PROC_MODULE, NULL) == FAILURE)
+ return MATCH_ERROR;
+
if (gfc_match_eos () != MATCH_YES)
{
gfc_syntax_error (ST_ENTRY);
return MATCH_ERROR;
}
- return MATCH_YES;
+ entry->attr.recursive = gfc_current_ns->proc_name->attr.recursive;
+ entry->attr.elemental = gfc_current_ns->proc_name->attr.elemental;
+ entry->attr.pure = gfc_current_ns->proc_name->attr.pure;
+
+ new_st.op = EXEC_ENTRY;
+ gfc_find_sym_tree (entry->name, gfc_current_ns, 1, &new_st.symtree);
-exec_construct:
- gfc_error ("ENTRY statement at %C cannot appear within %s",
- gfc_state_name (gfc_current_state ()));
-
- return MATCH_ERROR;
+ return MATCH_YES;
}
Index: dump-parse-tree.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/dump-parse-tree.c,v
retrieving revision 1.5
diff -u -p -r1.5 dump-parse-tree.c
--- dump-parse-tree.c 22 May 2004 15:52:42 -0000 1.5
+++ dump-parse-tree.c 16 Jun 2004 13:05:44 -0000
@@ -792,6 +792,10 @@ gfc_show_code_node (int level, gfc_code
gfc_status ("CONTINUE");
break;
+ case EXEC_ENTRY:
+ gfc_status ("ENTRY %s", c->symtree->n.sym->name);
+ break;
+
case EXEC_ASSIGN:
gfc_status ("ASSIGN ");
gfc_show_expr (c->expr);
Index: gfortran.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/gfortran.h,v
retrieving revision 1.13
diff -u -p -r1.13 gfortran.h
--- gfortran.h 14 Jun 2004 15:56:48 -0000 1.13
+++ gfortran.h 16 Jun 2004 13:05:47 -0000
@@ -1130,6 +1130,7 @@ typedef enum
{
EXEC_NOP = 1, EXEC_ASSIGN, EXEC_LABEL_ASSIGN, EXEC_POINTER_ASSIGN,
EXEC_GOTO, EXEC_CALL, EXEC_RETURN, EXEC_PAUSE, EXEC_STOP, EXEC_CONTINUE,
+ EXEC_ENTRY,
EXEC_IF, EXEC_ARITHMETIC_IF, EXEC_DO, EXEC_DO_WHILE, EXEC_SELECT,
EXEC_FORALL, EXEC_WHERE, EXEC_CYCLE, EXEC_EXIT,
EXEC_ALLOCATE, EXEC_DEALLOCATE,
Index: parse.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/parse.c,v
retrieving revision 1.7
diff -u -p -r1.7 parse.c
--- parse.c 27 May 2004 12:35:12 -0000 1.7
+++ parse.c 16 Jun 2004 13:05:47 -0000
@@ -1077,6 +1077,7 @@ accept_statement (gfc_statement st)
case_executable:
case_exec_markers:
+ case ST_ENTRY:
add_statement ();
break;
Index: resolve.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/resolve.c,v
retrieving revision 1.6
diff -u -p -r1.6 resolve.c
--- resolve.c 15 Jun 2004 21:50:48 -0000 1.6
+++ resolve.c 16 Jun 2004 13:05:48 -0000
@@ -3457,6 +3457,7 @@ resolve_code (gfc_code * code, gfc_names
case EXEC_STOP:
case EXEC_EXIT:
case EXEC_CONTINUE:
+ case EXEC_ENTRY:
case EXEC_DT_END:
case EXEC_TRANSFER:
break;
Index: st.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/st.c,v
retrieving revision 1.4
diff -u -p -r1.4 st.c
--- st.c 27 May 2004 12:35:12 -0000 1.4
+++ st.c 16 Jun 2004 13:05:48 -0000
@@ -104,6 +104,7 @@ gfc_free_statement (gfc_code * p)
case EXEC_POINTER_ASSIGN:
case EXEC_DO_WHILE:
case EXEC_CONTINUE:
+ case EXEC_ENTRY:
case EXEC_TRANSFER:
case EXEC_LABEL_ASSIGN:
Index: trans.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans.c,v
retrieving revision 1.7
diff -u -p -r1.7 trans.c
--- trans.c 3 Jun 2004 21:56:54 -0000 1.7
+++ trans.c 16 Jun 2004 13:05:48 -0000
@@ -494,6 +494,10 @@ gfc_trans_code (gfc_code * code)
res = NULL_TREE;
break;
+ case EXEC_ENTRY:
+ gfc_todo_error ("translating ENTRY");
+ break;
+
case EXEC_CYCLE:
res = gfc_trans_cycle (code);
break;