Files
SAPFOR/dvm/fdvm/trunk/fdvm/hpf.cpp
2023-09-14 19:43:13 +03:00

1699 lines
55 KiB
C++

/**************************************************************\
* Fortran DVM *
* *
* Translating HPF-program *
\**************************************************************/
#include "dvm.h"
int hpf_new_var;
/**************************************************************\
* Processing distributed array refference *
\**************************************************************/
/*----------- outside the range of parallel loop -------------*/
int SearchDistArrayRef(SgExpression *e, SgStatement *stmt)
{ int res = 0;
SgExpression *el,*eleft;
if(only_local) // option -Honlyl is specified:
return (res); // all the operands are local in sequential threads
//looks the expression 'e' for distributed array references,
// adds the attribute REMOTE_VARIABLE to the reference
//generates statements for loading the values of distributed array elements into buffers
if(!e)
return (res);
if(isSgArrayRefExp(e)) {
for(el=e->lhs(); el; el=el->rhs())
res = (SearchDistArrayRef(el->lhs(),stmt)) ? 1 : res;
if(HEADER( e->symbol()) && e->lhs()) {//is distributed array reference with subscripts
if(stmt->variant() == ASSIGN_STAT) {
eleft = isSgArrayRefExp(stmt->expr(0));//left part of assignment statement
if(eleft && eleft->lhs() && RemAccessRefCompare(eleft, e))
//array reference in right part of assignment statement is
//the same as one in left part
return(1);
}
BufferDistArrayRef(e,stmt);
//add attribute(REMOTE_VARIABLE) to distributed array reference
res = 1;
}
return(res);
}
res = SearchDistArrayRef(e->lhs(),stmt);
res = (SearchDistArrayRef(e->rhs(),stmt)) ? 1 : res;
return(res);
}
void BufferDistArrayRef(SgExpression *e, SgStatement *stmt)
{//generating statements for loading the value of distributed array element
// to buffer scalar variable and inserting ones before statement 'stmt'
//adding attribute REMOTE_VARIABLE to distributed array reference 'e'
int r,n,ibuf;
SgExpression *el;
rem_var *remv = new rem_var;
remv->ncolon = 0;
remv->index = ibuf = ++rmbuf_size[TypeIndex(e->symbol()->type()->baseType())];
remv->amv = -1;
e->addAttribute(REMOTE_VARIABLE,(void *) remv, sizeof(rem_var));
r = Rank(e->symbol());
for(el=e->lhs(),n=0; el; el = el->rhs(),n++)
;
if(r && n && r != n) {
Error("Wrong number of subscripts specified for '%s'",e->symbol()->identifier(),175,stmt);
return;
}
if(first_time) {
SgStatement *st,*stw;
ReplaceContext(stmt);
stw = (stmt->variant() == ELSEIF_NODE) ? stmt->controlParent() : stmt;
//loading buffers for statement ELSEIF is performed before statement IF_THEN
LINE_NUMBER_STL_BEFORE(st,stmt,stw);
cur_st = st;
first_time = 0;
}
CopyToBuffer(0, ibuf, e); //loading buffer for distributed array's element
return;
}
/*----------- inside the range of parallel loop --------------*/
SgExpression *IND_ModifiedDistArrayRef(SgExpression *e, SgStatement *st)
// analyzing distributed array reference:
// may this reference be used as IND_target?
{int i, num, ni, use[MAX_LOOP_NEST], IN_use;
SgExpression *ei,*el,*es,*ee;
ni = nIND+nIEX;
for(i= 0; i<ni; i++)
use[i] = 0;
if(!(e->lhs())) return(NULL); //no subscripts
ee = &(e->copy());
for(el=ee->lhs(); el; el=el->rhs()) {
es = el->lhs(); //subscript expression
IN_use = 0;
num = AxisNumOfDoVarInExpr(es, DoVar, ni, &ei, use, &IN_use, st);
if(num<0) return(NULL);
if(num>nIEX) {// IND-index is used
if(use[num-1] > 1) {
Error("More one occurance of do-variable '%s' in subscript list", DoVar[num-1]->identifier(),251, st);
return(NULL);
}
if(IN_use) //IND-index and IN-index are used
err("More one occurance of a do-variable in subscript expression", 252,st);
//err("Illegal subscript expression",253,cur_st);
} else
if(IN_use) //IN-index is used
el->setLhs(new SgExpression(DDOT)); //(new SgKeywordValExp("*"));
}
for(i= nIEX; i<ni; i++)
if(use[i] == 0)
return(NULL);
return(ee);
//return(&(e->copy()));
}
void IND_UsedDistArrayRef(SgExpression *e, SgStatement *st)
// analyzing the distributed array reference in right part of assignment statement and so on
// including it in the list IND_refs
{int i, num, ni, use[MAX_LOOP_NEST], IN_use, nt;
SgExpression *ei,*el,*es,*ee, *elbb;
SgValueExp c0(0),cM1(-1);
IND_ref_list *ref;
hpf_new_var=0;
ni = nIND+nIEX;
for(i= 0; i<ni; i++)
use[i] = 0;
if(!(e->lhs())) return; //no subscripts
if(isINDtarget(e)){ // is the same reference as IND_target
// ( reference in left part of assignment statement)
IND_DistArrayRef(e, st, NULL);
return;
}
if((ref=isInINDrefList(e)) != NULL) {// the same reference is in list IND_refs
IND_DistArrayRef(e, st, ref);
return;
}
// creating new element of list of distributed array references used in parallel loop
ref = new IND_ref_list;
ref->next = IND_refs;
IND_refs = ref;
ee = &(e->copy());
ref->rmref = ee;
ref->nc = 0;
ref->ind = 0;
nt = 0;
//looking through the subscript list
for(el=ee->lhs(); el; el=el->rhs(), nt++) {
es = el->lhs(); //subscript expression
IN_use = 0;
hpf_new_var=0;
//determinating kind of subscript expression
num = AxisNumOfDoVarInExpr(es, DoVar, ni, &ei, use, &IN_use, st);
if(num>nIEX) {// IND-index is used
ref->nc++;
if(IN_use) {//IND-index and IN-index are used : f(IN)
//err("More one occurance of a do-variable in subscript expression", 252,st);
el->setLhs(new SgExpression(DDOT)); // the subscript is replaced by ':'
ref->axis[nt] = & cM1.copy();
ref->coef[nt] = & c0.copy();
ref->cons[nt] = & c0.copy();
} else {
ref->axis[nt] = new SgValueExp(num-nIEX);
CoeffConst(es, ei, &(ref->coef[nt]), &(ref->cons[nt])); //testing form: a*IND+b
if(!ref->coef[nt]){ //f(IND)
//err("Illegal subscript expression", 253, stat);
el->setLhs(new SgExpression(DDOT)); // the subscript is replaced by ':'
ref->axis[nt] = & cM1.copy();
ref->coef[nt] = & c0.copy();
ref->cons[nt] = & c0.copy();
}
else //a*IND+b
// correcting const with lower bound of array
if((elbb = LowerBound(ref->rmref->symbol(),nt)) != NULL)
ref->cons[nt] = &(*(ref->cons[nt]) - (elbb->copy()));
}
} else // IND-index is not used
if(IN_use || hpf_new_var) {//IN-index is used: f(IN) or new variable is used
el->setLhs(new SgExpression(DDOT)); // the subscript is replaced by ':'
ref->axis[nt] = & cM1.copy();
ref->coef[nt] = & c0.copy();
ref->cons[nt] = & c0.copy();
ref->nc++;
}
else { // invariant: const,f(IEX)
ref->axis[nt] = & c0.copy();
ref->coef[nt] = & c0.copy();
if((elbb = LowerBound(ref->rmref->symbol(),nt)) != NULL)
ref->cons[nt] = & (es->copy() - (elbb->copy()));
// correcting const with lower bound of array
else //error situation
ref->cons[nt] = & (es->copy());
}
}
if(nt < 7)
ref->axis[nt] = NULL;
IND_DistArrayRef(e, st, ref);
return;
}
int AxisNumOfDoVarInExpr (SgExpression *e, SgSymbol *dovar_ident[], int ni, SgExpression **eref, int use[], int *pINuse, SgStatement *st)
{
SgSymbol *symb;
SgExpression * e1;
int i,i1,i2;
*eref = NULL;
if (!e)
return(0);
if(isSgVarRefExp(e)) {
symb = e->symbol();
for(i=0; i<ni; i++) {
if(dovar_ident[i]==NULL)
continue;
if(dovar_ident[i]==symb) { //is IEX- or IND-index
*eref = e;
/*
if (use[i] == 1 && i>= nIEX)
Error("More one occurance of do-variable '%s' in subscript list", symb->identifier(),251, st);
*/
use[i]++;
return(i+1);
}
}
if(isDoVar(symb)) // is IN-index
// (symb is not IEX- nor IND-index, but symb is do-variable => symb is IN-index)
(*pINuse)++;
if(isNewVar(symb))
hpf_new_var=1;
return (0);
}
i1 = AxisNumOfDoVarInExpr(e->lhs(), dovar_ident, ni, eref, use, pINuse, st);
e1 = *eref;
i2 = AxisNumOfDoVarInExpr(e->rhs(), dovar_ident, ni, eref, use, pINuse, st);
if((i1==-1)||(i2==-1)) return(-1);
if(i1 && i1>=nIEX && i2 && i2>=nIEX) {
err("More one occurance of a do-variable in subscript expression", 252,st);
return(-1);
}
if(i1) *eref = e1;
return(i1 ? i1 : i2);
}
int isINDtarget(SgExpression *re)
{if(RemAccessRefCompare(IND_target, re))
return(1);
else
return (0);
}
IND_ref_list *isInINDrefList(SgExpression *re)
{IND_ref_list *el;
//for(el=IND_refs; el; el=el->next)
//el->rmref->unparsestdout(); //?!!!
for(el=IND_refs; el; el=el->next)
if(RemAccessRefCompare(el->rmref, re))
return(el);
return (NULL);
}
/*
void IND_DistArrayRef(SgExpression *e, SgStatement *st)
{SgSymbol *ar;
//replace distributed array reference A(I1,I2,...,In) by
// n
// <memory>( HeaderCopy(n+1) + I1 + SUMMA(HeaderCopy(n-k+1) * Ik))
// k=2
// <memory> is I0000M if A is of type integer
// R0000M if A is of type real
// D0000M if A is of type double precision
// C0000M if A is of type complex
// L0000M if A is of type logical
ar = e->symbol();
e->setSymbol(baseMemory(ar->type()->baseType()));
if(!e->lhs())
Error("No subscripts: %s", ar->identifier(),171,st);
else {
(e->lhs())->setLhs(*LinearForm(ar,e->lhs()));
(e->lhs())->setRhs(NULL);
}
}
*/
void IND_DistArrayRef(SgExpression *e, SgStatement *st, IND_ref_list *el)
{SgSymbol *ar;
//replace distributed array reference A(I1,I2,...,In) by
// n
// <memory>( HeaderCopy(n+1) + I1 + SUMMA(HeaderCopy(n-k+1) * Ik))
// k=2
// <memory> is I0000M if A is of type integer
// R0000M if A is of type real
// D0000M if A is of type double precision
// C0000M if A is of type complex
// L0000M if A is of type logical
ar = e->symbol();
if(!el) { // local access reference
e->setSymbol(baseMemory(ar->type()->baseType()));
if(!e->lhs())
Error("No subscripts: %s", ar->identifier(),171,st);
else {
(e->lhs())->setLhs(*LinearForm(ar,e->lhs(),NULL));
(e->lhs())->setRhs(NULL);
}
} else {
int n, num, k;
SgExpression *esl;
SgExpression *p = NULL;
if(el->ind == 0) {//new reference: allocating header copy
el->ind = nhpf;
nhpf+=(el->nc)+2;
}
hpf_ind = el->ind;
if(el->nc) { //there are ':' or a*IND+b elements in index list of remote variable
for(n = 0; n<7 && el->axis[n]; n++)
;
if(n && n != Rank(ar)) {
Error("Wrong number of subscripts specified for '%s'", ar->identifier(),175,st);
return;
}
//looking through the subscript and index lists
for(esl=e->lhs(),k=0; esl && k<n; esl=esl->rhs(),k++){
num = el->axis[k]->valueInteger();
if(num == -1) // ':'
p=esl;
else if(num > 0){ //do-variable-use: a*IND+b
esl->setLhs(new SgVarRefExp(IND_var[num-1])); // replace by IND
/*
if(p)
esl->setLhs(new SgVarRefExp(IND_var[num-1])); // replace by IND
else //first non-invariant index
if(INTEGER_VALUE(el->coef[k],1) && k == 0) // a == 1
esl->setLhs(new SgVarRefExp(IND_var[num-1])); // replace by IND
else
esl->setLhs(&(*HPF000((el->ind)+(el->nc)-1)*(*new SgVarRefExp(IND_var[num-1]))));
// replace by HeaderCopy(nc)*IND
*/
p=esl;
}
else
//delete corresponding subscript in reference
if(!p)
e->setLhs(esl->rhs());
else
p->setRhs(esl->rhs());
}
}
e->setSymbol(baseMemory(ar->type()->baseType()));
num = el->axis[0]->valueInteger();
if ((num == 0) || ((num > 0) && !INTEGER_VALUE(el->coef[0], 1)) )//first dimension is b or a*IND+b
// where a != 1
e->lhs()->setLhs(*HPF000((el->ind)+(el->nc)) * (*e->lhs()->lhs()));
// first non-invariant index I is replaced by HeaderCopy(nc)*I
e->setLhs(*LinearFormB(hpfbuf, (el->ind), el->nc, e->lhs()));
}
}
/**************************************************************\
* Processing independent loop nest *
\**************************************************************/
void SkipIndepLoopNest(SgStatement *stmt)
{
SgStatement *st,*stl;
stl = stmt;
// looking through the loop nest
for(st=par_do; isSgForStmt(st); st=st->lexNext()){
stl = st;
if(st->lexNext()->variant() == HPF_INDEPENDENT_DIR)
Extract_Stmt(st->lexNext()); //extracting nested INDEPENDENT directive
else
break;
}
cur_st = stl;
}
void LookIndepLoopNest(SgStatement *stmt)
{ int i;
SgStatement *st,*stl;
stl = stmt;
// looking through the loop nest
for(st=stmt->lexNext(),i = 0; isSgForStmt(st); st=st->lexNext(),i++){
stl = st;
IND_var[i] = st->symbol();
if(st->lexNext()->variant() == HPF_INDEPENDENT_DIR)
Extract_Stmt(st->lexNext()); //extracting nested INDEPENDENT directive
else
break;
}
cur_st = stl;
}
int IndependentLoop(SgStatement *stmt)
{
SgStatement *st, *if_stmt, *stl = NULL;
SgStatement *first_do;
SgValueExp c0(0);
int i, ndo, iout, iinp, ind;
SgForStmt *stdo;
SgValueExp c1(1);
SgExpression *step[MAX_LOOP_LEVEL],
*init[MAX_LOOP_LEVEL],
*last[MAX_LOOP_LEVEL],
*vpart[MAX_LOOP_LEVEL];
first_do = stmt -> lexNext();// first DO statement of the loop nest
IND_var = DoVar+nIEX;
IND_target = NULL;
IND_target_R = NULL;
IND_refs = NULL;
redl = NULL;
irg = 0; idebrg = 0;
red_list = NULL;
redgref = NULL;
//new_red_var_list = NULL;
//initialization vpart[]
for(i=0; i<MAX_LOOP_LEVEL; i++)
vpart[i] = NULL;
//determinating rank of independent loop
for(st=first_do,ndo=0; isSgForStmt(st); st=st->lexNext()) {
ndo++;
if(st->lexNext()->variant() == HPF_INDEPENDENT_DIR) {
if(st->lexNext()->expr(0))
stmt->setExpression(0,*ConnectNewList(stmt->expr(0),st->lexNext()->expr(0)));
//stmt->expr(0)->lhs()->unparsestdout();
Extract_Stmt(st->lexNext()); //extracting nested INDEPENDENT directive
}
else
break;
}
/* if(st->lexNext()->variant() == HPF_INDEPENDENT_DIR)
st=st->lexNext();
else
break;
*/
nIND = ndo;
// generating assign statement:
// dvm000(i) = lnumb(num); // line number of stmt
LINE_NUMBER_AFTER(stmt,stmt);
//generating call to 'bploop' function of performance analizer (begin of parallel interval)
if(perf_analysis && perf_analysis != 2)
{
InsertNewStatementAfter(St_Bploop(OpenInterval(stmt)), cur_st, stmt->controlParent()); //inserting after function call 'lnumb'
}
ins_st1 = cur_st;
// generating assign statement:
// dvm000(iplp) = crtpl(Rank);
iplp = ndvm++;
doAssignTo_After(DVM000(iplp), CreateParLoop( ndo));
//allocating DebRedGroupRef
ndvm++;
//allocating RedGroupRef
ndvm++;
//allocating OutInitIndexArray,OutLastIndexArray,OutStepArray
iout = iarg = ndvm;
ndvm += 3*ndo;
// looking through the loop nest
for(st=first_do,i=0; i<ndo; st=st->lexNext(),i++) {
stdo = isSgForStmt(st);
if(!stdo)
break;
stl = st;
IND_var[i] = stdo->symbol();
step[i] = stdo->step();
if(!step[i])
step[i] = & c1.copy(); // by default: step = 1
init[i] = isSpecialFormExp(stdo->start(),i,iout+i,vpart,IND_var);
if( init[i] )
step[i] = & c1.copy();
else
init[i] = stdo->start();
last[i] = stdo->end();
// setting new loop parameters
if(vpart[i])
stdo->setStart(*DVM000(iout+i)+ (*vpart[i]));//special form
//step is not replaced
else {
stdo->setStart(*DVM000(iout+i));
//stdo->setStep(*DVM000(iout+i+2*ndo));
}
stdo->setEnd(*DVM000(iout+i+ndo));
SetDoVar(stdo->symbol());
}
iinp = ndvm;
if(dvm_debug)
OpenParLoop_Inter(stl,iinp,iinp+ndo,IND_var,ndo);
// creating LoopVarAddrArray, LoopVarTypeArray,InpInitIndexArray, InpLastIndexArray
// and InpStepArray
for(i=0; i<ndo; i++)
doAssignStmtAfter(GetAddres(IND_var[i]));
for(i=0; i<ndo; i++)
doAssignStmtAfter( new SgValueExp(LoopVarType(IND_var[i],stmt)));
for(i=0; i<ndo; i++)
doAssignStmtAfter( init[i] );
for(i=0; i<ndo; i++)
doAssignStmtAfter( last[i] );
for(i=0; i<ndo; i++)
doAssignStmtAfter( step[i] );
ins_st2 = cur_st;
if(dvm_debug) {
pardo_line = first_do->lineNumber();
DebugParLoop(cur_st,ndo,iinp+2*ndo);
/*SET_DVM(iinp+2*ndo); */
}
/* else
{ SET_DVM(iinp); }
*/
// generating Logical IF statement:
// begin_lab IF (DoPL(LoopRef) .EQ. 0) GO TO end_lab
// and inserting it before loop nest
begin_lab = GetLabel();
end_lab = GetLabel();
if_stmt = new SgLogIfStmt(SgEqOp(*doLoop(iplp) , c0), *new SgGotoStmt(*end_lab));
if_stmt -> setLabel(*begin_lab);
cur_st->insertStmtAfter(*if_stmt);
(if_stmt->lexNext()->lexNext()) -> extractStmt(); //extract ENDIF
// (error Sage)
cur_st = stl; // set cur_st on last DO satement of loop nest
//cur_st = st->lexPrev(); // set cur_st on last DO satement of loop nest
// cur_st = stl->lexNext();
return(1); //!!!
}
int IndependentLoop_Debug(SgStatement *stmt)
{ SgStatement *st, *stl = NULL;
SgStatement *first_do;
SgValueExp c0(0);
int i, ndo, iout, iinp, ind;
SgForStmt *stdo;
SgValueExp c1(1);
SgExpression *step[MAX_LOOP_LEVEL],
*init[MAX_LOOP_LEVEL],
*last[MAX_LOOP_LEVEL],
*vpart[MAX_LOOP_LEVEL];
first_do = stmt -> lexNext();// first DO statement of the loop nest
IND_var = DoVar+nIEX;
IND_target = NULL;
IND_target_R = NULL;
IND_refs = NULL;
redl = NULL;
irg = 0; idebrg = 0;
red_list = NULL;
redgref = NULL;
//new_red_var_list = NULL;
//determinating rank of independent loop
for(st=first_do,ndo=0; isSgForStmt(st); st=st->lexNext()) {
ndo++;
if(st->lexNext()->variant() == HPF_INDEPENDENT_DIR) {
if(st->lexNext()->expr(0))
stmt->setExpression(0,*ConnectNewList(stmt->expr(0),st->lexNext()->expr(0)));
//stmt->expr(0)->lhs()->unparsestdout();
Extract_Stmt(st->lexNext()); //extracting nested INDEPENDENT directive
}
else
break;
}
nIND = ndo;
// generating assign statement:
// dvm000(i) = lnumb(num); // line number of stmt
LINE_NUMBER_AFTER(stmt,stmt);
//generating call to 'bploop' function of performance analizer (begin of parallel interval)
if(perf_analysis && perf_analysis != 2)
{
InsertNewStatementAfter(St_Bploop(OpenInterval(stmt)), cur_st, stmt->controlParent()); //inserting after function call 'lnumb'
}
ins_st1 = cur_st;
iplp = 0;
//allocating DebRedGroupRef
ndvm++;
//allocating RedGroupRef
ndvm++;
iout = iarg = ndvm;
//ndvm += 3*ndo;
//initialization vpart[]
for(i=0; i<MAX_LOOP_LEVEL; i++)
vpart[i] = NULL;
// looking through the loop nest
for(st=first_do,i=0; i<ndo; st=st->lexNext(),i++) {
stdo = isSgForStmt(st);
if(!stdo)
break;
stl = st;
IND_var[i] = stdo->symbol();
step[i] = stdo->step();
if(!step[i])
step[i] = & c1.copy(); // by default: step = 1
init[i] = isSpecialFormExp(stdo->start(),i,iout+i,vpart,IND_var);
if( init[i] )
step[i] = & c1.copy();
else
init[i] = stdo->start();
last[i] = stdo->end();
SetDoVar(stdo->symbol());
}
iplp=iinp = ndvm;
OpenParLoop_Inter(stl,iinp,iinp+ndo,IND_var,ndo);
// creating LoopVarAddrArray, LoopVarTypeArray,InpInitIndexArray, InpLastIndexArray
// and InpStepArray
/* for(i=0; i<ndo; i++)
doAssignStmtAfter(GetAddres(IND_var[i]));
*/
ndvm +=ndo;
for(i=0; i<ndo; i++)
doAssignStmtAfter( new SgValueExp(LoopVarType(IND_var[i],stmt)));
for(i=0; i<ndo; i++)
doAssignStmtAfter( init[i] );
for(i=0; i<ndo; i++)
doAssignStmtAfter( last[i] );
for(i=0; i<ndo; i++)
doAssignStmtAfter( step[i] );
ins_st2 = cur_st;
pardo_line = first_do->lineNumber();
DebugParLoop(cur_st,ndo,iinp+2*ndo);
//SET_DVM(iinp+2*nloop);
cur_st = stl; // set cur_st on last DO satement of loop nest
return(1);
}
SgExpression *ConnectNewList(SgExpression *el1, SgExpression *el2)
{// el1 , el2 - NEW specifications of INDEPENDENT directives
SgExpression *el;
if(!el1)
return(el2);
if(!el2)
return(el1);
for(el = el1->lhs(); el->rhs(); el = el->rhs())
;
el->setRhs(el2->lhs());
//el1->lhs()->unparsestdout();
return(el1);
}
void IEXLoopAnalyse(SgStatement *func)
{ SgStatement *st;
int i;
nIEX = 0;
IEX_var = DoVar;
for(i=0; i<MAX_LOOP_NEST; i++)
DoVar[i] = NULL;
for(st=par_do->controlParent(); st!=func; st=st->controlParent()) {
if(st->variant() == FOR_NODE)
IEXLoopBegin(st);
else
continue;
}
}
void IEXLoopBegin(SgStatement *st)
{
DoVar[nIEX] = st->symbol();
nIEX++;
}
void INDLoopBegin()
{//generating Lib-DVM calls for beginning independent loop
SgSymbol *spat;
SgStatement *st;
int iaxis;
int nr;//number of aligning rules i.e. length of align-loop-index-list
st = cur_st; //store cur_st(pointer to current statement)
if(!IND_target)
IND_target = IND_target_R;
if(! IND_target) {
err("No target for independent loop", 254, indep_st);
return;
}
spat = IND_target->symbol(); // target array symbol
//printf("INN_target");
//IND_target->unparsestdout();
/* for HPF error if IND_target is NULL
if(!HEADER(spat)) {
Error("'%s' isn't distributed array", spat->identifier(), 72,stmt);
return(0);
}
*/
//creating reduction group
if(redl) {
irg = iarg-1;
redgref = DVM000(irg);
cur_st = ins_st1;
doAssignTo_After(redgref, CreateReductionGroup());
if(debug_regim){
idebrg = iarg-2;
doAssignTo_After(DVM000(idebrg), D_CreateDebRedGroup());
}
ReductionListIND1();
//ReductionListIND_Err();
}
cur_st = ins_st2;
// creating AxisArray, CoeffArray and ConstArray
iaxis = ndvm;
nr = doAlignIterationIND();
// generating assign statement:
// dvm000(i) =
// mappl(LoopRef, PatternRef, AxisArray[], CoefArray[], ConstArray[],
// LoopVarAdrArray[], InpInitIndexArray[], InpLastIndexArray[],
// InpStepArray[],
// OutInitIndexArray[], OutLastIndexArray[], OutStepArray[])
doCallAfter( BeginParLoop (iplp, HeaderRef(spat), nIND, iaxis, nr, iarg+3*nIND, iarg));
if(redgref)
ReductionListIND2(redgref);
if(IND_refs)
RemoteVariableListIND();
cur_st = st; //restore cur_st
}
void INDReductionDebug()
{//generating Lib-DVM calls for debugging independent loop (creating reduction group)
SgStatement *st;
st = cur_st; //store cur_st(pointer to current statement)
//creating reduction group
if(redl) {
irg = iarg-1;
redgref = DVM000(irg);
cur_st = ins_st1;
doAssignTo_After(redgref, CreateReductionGroup());
if(debug_regim){
idebrg = iarg-2;
doAssignTo_After( DVM000(idebrg), D_CreateDebRedGroup());
}
ReductionListIND1();
ReductionListIND2(redgref);
//ReductionListIND_Err();
}
cur_st = st; //restore cur_st
}
int doAlignIterationIND()
// creating axis_array, coeff_array and const_array
// returns counter of elements in align_iteration_list
{ int i,nt,num, use[MAX_LOOP_LEVEL];
SgExpression * el,*e,*ei,*elbb;
SgSymbol *ar;
SgExpression *axis[MAX_LOOP_LEVEL],
*coef[MAX_LOOP_LEVEL],
*cons[MAX_LOOP_LEVEL];
SgValueExp c1(1),c0(0),cM1(-1);
for (i=0; i<MAX_LOOP_LEVEL; i++)
use[i] = 0;
//ni = nIND;
ar = IND_target->symbol(); // array
//looking through the align_iteration_list
nt = 0; //counter of elements in align_iteration_list
for(el=IND_target->lhs(); el; el=el->rhs()) {
e = el->lhs(); //subscript expression
if(e->variant()==DDOT) { // ":"
/*if(e->variant()==KEYWORD_VAL) { */ // "*"
axis[nt] = & cM1.copy();
coef[nt] = & c0.copy();
cons[nt] = & c0.copy();
}
else { // expression
num = AxisNumOfDummyInExpr(e, IND_var, nIND, &ei, use, indep_st);
if (num<=0) {
axis[nt] = & c0.copy();
coef[nt] = & c0.copy();
if((elbb = LowerBound(ar,nt)) != NULL)
cons[nt] = & (e->copy() - (elbb->copy()));
// correcting const with lower bound of array
else //error situation
cons[nt] = & (e->copy());
}
else {
axis[nt] = new SgValueExp(num);
CoeffConst(e, ei,&coef[nt], &cons[nt]);
TestReverse(coef[nt],indep_st);
if(!coef[nt]){
err("Wrong iteration-align-subscript in PARALLEL", 160,indep_st);
coef[nt] = & c0.copy();
cons[nt] = & c0.copy();
}
else
// correcting const with lower bound of array
if((elbb = LowerBound(ar,nt)) != NULL)
cons[nt] = &(*cons[nt] - (elbb->copy()));
}
}
nt++;
}
// setting on arrays
for(i=nt-1; i>=0; i--)
doAssignStmtAfter(axis[i]);
for(i=nt-1; i>=0; i--)
doAssignStmtAfter(ReplaceFuncCall(coef[i]));
for(i=nt-1; i>=0; i--)
doAssignStmtAfter(Calculate(cons[i]));
return(nt);
}
void ReductionListIND1()
{
SgExpression *ev, *evc, *loc_var,*len, *loclen;
int irv, num_red, ntype,sign, ilen,locindtype;
SgSymbol *var;
SgValueExp c0(0),c1(1);
reduction_list *er;
//looking through the reduction list
for(er = redl; er; er=er->next) {
loc_var = ConstRef(0);
loclen = &c0;
locindtype = 0;
len =&c1;
ev = er->red_var;
evc=&(ev->copy());
num_red = er->red_op;
if( !num_red)
err("Wrong reduction operation name", 70, indep_st);
var = ev->symbol();
if(isSgVarRefExp(ev))
;
else if( isSgArrayRefExp(ev)) {
if(!ev->lhs()){ //whole array
if(Rank(var)>1)
Error("Wrong reduction variable '%s'", var->identifier(), 151, indep_st);
len = ArrayDimSize(var,1); // size of vector
if(!len || len->variant()==STAR_RANGE){
Error("Wrong reduction variable '%s'", var->identifier(), 151, indep_st);
len = &c1;
}
evc->setLhs(new SgExprListExp(*Exprn(LowerBound(var,0))));
}
}
else
err("Wrong reduction variable",151,indep_st);
ntype = VarType(var); //RedVarType(var)
if(!ntype)
Error("Wrong type of reduction variable '%s'", var->identifier(), 152,indep_st);
sign = 1;
ilen = ndvm; // index for RedArrayLength
doAssignStmtAfter(len);
doAssignStmtAfter(loclen);
irv = ndvm; // index for RedVarRef
if(! only_debug)
doAssignStmtAfter(ReductionVar(num_red,evc,ntype,ilen, loc_var, ilen+1,sign));
er->ind = irv;
if(debug_regim) {
doCallAfter(D_InsRedVar(DVM000(idebrg),num_red,evc,ntype,ilen, loc_var, ilen+1,locindtype));
}
}
return;
}
void ReductionListIND2(SgExpression *gref)
{ reduction_list *er;
//looking through the reduction list
if(only_debug) return;
for(er = redl; er; er=er->next)
doCallAfter(InsertRedVar(gref,er->ind,(only_debug ? 0 : iplp)));
}
void ReductionListIND_Err()
{ reduction_list *er;
//looking through the reduction list
for(er = redl; er; er=er->next)
Error("Reduction statement inside the range of INDEPENDENT loop, '%s' is reduction variable", er->red_var->symbol()->identifier(), 255, indep_st);
}
void OffDoVarsOfNest(SgStatement *end_stmt)
{
SgStatement *parent;
SgForStmt *do_st;
parent = end_stmt->controlParent();
OffDoVar(parent->symbol());
if(!end_stmt->label()) // ENDDO is end of DO constuct
return;
parent = parent->controlParent();
while((do_st=isSgForStmt(parent)) && do_st->endOfLoop()
&& ( LABEL_STMTNO(do_st->endOfLoop()->thelabel)==LABEL_STMTNO(end_stmt->label()->thelabel))) {
OffDoVar(parent->symbol());
parent = parent->controlParent();
}
return;
}
/*
void RemoteVariableListIND()
{ IND_ref_list *el;
int ibg,ishg,ikind,ibuf,ishw,iaxis,ideb,iq;
SgSymbol *ar, *b;
SgExpression *ind_deb[7],*head, *shgref, *bgref;
int j, n, buf_size, shw_size, rank, static_sign;
SgValueExp c0(0),cm1(-1);
SgStatement *if_st,*end_st,*cp, *cp1,*endif_st,*else_st;
if(!IND_refs) return;
cp = cp1 = cur_st->controlParent();
if( !one_inquiry){
ishg = ndvm; shgref = DVM000(ishg);
ibg = ndvm+1; bgref = DVM000(ibg);
doAssignStmtAfter(ConstRef(0)); // dvm000(ishg) = 0
doAssignStmtAfter(ConstRef(0)); // dvm000(ibg) = 0
static_sign = 0;
}
else {
iq = nhpf++;
InitInquiryVar(iq);
if_st = doIfThenConstrForIND(HPF000(iq), 0, 1, 0, cur_st, cp);
cur_st = if_st;
doAssignTo_After(HPF000(iq), ConstRef(1)); // hpf000(iq) = 1 :inquiry has done
ishg = nhpf++; shgref = HPF000(ishg);
ibg = nhpf++; bgref = HPF000(ibg);
doAssignTo_After(shgref, ConstRef(0)); // hpf000(ishg) = 0
doAssignTo_After( bgref, ConstRef(0)); // hpf000(ibg) = 0
static_sign = 1;
cp = if_st;
}
ikind = ndvm++;
//looking through the IND_reference list
for(el=IND_refs; el; el=el->next){
ar = el->rmref->symbol();
rank = Rank(ar);
// looking through the index list of remote variable
//for(es= el->rmref->lhs(),n=0; es; es= es->rhs(),n++)
//
for(n = 0; n<7 && el->axis[n]; n++)
if( el->axis[n]->valueInteger() == 0)
ind_deb[n] = &(el->cons[n]->copy());
else
ind_deb[n] = &cm1.copy();
//allocating buffer header (for remote data) and arrays of shadow widths
buf_size = (el->nc) ? 2*(el->nc)+2 : 4; //memory size for buffer
if( !one_inquiry){
ibuf = ndvm;
ndvm+= buf_size;
b = dvmbuf; //or NULL
} else {
ibuf = nhpf;
nhpf+= buf_size;
b = hpfbuf;
}
ishw = ndvm;
shw_size = 2*rank;
//size = (buf_size > shw_size) ? buf_size : shw_size;
ndvm+= shw_size;
//generating inquiry for kind of data access
iaxis = ndvm;
for(j=n-1; j>=0; j--)
doAssignStmtAfter(el->axis[j]);
for(j=n-1; j>=0; j--)
doAssignStmtAfter(ReplaceFuncCall(el->coef[j]));
for(j=n-1; j>=0; j--)
doAssignStmtAfter(Calculate(el->cons[j]));
head = HeaderRef(el->rmref->symbol());
doAssignTo_After(DVM000(ikind), RemoteAccessKind(head, header_rf(b,ibuf,1),static_sign,iplp,iaxis,iaxis+n,iaxis+2*n,ishw,ishw+rank));
//SET_DVM(ishw);
SET_DVM(iaxis);
//generating IF(dvm000(ikind).EQ.3) THEN ...ELSE...ENDIF
if_st = doIfThenConstrForIND(DVM000(ikind), 3, 1, 1, cur_st, cp);
end_st = endif_st = if_st->lexNext()->lexNext(); //END IF statement
else_st = if_st->lexNext(); // ELSE statement
//IF(dvm000(ibg).EQ.0) THEN ...ENDIF
// hpf000(ibg)
if_st = doIfThenConstrForIND(bgref, 0, 1, 0, if_st, if_st);
cur_st = if_st;
doAssignTo_After(bgref,CreateBG(static_sign,1));//creating group of remote data buffer
where = else_st;
doAssignStmt(InsertRemBuf(bgref, header_rf(b,ibuf,1)));//inserting buffer in group
if(dvm_debug) {
ideb = ndvm;
for(j=n-1; j>=0; j--)
doAssignStmt(ReplaceFuncCall(ind_deb[j]));
InsertNewStatementBefore(D_RmBuf(head, GetAddresDVM( header_rf(b,ibuf,1)),n,ideb),else_st);
}
BufferHeaderCopy(b,ibuf, n, el);
cur_st = else_st; // generating ELSE body
//generating IF(dvm000(ikind).EQ.2) THEN ...ELSE...ENDIF
if_st = doIfThenConstrForIND(DVM000(ikind), 2, 1, 0, else_st, else_st);
end_st = if_st->lexNext(); //END IF statement
//IF(dvm000(ishg).EQ.0) THEN ...ENDIF
// hpf000(ishg)
if_st = doIfThenConstrForIND(shgref, 0, 1, 0, if_st, if_st);
cur_st = if_st;
CreateBoundGroup(shgref); //creating group of shadow edges
where = end_st;
doAssignStmt(InsertArrayBound(shgref, head, ishw, ishw+rank, 1)); //corner = 1 !!!
//inserting shadow in group
//ishsign = ndvm;
//maxsh = doShadowSignArray(el); see DepList(),doDepLengthArrays()
//doAssignStmt(InsertArrayBoundDep(shgref, head, ishw, ishw+rank, maxsh, ishsign));
cur_st = end_st;
ArrayHeaderCopy(n,el);
SET_DVM(ishw);
cur_st = endif_st;
}
if(one_inquiry)
cur_st = cur_st->lexNext();
//IF(dvm000(ishg).NE.0) THEN {executing SHADOW group} ENDIF
// hpf000(ishg)
if_st = doIfThenConstrForIND(shgref, 0, 0, 0, cur_st, cp1);
end_st = if_st->lexNext(); //END IF statement
cur_st = if_st;
doAssignStmtAfter(StartBound(shgref)); // starting exchange of shadow edges
FREE_DVM(1);
doAssignStmtAfter(WaitBound (shgref));// waiting completion of shadow edges exchange
FREE_DVM(1);
//IF(dvm000(ibg).NE.0) THEN {executing REMOTE group} ENDIF
// hpf000(ibg)
if_st = doIfThenConstrForIND(bgref, 0, 0, 0, end_st, cp1);
cur_st = if_st;
doAssignStmtAfter(LoadBG(bgref)); // starting load of buffer group
FREE_DVM(1);
doAssignStmtAfter(WaitBG(bgref));// waiting completion of buffer group load
FREE_DVM(1);
if( one_inquiry)
{SET_HPF(nhpf);}
else
{SET_HPF(1);}
return;
}
*/
void RemoteVariableListIND()
{ IND_ref_list *el;
int ibg,ishg,ikind,ibuf,ishw,iaxis,ideb,iq;
SgSymbol *ar, *b;
SgExpression *ind_deb[7],*head, *shgref, *bgref;
int j, n, buf_size, shw_size, rank, static_sign;
SgValueExp c0(0),cm1(-1);
SgStatement *if_st,*end_st,*cp, *cp1,*endif_st,*else_st;
if(!IND_refs) return;
cp = cp1 = cur_st->controlParent();
if( !one_inquiry){
ishg = ndvm; shgref = DVM000(ishg);
ibg = ndvm+1; bgref = DVM000(ibg);
doAssignStmtAfter(ConstRef(0)); // dvm000(ishg) = 0
doAssignStmtAfter(ConstRef(0)); // dvm000(ibg) = 0
static_sign = 0;
}
else {
iq = nhpf++;
InitInquiryVar(iq);
if_st = doIfThenConstrForIND(HPF000(iq), 0, 1, 0, cur_st, cp);
cur_st = if_st;
doAssignTo_After(HPF000(iq), ConstRef(1)); // hpf000(iq) = 1 :inquiry has done
ishg = nhpf++; shgref = HPF000(ishg);
ibg = nhpf++; bgref = HPF000(ibg);
doAssignTo_After(shgref, ConstRef(0)); // hpf000(ishg) = 0
doAssignTo_After( bgref, ConstRef(0)); // hpf000(ibg) = 0
static_sign = 1;
cp = if_st;
}
ikind = ndvm++;
//looking through the IND_reference list
for(el=IND_refs; el; el=el->next){
ar = el->rmref->symbol();
rank = Rank(ar);
// looking through the index list of remote variable
//for(es= el->rmref->lhs(),n=0; es; es= es->rhs(),n++)
for(n = 0; n<7 && el->axis[n]; n++)
if( el->axis[n]->valueInteger() == 0)
ind_deb[n] = &(el->cons[n]->copy());
else
ind_deb[n] = &cm1.copy();
//allocating buffer header (for remote data) and arrays of shadow widths
buf_size = (el->nc) ? 2*(el->nc)+2 : 4; //memory size for buffer
if( !one_inquiry){
ibuf = ndvm;
ndvm+= buf_size;
b = dvmbuf; //or NULL
} else {
ibuf = nhpf;
nhpf+= buf_size;
b = hpfbuf;
}
ishw = ndvm;
shw_size = 2*rank;
//size = (buf_size > shw_size) ? buf_size : shw_size;
ndvm+= shw_size;
//generating inquiry for kind of data access
iaxis = ndvm;
for(j=n-1; j>=0; j--)
doAssignStmtAfter(el->axis[j]);
for(j=n-1; j>=0; j--)
doAssignStmtAfter(ReplaceFuncCall(el->coef[j]));
for(j=n-1; j>=0; j--)
doAssignStmtAfter(Calculate(el->cons[j]));
head = HeaderRef(el->rmref->symbol());
doAssignTo_After(DVM000(ikind), RemoteAccessKind(head, header_rf(b,ibuf,1),static_sign,iplp,iaxis,iaxis+n,iaxis+2*n,ishw,ishw+rank));
//SET_DVM(ishw);
SET_DVM(iaxis);
//generating IF(dvm000(ikind).EQ.4) THEN ...ELSE...ENDIF
if_st = doIfThenConstrForIND(DVM000(ikind), 4, 1, 1, cur_st, cp);
end_st = endif_st = if_st->lexNext()->lexNext(); //END IF statement
else_st = if_st->lexNext(); // ELSE statement
//IF(dvm000(ibg).EQ.0) THEN ...ENDIF
// hpf000(ibg)
if_st = doIfThenConstrForIND(bgref, 0, 1, 0, if_st, if_st);
cur_st = if_st;
doAssignTo_After(bgref,CreateBG(static_sign,1));//creating group of remote data buffer
where = else_st;
doAssignStmt(InsertRemBuf(bgref, header_rf(b,ibuf,1)));//inserting buffer in group
if(dvm_debug) {
ideb = ndvm;
for(j=n-1; j>=0; j--)
doAssignStmt(ReplaceFuncCall(ind_deb[j]));
InsertNewStatementBefore(D_RmBuf(head, GetAddresDVM( header_rf(b,ibuf,1)),n,ideb),else_st);
}
BufferHeaderCopy(b,ibuf, n, el);
cur_st = else_st; // generating ELSE body
ArrayHeaderCopy(n,el);
//generating IF(dvm000(ikind).NE.1) THEN ...ELSE...ENDIF
if_st = doIfThenConstrForIND(DVM000(ikind), 1, 0, 0, else_st, else_st);
end_st = if_st->lexNext(); //END IF statement
//generating IF(dvm000(ikind).EQ.2) THEN {corner = 0} ELSE {corner = 1} ENDIF
cur_st = doIfThenConstrForIND(DVM000(ikind), 2, 1, 1, if_st, if_st);
doCallAfter(InsertArrayBound(shgref, head, ishw, ishw+rank, 0));
//inserting shadow in group with FullShadowSign=0
//icorn = ndvm++;
//doAssignTo_After(DVM000(icorn),new SgValueExp(0)); //corner = 0
cur_st = cur_st->lexNext(); // ELSE
doCallAfter(InsertArrayBound(shgref, head, ishw, ishw+rank, 1));
//inserting shadow in groupwith FullShadowSign=1
//doAssignTo_After(DVM000(icorn),new SgValueExp(1)); //corner = 1
//IF(dvm000(ishg).EQ.0) THEN ...ENDIF
// hpf000(ishg)
if_st = doIfThenConstrForIND(shgref, 0, 1, 0, if_st, if_st);
cur_st = if_st;
CreateBoundGroup(shgref); //creating group of shadow edges
where = end_st;
//doAssignStmt(InsertArrayBound(shgref, head, ishw, ishw+rank, icorn));
//inserting shadow in group
//ishsign = ndvm;
//maxsh = doShadowSignArray(el); see DepList(),doDepLengthArrays()
//doAssignStmt(InsertArrayBoundDep(shgref, head, ishw, ishw+rank, maxsh, ishsign));
//cur_st = end_st;
// ArrayHeaderCopy(n,el);
SET_DVM(ishw);
cur_st = endif_st;
}
if(one_inquiry)
cur_st = cur_st->lexNext();
//IF(dvm000(ishg).NE.0) THEN {executing SHADOW group} ENDIF
// hpf000(ishg)
if_st = doIfThenConstrForIND(shgref, 0, 0, 0, cur_st, cp1);
end_st = if_st->lexNext(); //END IF statement
cur_st = if_st;
doCallAfter(StartBound(shgref)); // starting exchange of shadow edges
doCallAfter(WaitBound (shgref));// waiting completion of shadow edges exchange
//IF(dvm000(ibg).NE.0) THEN {executing REMOTE group} ENDIF
// hpf000(ibg)
if_st = doIfThenConstrForIND(bgref, 0, 0, 0, end_st, cp1);
cur_st = if_st;
doAssignStmtAfter(LoadBG(bgref)); // starting load of buffer group
FREE_DVM(1);
doAssignStmtAfter(WaitBG(bgref));// waiting completion of buffer group load
FREE_DVM(1);
if( one_inquiry)
{SET_HPF(nhpf);}
else
{SET_HPF(1);}
return;
}
void InitInquiryVar(int iq)
{SgStatement *st;
st = cur_st;//save cur_st
cur_st = first_hpf_exec;
doAssignTo_After(HPF000(iq),ConstRef(0));
cur_st = st; //resave cur_st
}
/**************************************************************\
* Creating header copy *
* (calculating coefficients of address expression) *
\**************************************************************/
void BufferHeaderCopy(SgSymbol *b, int ibuf, int n, IND_ref_list *el)
// n - number of subscripts in array reference
// hpf000(ihpf) = getai(dvm000(ibuf))- header address
// hpf000(ihpf+i) = dvm000(ibuf+i) i=1,...,rank-1
// hpf000(ihpf+rank) = 1
// hpf000(ihpf+rank+1) = f(dvm000(ibuf+1 : ibuf+2*rank+2)) - calculated
//
// Copy BufferHeader(rank=3)
// _________ _________
// | adress | | | 1
// |_________| |_________|
// | * | <--- | * | 2
// |_________| |_________|
// | * | <--- | * | 3
// |_________| |_________|
// | 1 | | | 4
// |_________| |_________|
// |calculate| | | 5
// |_________| |_________|
// | . . . |
// |_________|
//
{int k,ind,rank;
rank = el->nc; // rank of BufferArray
ind = el->ind;
doAssignTo(header_rf(hpfbuf,ind,1),GetAddresDVM(header_rf(b,ibuf,1)));
for(k=2; k<rank+1; k++)
doAssignTo(header_rf(hpfbuf,ind,k),header_rf(b,ibuf,k));
if(rank){
doAssignTo(header_rf(hpfbuf,ind,rank+2), INDBufferHeaderNplus1(el,b,n,ibuf));
doAssignTo(header_rf(hpfbuf,ind,rank+1), new SgValueExp(1));
} else
doAssignTo_After(header_rf(hpfbuf,ind,2),header_rf(b,ibuf,2));
/*
for(k=1; k<rank; k++)
doAssignTo(HPF000(ind+k),DVM000(ibuf+k));
if(rank) {
doAssignTo(HPF000(ind+rank+1), INDBufferHeaderNplus1(el,n,ibuf));
doAssignTo(HPF000(ind+rank), new SgValueExp(1));
}
else
doAssignTo(HPF000(ind+1), DVM000(ibuf+1));
*/
}
SgExpression *INDBufferHeaderNplus1(IND_ref_list *rme, SgSymbol *ar, int ni, int ihead)
{
// n
// Header(n+1) = Header(n) - L1*S1 - SUMMA(Header(n-i+1) * Li * Si)
// i=2
// Si = 1, if i-th remote subscript is ':', else Si = 0
// Li = lower bound of i-th array dimension if ':', Li = Header(2*n-i+3) - minimum of
// of lower bound and upper bound of corresponding do-variable,if a*i+b
SgArrayType *artype;
SgExpression *ehead,*e;
SgSymbol *array;
int i,ind,j,n,k;
array = rme->rmref->symbol();
n = rme->nc;
//ar = NULL;
if(!(array->attributes() & DIMENSION_BIT)){// for continuing translation
return (new SgValueExp(0));
}
artype = isSgArrayType(array->type());
if(!artype) // error
return(new SgValueExp(0)); // for continuing translation of procedure
ind = n+1;
ehead = header_rf(ar,ihead,ind);
i=0; j=0;
for(k = 0; k<ni ; k++)//looking until first ':' or do-variable-use element
if( rme->axis[k]->valueInteger() != 0)
{j = 1; break;}
else
i++;
if(j == 0) //buffer is of one element
return(ehead);
if(rme->axis[k]->valueInteger() == -1) // :
if(!(e=LowerBound(array,i)))
return(new SgValueExp(0)); // for continuing translation of procedure
else
ehead = &(*ehead - e->copy());
else //a*i+b
ehead = &(*ehead - (*header_rf(ar,ihead,ind+n+1)));
for(k = k+1, i++; k<ni ; k++) //continue looking through the index list
if(rme->axis[k]->valueInteger() == -1){
ind--;
e = artype->sizeInDim(i);
if(e && e->variant() == DDOT && e->lhs())
ehead = & (*ehead - (*header_rf(ar,ihead,ind) *
(LowerBound(array,i)->copy())));
else
ehead = & (*ehead - (*header_rf(ar,ihead,ind))); // by default Li=1
}
else if(rme->axis[k]->valueInteger() > 0){
ind--;
ehead = & (*ehead - (*header_rf(ar,ihead,ind) * (*header_rf(ar,ihead,ind+n+1))));
}
return(ehead);
}
void ArrayHeaderCopy(int n, IND_ref_list *el)
{ int k, i, ind, rank, num;
SgSymbol *ar;
SgExpression *e;
ind = el->ind;
rank = el->nc;
ar = el->rmref->symbol(); //array symbol
doAssignTo_After(HPF000(ind+rank+1),HeaderRefInd(ar,n+2));//HeaderCopy(rank+1)=Header(n+2)
num = el->axis[0]->valueInteger();
i = rank;
if(num == - 1) { // 1-st index is ':'
doAssignTo_After(HPF000(ind+rank), new SgValueExp(1));//HeaderCopy(rank) = 1
i--;
} else {
if(num > 0) { // 1-st index is a*IND+b
doAssignTo_After(HPF000(ind+rank), el->coef[0]); //HeaderCopy(rank) = a
i--;
}
if(el->cons[0]->lhs() && !INTEGER_VALUE(el->cons[0]->lhs(),0)) // b != 0
doAssignTo_After(HPF000(ind+rank+1), &(*HPF000(ind+rank+1)+(*el->cons[0]->lhs())));
//HeaderCopy(rank+1) = HeaderCopy(rank+1) + b
}
for(k=1; k<n; k++){
num = el->axis[k]->valueInteger();
if(num == - 1) { // k-th index is ':'
doAssignTo_After(HPF000(ind+i),HeaderRefInd(ar,n-k+1));//HeaderCopy(i) = Header(k)
i--;
} else {
if(num > 0) { // k-th index is a*IND+b
e = INTEGER_VALUE(el->coef[k],1) ? HeaderRefInd(ar,n-k+1) : &(*HeaderRefInd(ar,n-k+1)*(*el->coef[k]));
doAssignTo_After(HPF000(ind+i), e); //HeaderCopy(i) = a * Header(k)
i--;
}
if(el->cons[k]->lhs() && !INTEGER_VALUE(el->cons[k]->lhs(),0)) // b!= 0
doAssignTo_After(HPF000(ind+rank+1), &(*HPF000(ind+rank+1)+(*HeaderRefInd(ar,n-k+1)*(*el->cons[k]->lhs())))); // HeaderCopy(rank+1) = HeaderCopy(rank+1) + b * Header(k)
}
}
doAssignTo_After(HPF000(ind), GetAddresDVM(HeaderRefInd(ar,1)));
return;
}
/**************************************************************\
* Looking for reduction operation *
\**************************************************************/
int NodeBefore=ASSIGN_STAT;
int CompareIfReduction(SgExpression *e1, SgExpression *e2)
{
if(!e1||!e2) return(0);
if(e1->variant() != e2->variant())
return(0);
if(e1->variant() != VAR_REF && e1->variant() != ARRAY_REF)
return(0);
if(e1->symbol() != e2->symbol())
return(0);
if(e1->variant() == ARRAY_REF && !ExpCompare(e1->lhs(),e2->lhs()))
return(0);
return (1);
}
/* Function returns number of reduction operation */
/* expr_ind is used in order to correspond position of reduction variable*/
/* if SgExpression e - if-condition 'rv ol er' expr_ind=0 */
/* if SgExpression e - if-condition 'er ol rv' expr_ind=1 */
/* else expr_ind=0 */
int ReductionFuncNumber(SgExpression *e,int expr_ind)
{
switch(e->variant())
{
case ADD_OP: return (1);
case MULT_OP: return (2);
case AND_OP: return (5);
case OR_OP: return (6);
case NEQV_OP: return (7);
case EQV_OP: return (8);
case XOR_OP: return (0);
case FUNC_CALL: {
char *red_name;
red_name = ((e->symbol())->identifier());
if(!strcmp(red_name, "max"))
return(3);
if(!strcmp(red_name, "min"))
return(4);
};break;
case LT_OP:
case LTEQL_OP: if (expr_ind==0) return (3); /*max*/
else return (4);/*min*/
case GT_OP:
case GTEQL_OP: if (expr_ind==0) return (4);
else return (3);
default: return (0);
}
return 0;
}
/* Function checks if pos_red is in newl-list */
int IsInNewList(SgExpression *pos_red, SgExpression *newl)
{
SgExpression *ExprList;
if (!newl) return 0;
if (!pos_red) return 0;
if (pos_red->variant()!=VAR_REF && pos_red->variant()!=ARRAY_REF) return 0;
for (ExprList=newl;ExprList&&(ExprList->variant()==EXPR_LIST);ExprList=ExprList->rhs())
{
if ((ExprList->lhs())->variant()==VAR_REF || (ExprList->lhs())->variant()==ARRAY_REF )
if (ExprList->lhs()->symbol()==pos_red->symbol())
return 1;
}
return 0;
}
/* Function checks if pos_red is already in reduction-list */
int IsInReductionList(SgExpression *pos_red)
{
reduction_list *rlist=redl;
if (!pos_red) return 0;
if(pos_red->variant()!=VAR_REF && pos_red->variant()!=ARRAY_REF) return 0;
for (;rlist;rlist=rlist->next)
{
if (rlist->red_var)
if (rlist->red_var->symbol()==pos_red->symbol())
return 1;
}
return 0;
}
/* Function checks if pos_red is reduction-variable *
* pos_red should be variable, shouldn`t be in newl-list, *
* pos_red shouldn`t be loop-variable and distribute-array*/
int IsReductionVariable(SgExpression *pos_red, SgExpression *newl)
{
if (!pos_red) return 0;
if (pos_red->variant()!=VAR_REF && pos_red->variant()!=ARRAY_REF)
{
return 0;
}
if (IsInNewList(pos_red,newl))
{
return 0;
}
if (IS_DISTR_ARRAY(pos_red->symbol()))
{
return 0;
}
if (isDoVar(pos_red->symbol()))
{
return 0;
}
return 1;
}
int IsError(SgExpression *pos_red, SgExpression *newl, int variant)
{
if (!pos_red) return 0;
if (IsInNewList(pos_red,newl)) return 0;
if (variant&&IsReductionVariable(pos_red,newl)) return 0;
if (IS_DISTR_ARRAY(pos_red->symbol())) return 0;
return 1;
}
int FindInExpr(SgExpression *red, SgExpression *expr)
{
if(!expr) return 0;
if (!red) return 0;
if (red->variant()!=VAR_REF && red->variant()!=ARRAY_REF) return 0;
if(red->variant()==VAR_REF && red->variant() == expr->variant())
{
if (red->symbol()== expr->symbol())
return 1;
else return 0;
}
if(red->variant()==ARRAY_REF && red->variant() == expr->variant())
{
if (red->symbol() == expr->symbol())
return(ExpCompare(red->lhs(),expr->lhs()));
}
return (FindInExpr(red,expr->lhs())+FindInExpr(red,expr->rhs()));
}
int IsReductionOp(SgStatement *st, SgExpression *newl)
{
reduction_list *rlist;
int variant=0;
SgExpression *ExprList1,*ExprList2,*Reduction;
ExprList1=ExprList2=Reduction=NULL;
if(st || newl)
{
if (st->variant() == ASSIGN_STAT)
{
ExprList1=st->expr(0);
ExprList2=st->expr(1);
//ExprList =st->expr(1);
if (ExprList2&&(ExprList2->variant() != FUNC_CALL))
{
if (ExprList2->lhs())
{
/* rv=rv op er */
if (CompareIfReduction(ExprList1,ExprList2->lhs()))
{
// ExprList =ExprList2->rhs();
Reduction=ExprList2->lhs();
variant=11;
}
else
{
if (ExprList2->rhs())
{
/* rv=er op rv */
if (CompareIfReduction(ExprList1,ExprList2->rhs()))
{
Reduction=ExprList2->rhs();
// ExprList =ExprList2->lhs();
variant=12;
}
}
}
}
}
else
{
/* rv=f(rv,er) or rv=f(er,rv) */
char *red_name;
red_name = ((ExprList2->symbol())->identifier());
if(!strcmp(red_name, "max")||!strcmp(red_name, "min"))
{
if (ExprList2->lhs()&&((ExprList2->lhs())->variant()==EXPR_LIST))
{
/* rv=f(rv,er) */
if (CompareIfReduction(ExprList1,ExprList2->lhs()->lhs()))
{
variant=21;
Reduction=(ExprList2->lhs())->lhs();
// ExprList=(ExprList2->lhs())->rhs();
}
else
{
/* rv=f(er,rv) */
if (ExprList2->lhs()->rhs()&&CompareIfReduction(ExprList1,ExprList2->lhs()->rhs()->lhs()))
{
variant=22;
Reduction=ExprList2->lhs()->rhs()->lhs();
// ExprList=ExprList2->lhs()->lhs();
}
}
}
}
if (!variant)
{
if (IsError(ExprList1,newl,variant))
err("Illegal statement in the range of parallel loop",94,st);
return (0);
}
}
}
if (IsError(ExprList1,newl,variant))
{
/*We need check variant 'if ( rv ol er ) rv = er' or 'if ( er ol rv ) rv = er'*/
if (NodeBefore!=LOGIF_NODE)
err("Illegal statement in the range of parallel loop",94,st);
return (0);
}
NodeBefore=ASSIGN_STAT;
if (Reduction&&variant)
{
if (IsReductionVariable(ExprList1,newl))
{
if (IsInReductionList(Reduction)||!ReductionFuncNumber(ExprList2,0))
{
err("Illegal statement in the range of parallel loop",94,st);
return (0);
}
rlist= new reduction_list;
if (rlist)
{
if (!redl) rlist->next=NULL;
else rlist->next=redl;
rlist->red_op=ReductionFuncNumber(ExprList2,0);
rlist->red_var=&(Reduction->copy());
if(rlist->red_var->variant() == ARRAY_REF)
rlist->red_var->setLhs(NULL);
redl=rlist;
}
else return 0;
return 1;
}
}
return 0;
}
else
return 0;
}
int IsLIFReductionOp(SgStatement *st, SgExpression *newl)
{
SgStatement *assign;
PTR_BFND abif;
int variant=0;
if(st || newl)
{
reduction_list *rlist;
/*'if ( rv ol er ) rv = er' or 'if ( er ol rv ) rv = er'*/
NodeBefore=LOGIF_NODE;
if (st&&(st->variant()==LOGIF_NODE))
{
/* assign = 'rv = er'*/
abif= BIF_BLOB1(st->thebif) ? BLOB_VALUE(BIF_BLOB1(st->thebif)):(PTR_BFND)NULL;
assign=new SgStatement(abif);
if (assign&&(assign->variant()==ASSIGN_STAT))
{
if (assign->expr(0)&&(assign->expr(0)->variant()==VAR_REF))
if (st->expr(0)&&((st->expr(0)->lhs()->variant()==VAR_REF)||(st->expr(0)->rhs()->variant()==VAR_REF)))
{
if (st->expr(0)->lhs()->variant()==VAR_REF)
{
if (st->expr(0)->lhs()->symbol()==assign->expr(0)->symbol())
if (!FindInExpr(st->expr(0)->lhs(),st->expr(0)->rhs())&&!FindInExpr(st->expr(0)->lhs(),assign->expr(1)))
{
/*if ( rv ol er ) rv = er*/
variant= 31;
/*fprintf(stderr,"variant 31\n");*/
}
}
else if (st->expr(0)->rhs()->symbol()==assign->expr(0)->symbol())
if (!FindInExpr(st->expr(0)->rhs(),st->expr(0)->lhs())&&!FindInExpr(st->expr(0)->rhs(),assign->expr(1)))
{
/*if ( er ol rv ) rv = er*/
variant= 32;
/*fprintf(stderr,"variant 32\n");*/
}
}
if (IsError(assign->expr(0),newl,variant))
{
err("Illegal statement in the range of parallel loop",94,st);
return (0);
}
if (assign->expr(0)&&variant)
{
if (IsReductionVariable(assign->expr(0),newl))
{
if (IsInReductionList(assign->expr(0))||!ReductionFuncNumber(st->expr(0),0))
{
err("Illegal statement in the range of parallel loop",94,st);
return (0);
}
rlist= new reduction_list;
if (rlist)
{
if (!redl) rlist->next=NULL;
else rlist->next=redl;
if (variant==31) rlist->red_op=ReductionFuncNumber(st->expr(0),0);
else rlist->red_op=ReductionFuncNumber(st->expr(0),1);
rlist->red_var=&(assign->expr(0)->copy());
if(rlist->red_var->variant()==ARRAY_REF)
rlist->red_var->setLhs(NULL);
redl=rlist;
}
else return 0;
return 1;
}
}
return 0;
}
else return 0;
}
}
else
return 0;
return 0;
}
/**************************************************************\
* Miscellaneous functions *
\**************************************************************/
int isNewVar(SgSymbol *s)
{SgExpression *enl, *el;
enl = indep_st->expr(0) ? indep_st->expr(0)->lhs() : indep_st->expr(0);//NEW variable list
for(el=enl; el; el=el->rhs()) {
if(s == el->lhs()->symbol()) // is NEW variable
return(1);
}
return(0);
}