8sa1-gcc/gcc/fortran/st.c
Paul Brook 3d79abbdf8 re PR fortran/13082 (Function entries and entries with alternate returns not implemented)
2004-08-17  Paul Brook  <paul@codesourcery.com>
	Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>

	PR fortran/13082
	* decl.c (get_proc_name): Update mystery comment.
	(gfc_match_entry): Check for errors earlier.  Add entry point to list.
	* dump-parse-tree.c (gfc_show_code_node): Print EXEC_ENTRY nodes.
	* gfortran.h (symbol_attribute): Add entry_master.  Document entry.
	(struct gfc_entry_list): Define.
	(gfc_get_entry_list): Define.
	(struct gfc_namespace): Add refs and entries.
	(enum gfc_exec_op): Add EXEC_ENTRY.
	(struct gfc_code): Add ext.entry.
	* module.c (ab_attribute, attr_bits): Remove AB_ENTRY.
	(mio_symbol_attribute): Don't save/reture addr->entry.
	(mio_namespace_ref): Refcount namespaces.
	* parse.c (accept_statement): Handle ST_ENTRY.
	(gfc_fixup_sibling_symbols): Mark symbol as referenced.
	(parse_contained): Fixup sibling references to entry points
	after parsing the procedure body.
	* resolve.c (resolve_contained_fntype): New function.
	(merge_argument_lists, resolve_entries): New functions.
	(resolve_contained_functions): Use them.
	(resolve_code): Handle EXEC_ENTRY.
	(gfc_resolve): Call resolve_entries.
	* st.c (gfc_free_statement): Handle EXEC_ENTRY.
	* symbol.c (gfc_get_namespace): Refcount namespaces.
	(gfc_free_namespace): Ditto.
	* trans-array.c (gfc_trans_dummy_array_bias): Treat all args as
	optional when multiple entry points are present.
	* trans-decl.c (gfc_get_symbol_decl): Remove incorrect check.
	(gfc_get_extern_function_decl): Add assertion.  Fix coment.
	(create_function_arglist, trans_function_start, build_entry_thunks):
	New functions.
	(gfc_build_function_decl): Rename ...
	(build_function_decl): ... to this.
	(gfc_create_function_decl): New function.
	(gfc_generate_contained_functions): Use it.
	(gfc_trans_entry_master_switch): New function.
	(gfc_generate_function_code): Use new functions.
	* trans-stmt.c (gfc_trans_entry): New function.
	* trans-stmt.h (gfc_trans_entry): Add prototype.
	* trans-types.c (gfc_get_function_type): Add entry point argument.
	* trans.c (gfc_trans_code): Handle EXEC_ENTRY.
	(gfc_generate_module_code): Call gfc_create_function_decl.
	* trans.h (gfc_build_function_decl): Remove.
	(gfc_create_function_decl): Add prototype.
testsuite/
	* gfortran.dg/entry_1.f90: New test.

Co-Authored-By: Tobias Schlüter <tobias.schlueter@physik.uni-muenchen.de>

From-SVN: r86128
2004-08-17 15:34:12 +00:00

187 lines
3.8 KiB
C

/* Build executable statement trees.
Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
Contributed by Andy Vaught
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. */
/* Executable statements are strung together into a singly linked list
of code structures. These structures are later translated into GCC
GENERIC tree structures and from there to executable code for a
target. */
#include "config.h"
#include "gfortran.h"
#include <string.h>
gfc_code new_st;
/* Zeroes out the new_st structure. */
void
gfc_clear_new_st (void)
{
memset (&new_st, '\0', sizeof (new_st));
new_st.op = EXEC_NOP;
}
/* Get a gfc_code structure. */
gfc_code *
gfc_get_code (void)
{
gfc_code *c;
c = gfc_getmem (sizeof (gfc_code));
c->loc = gfc_current_locus;
return c;
}
/* Given some part of a gfc_code structure, append a set of code to
its tail, returning a pointer to the new tail. */
gfc_code *
gfc_append_code (gfc_code * tail, gfc_code * new)
{
if (tail != NULL)
{
while (tail->next != NULL)
tail = tail->next;
tail->next = new;
}
while (new->next != NULL)
new = new->next;
return new;
}
/* Free a single code structure, but not the actual structure itself. */
void
gfc_free_statement (gfc_code * p)
{
if (p->expr)
gfc_free_expr (p->expr);
if (p->expr2)
gfc_free_expr (p->expr2);
switch (p->op)
{
case EXEC_NOP:
case EXEC_ASSIGN:
case EXEC_GOTO:
case EXEC_CYCLE:
case EXEC_RETURN:
case EXEC_IF:
case EXEC_PAUSE:
case EXEC_STOP:
case EXEC_EXIT:
case EXEC_WHERE:
case EXEC_IOLENGTH:
case EXEC_POINTER_ASSIGN:
case EXEC_DO_WHILE:
case EXEC_CONTINUE:
case EXEC_TRANSFER:
case EXEC_LABEL_ASSIGN:
case EXEC_ENTRY:
case EXEC_ARITHMETIC_IF:
break;
case EXEC_CALL:
gfc_free_actual_arglist (p->ext.actual);
break;
case EXEC_SELECT:
if (p->ext.case_list)
gfc_free_case_list (p->ext.case_list);
break;
case EXEC_DO:
gfc_free_iterator (p->ext.iterator, 1);
break;
case EXEC_ALLOCATE:
case EXEC_DEALLOCATE:
gfc_free_alloc_list (p->ext.alloc_list);
break;
case EXEC_OPEN:
gfc_free_open (p->ext.open);
break;
case EXEC_CLOSE:
gfc_free_close (p->ext.close);
break;
case EXEC_BACKSPACE:
case EXEC_ENDFILE:
case EXEC_REWIND:
gfc_free_filepos (p->ext.filepos);
break;
case EXEC_INQUIRE:
gfc_free_inquire (p->ext.inquire);
break;
case EXEC_READ:
case EXEC_WRITE:
gfc_free_dt (p->ext.dt);
break;
case EXEC_DT_END:
/* The ext.dt member is a duplicate pointer and doesn't need to
be freed. */
break;
case EXEC_FORALL:
gfc_free_forall_iterator (p->ext.forall_iterator);
break;
default:
gfc_internal_error ("gfc_free_statement(): Bad statement");
}
}
/* Free a code statement and all other code structures linked to it. */
void
gfc_free_statements (gfc_code * p)
{
gfc_code *q;
for (; p; p = q)
{
q = p->next;
if (p->block)
gfc_free_statements (p->block);
gfc_free_statement (p);
gfc_free (p);
}
}