void
gfc_free_omp_clauses (gfc_omp_clauses *c)
{
int i;
if (c == NULL)
return;
gfc_free_expr (c->if_expr);
gfc_free_expr (c->num_threads);
gfc_free_expr (c->chunk_size);
for (i = 0; i < OMP_LIST_NUM; i++)
gfc_free_namelist (c->lists[i]);
gfc_free (c);
}
match
gfc_match_omp_flush (void)
{
gfc_namelist *list = NULL;
gfc_match_omp_variable_list (" (", &list, true);
if (gfc_match_omp_eos () != MATCH_YES)
{
gfc_error ("Unexpected junk after $OMP FLUSH statement at %C");
gfc_free_namelist (list);
return MATCH_ERROR;
}
new_st.op = EXEC_OMP_FLUSH;
new_st.ext.omp_namelist = list;
return MATCH_YES;
}
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_END_NESTED_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:
case EXEC_LOCK:
case EXEC_UNLOCK:
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_DO_CONCURRENT:
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:
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:
case EXEC_OMP_TASKYIELD:
break;
default:
gfc_internal_error ("gfc_free_statement(): Bad statement");
}
}
static match
gfc_match_omp_variable_list (const char *str, gfc_namelist **list,
bool allow_common)
{
gfc_namelist *head, *tail, *p;
locus old_loc;
char n[GFC_MAX_SYMBOL_LEN+1];
gfc_symbol *sym;
match m;
gfc_symtree *st;
head = tail = NULL;
old_loc = gfc_current_locus;
m = gfc_match (str);
if (m != MATCH_YES)
return m;
for (;;)
{
m = gfc_match_symbol (&sym, 1);
switch (m)
{
case MATCH_YES:
gfc_set_sym_referenced (sym);
p = gfc_get_namelist ();
if (head == NULL)
head = tail = p;
else
{
tail->next = p;
tail = tail->next;
}
tail->sym = sym;
goto next_item;
case MATCH_NO:
break;
case MATCH_ERROR:
goto cleanup;
}
if (!allow_common)
goto syntax;
m = gfc_match (" / %n /", n);
if (m == MATCH_ERROR)
goto cleanup;
if (m == MATCH_NO)
goto syntax;
st = gfc_find_symtree (gfc_current_ns->common_root, n);
if (st == NULL)
{
gfc_error ("COMMON block /%s/ not found at %C", n);
goto cleanup;
}
for (sym = st->n.common->head; sym; sym = sym->common_next)
{
gfc_set_sym_referenced (sym);
p = gfc_get_namelist ();
if (head == NULL)
head = tail = p;
else
{
tail->next = p;
tail = tail->next;
}
tail->sym = sym;
}
next_item:
if (gfc_match_char (')') == MATCH_YES)
break;
if (gfc_match_char (',') != MATCH_YES)
goto syntax;
}
while (*list)
list = &(*list)->next;
*list = head;
return MATCH_YES;
syntax:
gfc_error ("Syntax error in OpenMP variable list at %C");
cleanup:
gfc_free_namelist (head);
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
