void
donmlist(Void)
{
register struct Hashentry *p;
register Namep q;
for(p=hashtab; p<lasthash; ++p)
if( (q = p->varp) && q->vclass==CLNAMELIST)
namelist(q);
}
static void pragma_warning(Node pragma_node) /*;pragma_warning*/
{
/* Give a warning that a pragma is ignored. */
char msg[MAXLINE + 30];
#define id (N_AST1(pragma_node))
sprintf(msg,"Pragma %s is ignored", namelist(N_ID(id)));
prs_warning(SPAN(pragma_node),msg);
#undef id
}
void check_pragmas(Node pragma_node, int (*allowed_test)(int))
/*;check_pragmas*/
{
/* Check that a pragma is valid. */
Tuple new_list = tup_new(0);
Node tmp_node;
Fortup ft1;
int id;
if (N_LIST(pragma_node) != (Tuple)0) {
FORTUP(tmp_node = (Node), N_LIST(pragma_node), ft1);
id = N_ID(N_AST1(tmp_node));
if (is_pragma(id) && (*allowed_test)(id - MIN_PRAGMA)) {
if (strcmp(namelist(id),"PRIORITY")
&& strcmp(namelist(id),"ELABORATE")
&& strcmp(namelist(id),"INTERFACE")) {
pragma_warning(tmp_node);
}
else
new_list = tup_with(new_list, (char *)tmp_node);
}
else if (is_pragma(id) && ispredef_pragma[id - MIN_PRAGMA]) {
char msg[200];
sprintf(msg,"Pragma %s is not valid in this context",
namelist(id));
prs_warning(SPAN(tmp_node),msg);
}
else if (!(is_pragma(id) && isimpldef_pragma[id - MIN_PRAGMA])
&& strcmp(namelist(id),"OPTIMIZE")) {
pragma_warning(tmp_node);
}
else
new_list = tup_with(new_list, (char *)tmp_node);
ENDFORTUP(ft1);
N_LIST(pragma_node) = new_list;
}
}