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

improved f2c convertation

Browse Source
This commit is contained in:
ALEXks
2023-12-04 14:33:22 +03:00
parent d48a73043a
commit f08f46a536
3 changed files with 429 additions and 29 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -94,6 +94,7 @@ static map<SgStatement*, vector<SgStatement*> > insertAfter;
static map<SgStatement*, SgStatement*> replaced;
static int arrayGenNum;
static int SAPFOR_CONV = 0;
#if TRACE
static int lvl_convert_st = 0;
@@ -2301,7 +2302,17 @@ static bool convertStmt(SgStatement* &st, pair<SgStatement*, SgStatement*> &retS
tt3->setRhs(new SgExprListExp());
tt3->rhs()->setLhs(&SgAssignOp(*new SgVarRefExp(newVar), *new SgVarRefExp(newVar) + *new SgValueExp(1)));
retSt = new SgForStmt(tt, &(*new SgVarRefExp(*newVar) < *new SgVarRefExp(cond)), tt3, NULL);
if (SAPFOR_CONV) // TODO: negative step
{
SgExprListExp* start = new SgExprListExp();
start->setLhs(SgAssignOp(*new SgVarRefExp(it), *ex1));
SgExprListExp* step = new SgExprListExp();
step->setLhs(&SgAssignOp(*new SgVarRefExp(it), *new SgVarRefExp(it) + *ex3));
retSt = new SgForStmt(start, &(*new SgVarRefExp(it) <= ex2->copy()), step, NULL);
}
else
retSt = new SgForStmt(tt, &(*new SgVarRefExp(*newVar) < *new SgVarRefExp(cond)), tt3, NULL);
if (cycleName)
{
@@ -2321,7 +2332,7 @@ static bool convertStmt(SgStatement* &st, pair<SgStatement*, SgStatement*> &retS
int sizeStack = bodySt.size();
for (int i = 0; i < sizeStack; ++i)
{
retSt->insertStmtAfter(*bodySt.top());
retSt->insertStmtAfter(*bodySt.top(), *retSt);
bodySt.pop();
}
newVars.push_back(cond);
@@ -2434,7 +2445,7 @@ static bool convertStmt(SgStatement* &st, pair<SgStatement*, SgStatement*> &retS
int sizeStack = bodySt.size();
for (int i = 0; i < sizeStack; ++i)
{
retSt->insertStmtAfter(*bodySt.top());
retSt->insertStmtAfter(*bodySt.top(), *retSt);
bodySt.pop();
}
@@ -2557,7 +2568,7 @@ static bool convertStmt(SgStatement* &st, pair<SgStatement*, SgStatement*> &retS
int sizeStack = bodySt.size();
for (int i = 0; i < sizeStack; ++i)
{
newIfStmt->insertStmtAfter(*bodySt.top());
newIfStmt->insertStmtAfter(*bodySt.top(), *newIfStmt);
bodySt.pop();
}
}
@@ -2695,6 +2706,30 @@ static bool convertStmt(SgStatement* &st, pair<SgStatement*, SgStatement*> &retS
needReplace = true;
}
else if (st->variant() == PRINT_STAT) // only for SAPFOR
{
if (SAPFOR_CONV == 0)
Error("Internal inconsistency in F->C convertation", "", 654, first_do_par);
SgInputOutputStmt* outStat = (SgInputOutputStmt*)st;
SgExpression* lhs = outStat->itemList();
convertExpr(lhs, lhs);
SgExpression* list = lhs;
while (list)
{
SgExpression* item = list->lhs();
if (item && item->variant() == STRING_VAL)
{
SgValueExp* exp = (SgValueExp*)item;
string str = exp->stringValue();
str += "\\n";
exp->setValue(strdup(str.c_str()));
}
list = list->rhs();
}
retSt = new SgCExpStmt(*new SgFunctionCallExp(*new SgSymbol(FUNCTION_NAME, "printf"), *lhs));
}
else if (st->variant() == PROC_STAT)
{
#if TRACE
@@ -2702,11 +2737,16 @@ static bool convertStmt(SgStatement* &st, pair<SgStatement*, SgStatement*> &retS
printf("convert call node\n");
lvl_convert_st += 2;
#endif
SgExpression *lhs = st->expr(0);
SgExpression *lhs = st->expr(0);
convertExpr(lhs, lhs);
if (lhs == NULL)
retSt = new SgCExpStmt(*new SgFunctionCallExp(*st->symbol()));
if (lhs == NULL || SAPFOR_CONV)
{
if (lhs)
retSt = new SgCExpStmt(*new SgFunctionCallExp(*st->symbol(), *lhs));
else
retSt = new SgCExpStmt(*new SgFunctionCallExp(*st->symbol()));
}
else
{
if (st->symbol()->identifier() == string("random_number"))
@@ -2810,7 +2850,7 @@ static bool convertStmt(SgStatement* &st, pair<SgStatement*, SgStatement*> &retS
else
{
retSt = st;
if (st->variant() != CONTROL_END && st->variant() != EXPR_STMT_NODE)
if (st->variant() != CONTROL_END && st->variant() != EXPR_STMT_NODE && first_do_par)
{
printf(" [STMT ERROR: %s, line %d, user line %d] unsupported variant of node: %s\n", __FILE__, __LINE__, first_do_par->lineNumber(), tag[st->variant()]);
if (unSupportedVars.size() != 0)
@@ -3177,11 +3217,18 @@ static void correctLabelsUse(SgStatement *firstStmt, SgStatement *lastStmt)
}
}
void Translate_Fortran_To_C(SgStatement *Stmt)
SgStatement* Translate_Fortran_To_C(SgStatement *Stmt, bool isSapforConv)
{
#if TRACE
printf("START: CONVERTION OF BODY ON LINE %d\n", number_of_loop_line);
#endif
if (isSapforConv)
{
SAPFOR_CONV = 1;
if (handlersOfFunction.size() == 0)
initF2C_FunctionCalls();
}
map<string, int> redArraysWithUnknownSize;
SgExpression* er = red_list;
for (reduction_operation_list* rsl = red_struct_list; rsl && er; rsl = rsl->next, er = er->rhs())
@@ -3189,6 +3236,8 @@ void Translate_Fortran_To_C(SgStatement *Stmt)
redArraysWithUnknownSize[rsl->redvar->identifier()] = RedFuncNumber(er->lhs()->lhs());
SgStatement *copyFSt = Stmt;
SgStatement* last = (Stmt == Stmt->lastNodeOfStmt()) ? Stmt->lastNodeOfStmt() : Stmt->lastExecutable();
vector<stack<SgStatement*> > copyBlock;
labelsExitCycle.clear();
autoTfmReplacing.clear();
@@ -3196,41 +3245,47 @@ void Translate_Fortran_To_C(SgStatement *Stmt)
cond_generator = 0;
unSupportedVars.clear();
bool needReplace = false;
pair<SgStatement*, SgStatement*> tmp;
pair<SgStatement*, SgStatement*> converted;
#if TRACE
printfSpaces(lvl_convert_st);
printf("convert Stmt\n");
lvl_convert_st += 2;
#endif
needReplace = convertStmt(copyFSt, tmp, copyBlock, 0, 0, redArraysWithUnknownSize);
needReplace = convertStmt(copyFSt, converted, copyBlock, 0, 0, redArraysWithUnknownSize);
#if TRACE
lvl_convert_st-=2;
printfSpaces(lvl_convert_st);
printf("end of convert Stmt\n");
#endif
if (needReplace)
if (needReplace && !isSapforConv)
{
char *comm = copyFSt->comments();
if (comm)
tmp.first->addComment(comm);
converted.first->addComment(comm);
if (tmp.first)
copyFSt->insertStmtBefore(*tmp.first, *copyFSt->controlParent());
if (converted.first)
copyFSt->insertStmtBefore(*converted.first, *copyFSt->controlParent());
copyFSt->deleteStmt();
}
for (set<int>::iterator i = unSupportedVars.begin(); i != unSupportedVars.end(); i++)
printf(" [EXPR ERROR: %s, line %d, %d] unsupported variant of node: %s\n", __FILE__, __LINE__, first_do_par->lineNumber(), tag[*i]);
if (unSupportedVars.size() != 0)
Error("Internal inconsistency in F->C convertation", "", 654, first_do_par);
if (first_do_par)
{
for (set<int>::iterator i = unSupportedVars.begin(); i != unSupportedVars.end(); i++)
printf(" [EXPR ERROR: %s, line %d, %d] unsupported variant of node: %s\n", __FILE__, __LINE__, first_do_par->lineNumber(), tag[*i]);
if (unSupportedVars.size() != 0)
Error("Internal inconsistency in F->C convertation", "", 654, first_do_par);
}
correctLabelsUse(Stmt, Stmt->lastExecutable());
correctLabelsUse(Stmt, last);
#if TRACE
printf("END: CONVERTION OF BODY ON LINE %d\n", number_of_loop_line);
#endif
return converted.first;
}
@@ -3265,13 +3320,13 @@ void Translate_Fortran_To_C(SgStatement *firstStmt, SgStatement *lastStmt, vecto
while (copyFSt != lastStmt)
{
bool needReplace = false;
pair<SgStatement*, SgStatement*> tmp;
pair<SgStatement*, SgStatement*> converted;
#if TRACE
printfSpaces(lvl_convert_st);
printf("convert Stmt\n");
lvl_convert_st += 2;
#endif
needReplace = convertStmt(copyFSt, tmp, copyBlock, countOfCopy, 0, redArraysWithUnknownSize);
needReplace = convertStmt(copyFSt, converted, copyBlock, countOfCopy, 0, redArraysWithUnknownSize);
#if TRACE
lvl_convert_st-=2;
printfSpaces(lvl_convert_st);
@@ -3279,16 +3334,16 @@ void Translate_Fortran_To_C(SgStatement *firstStmt, SgStatement *lastStmt, vecto
#endif
if (needReplace)
{
if (tmp.first)
if (converted.first)
{
char *comm = copyFSt->comments();
if (comm)
tmp.first->addComment(comm);
converted.first->addComment(comm);
copyFSt->insertStmtBefore(*tmp.first, *copyFSt->controlParent());
replaced[tmp.first] = copyFSt;
copyFSt->insertStmtBefore(*converted.first, *copyFSt->controlParent());
replaced[converted.first] = copyFSt;
for (int i = 0; i < countOfCopy; ++i)
copyBlock[i].push(&tmp.first->copy());
copyBlock[i].push(&converted.first->copy());
}
SgStatement *tmp1 = copyFSt;