diff options
Diffstat (limited to 'gcc/fortran/st.c')
| -rw-r--r-- | gcc/fortran/st.c | 246 |
1 files changed, 246 insertions, 0 deletions
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c new file mode 100644 index 000000000..28d69b929 --- /dev/null +++ b/gcc/fortran/st.c @@ -0,0 +1,246 @@ +/* Build executable statement trees. + Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2009, 2010 + 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 3, 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 COPYING3. If not see +<http://www.gnu.org/licenses/>. */ + +/* 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 "system.h" +#include "gfortran.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 = XCNEW (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_code) +{ + if (tail != NULL) + { + while (tail->next != NULL) + tail = tail->next; + + tail->next = new_code; + } + + while (new_code->next != NULL) + new_code = new_code->next; + + return new_code; +} + + +/* Free a single code structure, but not the actual structure itself. */ + +void +gfc_free_statement (gfc_code *p) +{ + if (p->expr1) + gfc_free_expr (p->expr1); + if (p->expr2) + gfc_free_expr (p->expr2); + + switch (p->op) + { + case EXEC_NOP: + case EXEC_END_BLOCK: + case EXEC_ASSIGN: + case EXEC_INIT_ASSIGN: + case EXEC_GOTO: + case EXEC_CYCLE: + case EXEC_RETURN: + case EXEC_END_PROCEDURE: + case EXEC_IF: + case EXEC_PAUSE: + case EXEC_STOP: + case EXEC_ERROR_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: + case EXEC_CRITICAL: + case EXEC_SYNC_ALL: + case EXEC_SYNC_IMAGES: + case EXEC_SYNC_MEMORY: + break; + + case EXEC_BLOCK: + gfc_free_namespace (p->ext.block.ns); + gfc_free_association_list (p->ext.block.assoc); + break; + + case EXEC_COMPCALL: + case EXEC_CALL_PPC: + case EXEC_CALL: + case EXEC_ASSIGN_CALL: + gfc_free_actual_arglist (p->ext.actual); + break; + + case EXEC_SELECT: + case EXEC_SELECT_TYPE: + if (p->ext.block.case_list) + gfc_free_case_list (p->ext.block.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: + case EXEC_FLUSH: + gfc_free_filepos (p->ext.filepos); + break; + + case EXEC_INQUIRE: + gfc_free_inquire (p->ext.inquire); + break; + + case EXEC_WAIT: + gfc_free_wait (p->ext.wait); + 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; + + case EXEC_OMP_DO: + case EXEC_OMP_END_SINGLE: + case EXEC_OMP_PARALLEL: + case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_SECTIONS: + case EXEC_OMP_SECTIONS: + case EXEC_OMP_SINGLE: + case EXEC_OMP_TASK: + case EXEC_OMP_WORKSHARE: + case EXEC_OMP_PARALLEL_WORKSHARE: + gfc_free_omp_clauses (p->ext.omp_clauses); + break; + + case EXEC_OMP_CRITICAL: + gfc_free (CONST_CAST (char *, p->ext.omp_name)); + break; + + case EXEC_OMP_FLUSH: + gfc_free_namelist (p->ext.omp_namelist); + break; + + case EXEC_OMP_ATOMIC: + case EXEC_OMP_BARRIER: + case EXEC_OMP_MASTER: + case EXEC_OMP_ORDERED: + case EXEC_OMP_END_NOWAIT: + case EXEC_OMP_TASKWAIT: + 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); + } +} + + +/* Free an association list (of an ASSOCIATE statement). */ + +void +gfc_free_association_list (gfc_association_list* assoc) +{ + if (!assoc) + return; + + gfc_free_association_list (assoc->next); + gfc_free (assoc); +} |