Alexander_KS/SAPFOR
4
2
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fixed dead flag for functions

Browse Source
This commit is contained in:
ALEXks
2025-02-09 20:48:06 +03:00
parent c5d063b0da
commit d8aa5606ef
19 changed files with 897 additions and 241 deletions
Download Patch File Download Diff File Expand all files Collapse all files

141
dvm/fdvm/trunk/fdvm/acc_f2c.cpp
View File

@@ -103,7 +103,7 @@ static int lvl_convert_st = 0;
// functions
void convertExpr(SgExpression*, SgExpression*&);
void createNewFCall(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs);
static bool isPrivate(const string& array);
#if TRACE
void printfSpaces(int num)
@@ -191,6 +191,14 @@ static bool inNewVars(const char *name)
return ret;
}
static bool isNullSubscripts(SgExpression *subs)
{
if (subs && subs->attributeValue(0, NULL_SUBSCRIPTS))
return true;
else
return false;
}
static void addInListIfNeed(SgSymbol *tmp, int type, reduction_operation_list *tmpR)
{
stack<SgExpression*> allArraySub;
@@ -285,6 +293,14 @@ static void addRandStateIfNeeded(const string& name)
private_list = e;
}
void swapDimentionsInprivateList(SgExpression *pList)
{
private_list = pList;
red_struct_list = NULL;
swapDimentionsInprivateList();
private_list = NULL;
}
void swapDimentionsInprivateList()
{
SgExpression *tmp = private_list;
@@ -639,46 +655,53 @@ SgExpression* switchArgumentsByKeyword(const string& name, SgExpression* funcCal
if (argDims != dims)
{
char buf[256];
sprintf(buf, "Dimention of the %d formal and actual parameters of '%s' call is not equal", i, name.c_str());
sprintf(buf, "Rank of the %d dummy and actual arguments of '%s' call is not equal", i, name.c_str());
Error(buf, "", 651, first_do_par);
}
SgExpression* argList = NULL;
for (int j = 6; j >= 0; --j)
for (int j = MAX_DIMS; j >= 0; --j)
{
if (argInfo->elem(j) == NULL)
continue;
//TODO: not checked!!
SgExpression* val = Calculate(&(*UpperBound(resultExprCall[i]->symbol(), j) - *LowerBound(resultExprCall[i]->symbol(), j) + *LowerBound(s->parameter(i), j)));
if (val != NULL)
tmp = new SgExprListExp(*val);
else
tmp = new SgExprListExp(*new SgValueExp(int(0)));
if (j<dims)
{
SgExpression* val = Calculate(&(*UpperBound(resultExprCall[i]->symbol(), j) - *LowerBound(resultExprCall[i]->symbol(), j) + *LowerBound(s->parameter(i), j)));
if (val != NULL)
tmp = new SgExprListExp(*val);
else
tmp = new SgExprListExp(*new SgValueExp(int(0)));
tmp->setRhs(argList);
argList = tmp;
val = LowerBound(s->parameter(i), j);
if (val != NULL)
tmp = new SgExprListExp(*val);
else
tmp = new SgExprListExp(*new SgValueExp(int(0)));
tmp->setRhs(argList);
argList = tmp;
tmp->setRhs(argList);
argList = tmp;
val = LowerBound(s->parameter(i), j);
if (val != NULL)
tmp = new SgExprListExp(*val);
else
tmp = new SgExprListExp(*new SgValueExp(int(0)));
tmp->setRhs(argList);
argList = tmp;
}
}
if (isPrivate(resultExprCall[i]->symbol()->identifier())) //isPrivateArrayDummy==1
{
resultExprCall[i] = new SgArrayRefExp(*resultExprCall[i]->symbol());
}
else
{
SgArrayRefExp* arrRef = new SgArrayRefExp(*resultExprCall[i]->symbol());
for (int j = 0; j < dims; ++j)
arrRef->addSubscript(*new SgValueExp(0));
SgArrayRefExp* arrRef = new SgArrayRefExp(*resultExprCall[i]->symbol());
for (int j = 0; j < dims; ++j)
arrRef->addSubscript(*new SgValueExp(0));
tmp = new SgExprListExp(SgAddrOp(*arrRef));
tmp->setRhs(argList);
argList = tmp;
SgSymbol* aa = s->parameter(i);
SgTypeRefExp* typeExpr = new SgTypeRefExp(*C_Type(s->parameter(i)->type()));
resultExprCall[i] = new SgFunctionCallExp(*((new SgDerivedTemplateType(typeExpr, new SgSymbol(TYPE_NAME, "s_array")))->typeName()), *argList);
resultExprCall[i]->setRhs(typeExpr);
tmp = new SgExprListExp(SgAddrOp(*arrRef));
tmp->setRhs(argList);
argList = tmp;
SgSymbol* aa = s->parameter(i);
SgTypeRefExp* typeExpr = new SgTypeRefExp(*C_Type(s->parameter(i)->type()));
resultExprCall[i] = new SgFunctionCallExp(*((new SgDerivedTemplateType(typeExpr, new SgSymbol(TYPE_NAME, "s_array")))->typeName()), *argList);
resultExprCall[i]->setRhs(typeExpr);
}
}
}
}
@@ -925,7 +948,7 @@ static bool isPrivate(const string& array)
static bool matchPrototype(SgSymbol *funcSymb, SgExpression *&listArgs, bool isFunction)
{
bool ret = true;
bool casePrivateArray = false;
const string name(funcSymb->identifier());
vector<SgType*> *prototype = NULL;
@@ -1072,15 +1095,29 @@ static bool matchPrototype(SgSymbol *funcSymb, SgExpression *&listArgs, bool isF
}
else if (inCall->dimension() != inProt->dimension())
{
typeInCall = NULL;
if (isPrivate(argInCall->lhs()->symbol()->identifier()) && isPrivateArrayDummy(argInCall->lhs()->symbol()) != 1)
typeInCall = typeInProt;
else
typeInCall = NULL;
#ifdef DEB
printf("typeInCall NULL 2\n");
#endif
}
else
{
typeInCall = typeInProt;
if (for_kernel && isPrivate(argInCall->lhs()->symbol()->identifier()) || isPrivateArrayDummy(argInCall->lhs()->symbol())==1)
{
typeInCall = NULL;
casePrivateArray = true;
#ifdef DEB
printf("typeInCall NULL 2_p\n");
#endif
}
}
}
else
else // countOfSubscrInCall != 0
{
//TODO: not supported yet
if (inCall && inProt)
@@ -1092,12 +1129,12 @@ static bool matchPrototype(SgSymbol *funcSymb, SgExpression *&listArgs, bool isF
}
else
{
if (options.isOn(O_PL2) && dvm_parallel_dir->expr(0) == NULL)
if (options.isOn(O_PL2) && dvm_parallel_dir && dvm_parallel_dir->expr(0) == NULL)
dimSizeInProt = inCall->dimension();
const int arrayDim = isPrivate(argInCall->lhs()->symbol()->identifier()) ? inCall->dimension() : 1;
if (isSgArrayType(typeInProt) && (!options.isOn(O_PL2) || dvm_parallel_dir->expr(0) != NULL)) // inconsistency
if (isSgArrayType(typeInProt) && (!options.isOn(O_PL2) || !for_kernel || dvm_parallel_dir && dvm_parallel_dir->expr(0) != NULL)) // inconsistency
{
if (inCall->dimension() == inProt->dimension())
{
@@ -1208,7 +1245,7 @@ static bool matchPrototype(SgSymbol *funcSymb, SgExpression *&listArgs, bool isF
}
}
else
; //TODO
printf("typeInCall NULL 11\n"); //TODO
}
}
@@ -1228,14 +1265,15 @@ static bool matchPrototype(SgSymbol *funcSymb, SgExpression *&listArgs, bool isF
if (CompareKind(typeInProt, typeInCall))
typeInCall = typeInProt;
}
}
} // end of type analysis
//----------------------------------------------------------------------------------------------------
if (typeInProt != typeInCall)
{
char buf[256];
sprintf(buf, "Can not match the %d argument of '%s' procedure", i + 1, name.c_str());
Error(buf, "", 656, first_do_par);
ret = false;
if (!casePrivateArray)
Error(buf, "", 656, first_do_par);
//ret = false;
}
else if (argInCall->lhs()->variant() == ARRAY_REF)
{
@@ -1253,7 +1291,7 @@ static bool matchPrototype(SgSymbol *funcSymb, SgExpression *&listArgs, bool isF
{
if (dimSizeInProt == 0)
{
if (isFunction)
//if (isFunction) //04.02.25 podd
{
SgExpression* arrayRef = argInCall->lhs();
convertExpr(arrayRef, arrayRef);
@@ -1307,7 +1345,9 @@ static bool matchPrototype(SgSymbol *funcSymb, SgExpression *&listArgs, bool isF
}
else
{
SgExpression* arr = argInCall->lhs();
SgExpression* arr = argInCall->lhs();
if (!isNullSubscripts(arr->lhs()))
convertExpr(arr, arr);
if (options.isOn(O_PL2))
{
@@ -1316,14 +1356,23 @@ static bool matchPrototype(SgSymbol *funcSymb, SgExpression *&listArgs, bool isF
cast = C_PointerType(C_Type(typeInProtSave->baseType()));
else
cast = C_PointerType(C_Type(typeInProtSave));
if (for_kernel && isPrivate(arr->symbol()->identifier()) || isPrivateArrayDummy(arr->symbol())==2)
{
cast = C_PointerType(C_VoidType());
}
argInCall->setLhs(*new SgCastExp(*cast, SgAddrOp(*arr)));
}
else
argInCall->setLhs(SgAddrOp(*arr));
{
if (for_kernel && isPrivate(arr->symbol()->identifier()) || isPrivateArrayDummy(arr->symbol())==2)
argInCall->setLhs(*new SgCastExp(*C_PointerType(C_VoidType()), SgAddrOp(*arr)));
else
argInCall->setLhs(SgAddrOp(*arr));
}
}
}
}
}
} //end of ARRAY_REF
else
{
SgExpression* arg = argInCall->lhs();
@@ -1337,7 +1386,7 @@ static bool matchPrototype(SgSymbol *funcSymb, SgExpression *&listArgs, bool isF
arg->setType(typeCopy);
}
if (isFunction)
//if (isFunction) // 04.02.25 podd
convertExpr(arg, arg);
if (selector)
@@ -2752,7 +2801,7 @@ static bool convertStmt(SgStatement* &st, pair<SgStatement*, SgStatement*> &retS
lvl_convert_st += 2;
#endif
SgExpression *lhs = st->expr(0);
convertExpr(lhs, lhs);
//convertExpr(lhs, lhs); // !!!! 04.02.25 podd
if (lhs == NULL || SAPFOR_CONV)
{