/* FIRST(statement)={AVID,SVID,IF,USING,INPUT,OUTPUT}
<statement> ->
<assignment statement>
| <selection statement>
| <iteration statement>
| <input statement>
| <output statement>
Author: Kwok Hong Kelvin Chan */
void statement(void){
switch(lookahead_token.code){
case AVID_T:
case SVID_T:
assignment_statement();
break;
case KW_T:
switch(lookahead_token.attribute.get_int) {
case IF:
selection_statement();
break;
case USING:
iteration_statement();
break;
case INPUT:
input_statement();
break;
case OUTPUT:
output_statement();
break;
default:
syn_printe();
break;
}
break;
default:
syn_printe();
break;
}
}
int OMP_output_st_pragma(expv v)
{
switch(OMP_st_flag){
case OMP_ST_ATOMIC:
output_statement(OMP_pragma_list(OMP_ATOMIC, list0(LIST),
list1(EXPR_STATEMENT, v)));
return TRUE;
default:
return FALSE;
}
}
/*
* Production: Statement
* FIRST set: { AVID_T, SVID_T, KW_T (only IF, USING, INPUT, OUTPUT) }
*/
void statement(void) {
switch (lookahead.code) {
case AVID_T:
case SVID_T:
assignment_statement();
return;
case KW_T:
/* The token attribute must be IF, INPut, OUTPUT or USING */
switch (lookahead.attribute.kwt_idx) {
case IF:
selection_statement();
return;
case INPUT:
input_statement();
return;
case OUTPUT:
output_statement();
return;
case USING:
iteration_statement();
return;
/* If the keyword token does not match the above, print an error and return. */
default:
syn_printe();
return;
}
/* If nothing matches, print an error. */
default:
syn_printe();
return;
}
}
void compile_OMP_directive(expr x)
{
expr dir;
expr c = NULL;
expv pclause,dclause;
if(x == NULL) return; /* error */
if (debug_flag) {
fprintf(stderr, "OMP_directive:\n");
expv_output(x, stderr);
fprintf(stderr, "\n");
}
check_for_OMP_pragma(x);
check_for_XMP_pragma(-1, x);
if(OMP_do_required){
error("OpenMP DO directived must be followed by do statement");
OMP_do_required = FALSE;
return;
}
if(OMP_st_required != OMP_ST_NONE){
error("OpenMP ATOMIC directives must be followed by assignment");
return;
}
dir = EXPR_ARG1(x);
if (EXPR_INT(dir) == OMP_F_THREADPRIVATE) {
check_INDCL();
} else {
check_INEXEC();
}
if (EXPR_INT(dir) != OMP_F_END_DO &&
EXPR_INT(dir) != OMP_F_END_PARALLEL_DO &&
EXPR_INT(dir) != OMP_F_ATOMIC) {
check_for_OMP_pragma(NULL); /* close DO directives if any */
}
switch(EXPR_INT(dir)){
case OMP_F_PARALLEL:
push_ctl(CTL_OMP);
compile_OMP_pragma_clause(EXPR_ARG2(x),OMP_PARALLEL,TRUE,
&pclause,&dclause);
CTL_OMP_ARG(ctl_top) = list3(LIST,dir,pclause,dclause);
EXPR_LINE(CTL_OMP_ARG(ctl_top)) = current_line;
return;
case OMP_F_END_PARALLEL:
if(CTL_TYPE(ctl_top) == CTL_OMP &&
CTL_OMP_ARG_DIR(ctl_top) == OMP_F_PARALLEL){
CTL_BLOCK(ctl_top) =
OMP_pragma_list(OMP_PARALLEL,CTL_OMP_ARG_PCLAUSE(ctl_top),
CURRENT_STATEMENTS);
EXPR_LINE(CTL_BLOCK(ctl_top)) = EXPR_LINE(CTL_OMP_ARG(ctl_top));
pop_ctl();
} else error("OpenMP PARALLEL block is not closed");
return;
case OMP_F_PARALLEL_DO:
push_ctl(CTL_OMP);
compile_OMP_pragma_clause(EXPR_ARG2(x),OMP_FOR,TRUE,
&pclause,&dclause);
CTL_OMP_ARG(ctl_top) = list3(LIST,dir,pclause,dclause);
EXPR_LINE(CTL_OMP_ARG(ctl_top)) = current_line;
OMP_do_required = TRUE;
return;
case OMP_F_END_PARALLEL_DO:
/* if(CTL_TYPE(ctl_top) == CTL_OMP && */
/* CTL_OMP_ARG_DIR(ctl_top) == OMP_F_PARALLEL_DO){ */
/* CTL_BLOCK(ctl_top) = */
/* OMP_pragma_list(OMP_PARALLEL,CTL_OMP_ARG_PCLAUSE(ctl_top), */
/* OMP_FOR_pragma_list( */
/* CTL_OMP_ARG_DCLAUSE(ctl_top), */
/* CURRENT_STATEMENTS)); */
/* EXPR_LINE(CTL_BLOCK(ctl_top)) = EXPR_LINE(CTL_OMP_ARG(ctl_top)); */
/* pop_ctl(); */
/* } else error("OpenMP PARALLEL DO block is not closed"); */
return;
case OMP_F_DO:
push_ctl(CTL_OMP);
compile_OMP_pragma_clause(EXPR_ARG2(x),OMP_FOR,FALSE,
&pclause,&dclause);
CTL_OMP_ARG(ctl_top) = list3(LIST,dir,pclause,dclause);
EXPR_LINE(CTL_OMP_ARG(ctl_top)) = current_line;
OMP_do_required = TRUE;
return;
case OMP_F_END_DO:
/* OMP_F_DO has been already closed at F_ENDDO */
/* Here, only the nowait clause is handled. */
if (ctl_top_saved){
dclause = CTL_OMP_ARG_DCLAUSE(ctl_top_saved);
if (EXPR_ARG2(x) != NULL) list_put_last(dclause, EXPR_ARG2(x));
CTL_BLOCK(ctl_top_saved) = OMP_FOR_pragma_list(dclause, CURRENT_STATEMENTS_saved);
EXPR_LINE(CTL_BLOCK(ctl_top_saved)) = EXPR_LINE(CTL_OMP_ARG(ctl_top_saved));
ctl_top_saved = NULL;
}
/* if(CTL_TYPE(ctl_top) == CTL_OMP && */
/* CTL_OMP_ARG_DIR(ctl_top) == OMP_F_DO){ */
/* dclause = CTL_OMP_ARG_DCLAUSE(ctl_top); */
/* if(EXPR_ARG2(x) != NULL) list_put_last(dclause,EXPR_ARG2(x)); */
/* CTL_BLOCK(ctl_top) = */
/* OMP_FOR_pragma_list(dclause,CURRENT_STATEMENTS); */
/* EXPR_LINE(CTL_BLOCK(ctl_top)) = EXPR_LINE(CTL_OMP_ARG(ctl_top)); */
/* pop_ctl(); */
/* } else error("OpenMP DO block is not closed"); */
return;
case OMP_F_PARALLEL_SECTIONS:
push_ctl(CTL_OMP);
compile_OMP_pragma_clause(EXPR_ARG2(x),OMP_SECTIONS,TRUE,
&pclause,&dclause);
CTL_OMP_ARG(ctl_top) = list3(LIST,dir,pclause,dclause);
EXPR_LINE(CTL_OMP_ARG(ctl_top)) = current_line;
return;
case OMP_F_END_PARALLEL_SECTIONS:
if(CTL_TYPE(ctl_top) == CTL_OMP &&
CTL_OMP_ARG_DIR(ctl_top) == OMP_F_PARALLEL_SECTIONS){
CURRENT_STATEMENTS = OMP_check_SECTION(CURRENT_STATEMENTS);
CTL_BLOCK(ctl_top) =
OMP_pragma_list(OMP_PARALLEL,CTL_OMP_ARG_PCLAUSE(ctl_top),
OMP_pragma_list(OMP_SECTIONS,
CTL_OMP_ARG_DCLAUSE(ctl_top),
CURRENT_STATEMENTS));
EXPR_LINE(CTL_BLOCK(ctl_top)) = EXPR_LINE(CTL_OMP_ARG(ctl_top));
pop_ctl();
} else error("OpenMP PARALLEL SECTIONS block is not closed");
return;
case OMP_F_SECTIONS:
push_ctl(CTL_OMP);
compile_OMP_pragma_clause(EXPR_ARG2(x),OMP_SECTIONS,FALSE,
&pclause,&dclause);
CTL_OMP_ARG(ctl_top) = list3(LIST,dir,pclause,dclause);
EXPR_LINE(CTL_OMP_ARG(ctl_top)) = current_line;
return;
case OMP_F_END_SECTIONS:
if(CTL_TYPE(ctl_top) == CTL_OMP &&
CTL_OMP_ARG_DIR(ctl_top) == OMP_F_SECTIONS){
CURRENT_STATEMENTS = OMP_check_SECTION(CURRENT_STATEMENTS);
dclause = CTL_OMP_ARG_DCLAUSE(ctl_top);
if(EXPR_ARG2(x) != NULL) list_put_last(dclause,EXPR_ARG2(x));
CTL_BLOCK(ctl_top) =
OMP_pragma_list(OMP_SECTIONS,dclause,CURRENT_STATEMENTS);
EXPR_LINE(CTL_BLOCK(ctl_top)) = EXPR_LINE(CTL_OMP_ARG(ctl_top));
pop_ctl();
} else error("OpenMP SECTIONS block is not closed");
return;
case OMP_F_SECTION:
if(CTL_TYPE(ctl_top) == CTL_OMP &&
(CTL_OMP_ARG_DIR(ctl_top) == OMP_F_SECTIONS ||
CTL_OMP_ARG_DIR(ctl_top) == OMP_F_PARALLEL_SECTIONS)){
output_statement(OMP_pragma_list(OMP_SECTION,NULL,NULL));
} else error("OpenMP SECTION appears outside SECTOINS");
return;
case OMP_F_SINGLE:
push_ctl(CTL_OMP);
compile_OMP_pragma_clause(EXPR_ARG2(x),OMP_SINGLE,FALSE,
&pclause,&dclause);
CTL_OMP_ARG(ctl_top) = list3(LIST,dir,pclause,dclause);
EXPR_LINE(CTL_OMP_ARG(ctl_top)) = current_line;
return;
case OMP_F_END_SINGLE:
if(CTL_TYPE(ctl_top) == CTL_OMP &&
CTL_OMP_ARG_DIR(ctl_top) == OMP_F_SINGLE){
dclause = CTL_OMP_ARG_DCLAUSE(ctl_top);
//if(EXPR_ARG2(x) != NULL) list_put_last(dclause,EXPR_ARG2(x));
if (EXPR_ARG2(x) != NULL){
list lp;
FOR_ITEMS_IN_LIST(lp, EXPR_ARG2(x)){
list_put_last(dclause, LIST_ITEM(lp));
}
}
