From f08f46a536dbcba90b409396cdedfa875c56800a Mon Sep 17 00:00:00 2001 From: ALEXks Date: Mon, 4 Dec 2023 14:33:22 +0300 Subject: [PATCH] improved f2c convertation --- dvm/fdvm/trunk/fdvm/acc_f2c.cpp | 109 ++++-- dvm/fdvm/trunk/include/dvm.h | 2 +- .../_src/Transformations/convert_to_c.cpp | 347 +++++++++++++++++- 3 files changed, 429 insertions(+), 29 deletions(-) diff --git a/dvm/fdvm/trunk/fdvm/acc_f2c.cpp b/dvm/fdvm/trunk/fdvm/acc_f2c.cpp index 0f1e19c..f4c58c2 100644 --- a/dvm/fdvm/trunk/fdvm/acc_f2c.cpp +++ b/dvm/fdvm/trunk/fdvm/acc_f2c.cpp @@ -94,6 +94,7 @@ static map > insertAfter; static map 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 &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 &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 &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 &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 &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 &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 &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 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 > 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 tmp; + pair 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::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::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 tmp; + pair 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; diff --git a/dvm/fdvm/trunk/include/dvm.h b/dvm/fdvm/trunk/include/dvm.h index 43fc21f..c25913e 100644 --- a/dvm/fdvm/trunk/include/dvm.h +++ b/dvm/fdvm/trunk/include/dvm.h @@ -2075,7 +2075,7 @@ char *Check_Correct_Name(const char *name); /* acc_f2c.cpp */ void Translate_Fortran_To_C(SgStatement *stat, SgStatement *last, std::vector > &, int); -void Translate_Fortran_To_C(SgStatement *Stmt); +SgStatement* Translate_Fortran_To_C(SgStatement* Stmt, bool isSapforConv = false); SgSymbol* createNewFunctionSymbol(const char *name); void swapDimentionsInprivateList(void); diff --git a/sapfor/experts/Sapfor_2017/_src/Transformations/convert_to_c.cpp b/sapfor/experts/Sapfor_2017/_src/Transformations/convert_to_c.cpp index a95e7b6..2b3f7a6 100644 --- a/sapfor/experts/Sapfor_2017/_src/Transformations/convert_to_c.cpp +++ b/sapfor/experts/Sapfor_2017/_src/Transformations/convert_to_c.cpp @@ -14,7 +14,352 @@ #include "dvm.h" #include "convert_to_c.h" +#include "Utils/utils.h" +#include "Utils/SgUtils.h" + +using std::vector; +using std::string; +using std::set; + +extern "C" void Set_Function_Language(int); +extern "C" void Unset_Function_Language(); +extern "C" int out_upper_case; + +static SgStatement* createNewFunc(SgSymbol* sF, SgFile* file, SgProgHedrStmt* prog) +{ + SgStatement* st_hedr, * st_end; + SgExpression* fe, *arg_list = NULL; + + bool isMain = sF == NULL; + if (!sF) + sF = findSymbolOrCreate(file, "main", C_VoidType()); + else + sF->setType(C_VoidType()); + + // create fuction header + st_hedr = new SgStatement(FUNC_HEDR); + st_hedr->setSymbol(*sF); + fe = new SgFunctionRefExp(*sF); + fe->setSymbol(*sF); + st_hedr->setExpression(0, *fe); + + // create end of function + st_end = new SgStatement(CONTROL_END); + st_end->setSymbol(*sF); + + if (!isMain) + { + //fill global + first_do_par = prog; + + fe = st_hedr->expr(0); + int num = prog->numberOfParameters(); + for (int z = 0; z < num; ++z) + { + SgSymbol* arg = prog->parameter(z); + auto typ = C_Type(arg->type()); + if (arg->type()->variant() == T_STRING) + typ = C_PointerType(SgTypeChar()); + auto s = new SgSymbol(VARIABLE_NAME, arg->identifier(), *typ, *st_hedr); + + SgExpression* ae = new SgVarRefExp(s); + ae->setType(typ); + if (arg->type()->variant() == T_STRING) + ae = new SgPointerDerefExp(*ae); + + if (z == 0) + { + arg_list = new SgExprListExp(*ae); + fe->setLhs(arg_list); + } + else + { + auto el = new SgExpression(EXPR_LIST); + el->setLhs(NULL); + ae->setLhs(*el); + + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + } + } + + first_do_par = NULL; + } + + return st_hedr; +} + +static void shiftIntValue(SgExpression* ex, SgExpression* par, bool isLeft, const set& for_vars, bool& rep) +{ + if (ex) + { + if (ex->variant() == VAR_REF && for_vars.find(ex->symbol()->identifier()) != for_vars.end()) + { + if (isLeft) + par->setLhs(*new SgExpression(SUBT_OP, ex->copyPtr(), new SgValueExp(1))); + else + par->setRhs(*new SgExpression(SUBT_OP, ex->copyPtr(), new SgValueExp(1))); + rep = true; + } + + shiftIntValue(ex->lhs(), ex, true, for_vars, rep); + shiftIntValue(ex->rhs(), ex, false, for_vars, rep); + } +} + +static void findArrayRef(SgExpression* ex, const set& for_vars) +{ + if (ex) + { + if (ex->variant() == ARRAY_REF) + { + SgArrayRefExp* ref = (SgArrayRefExp*)ex; + SgExpression* list = ex->lhs(); + for (int z = 0; z < ref->numberOfSubscripts(); ++z) + { + bool rep = false; + if (for_vars.size()) + shiftIntValue(ref->subscript(z), list, true, for_vars, rep); + + if (!rep || for_vars.size() == 0) + { + auto sub = ref->subscript(z); + auto val = isSgValueExp(sub); + if (val && val->isInteger()) + val->setValue(val->intValue() - 1); + else + list->setLhs(*new SgExpression(SUBT_OP, sub->copyPtr(), new SgValueExp(1))); + + } + list = list->rhs(); + } + } + + findArrayRef(ex->lhs(), for_vars); + findArrayRef(ex->rhs(), for_vars); + } +} + +static void findLoopSymbols(SgExpression* ex, set& vars) +{ + if (ex) + { + if (ex->variant() == VAR_REF) + vars.insert(ex->symbol()->identifier()); + findLoopSymbols(ex->lhs(), vars); + findLoopSymbols(ex->rhs(), vars); + } +} + void covertToC(SgFile* file) { - printf("%s\n", file->firstStatement()->unparse(C_LANG)); + out_upper_case = 0; + + int funcNum = file->numberOfFunctions(); + SgStatement* global = file->firstStatement(); + + vector funcs; + + for (int i = 0; i < funcNum; ++i) + funcs.push_back(file->functions(i)); + + for (int i = funcs.size() - 1; i >= 0; --i) + { + SgStatement* st = funcs[i]; + SgStatement* last = st->lastNodeOfStmt(); + + //fill global dvm variables + cur_func = st; + bind_ = 1; + // + + SgStatement* func = createNewFunc(st->variant() == PROG_HEDR ? NULL : st->symbol()->copyPtr(), file, isSgProgHedrStmt(st)); + SgStatement* lastOfFunc = func->lastNodeOfStmt(); + global->insertStmtAfter(*func, *global); + + set for_vars; + vector dvm_dirs; + for (SgStatement* st = funcs[i]; st != last; ) + { + if (st->variant() == FOR_NODE) + for_vars.insert(isSgForStmt(st)->doName()->identifier()); + else if (st->variant() == CONTROL_END) + { + auto cp = st->controlParent(); + if (cp->variant() == FOR_NODE) + for_vars.erase(isSgForStmt(cp)->doName()->identifier()); + } + else if (st->variant() == DVM_PARALLEL_ON_DIR) + { + SgExpression* rule = st->expr(2); + findLoopSymbols(rule, for_vars); + } + + for (int z = 0; z < 3; ++z) + findArrayRef(st->expr(z), for_vars); + + if (isDVM_stat(st)) + { + SgStatement* next = st->lexNext(); + dvm_dirs.push_back(st->extractStmt()); + st = next; + } + else if(st->variant() == ALLOCATE_STMT || + st->variant() == DEALLOCATE_STMT) + { + SgStatement* next = st->lexNext(); + st->extractStmt(); + st = next; + } + else + st = st->lexNext(); + + if (st->variant() == DVM_PARALLEL_ON_DIR) + for_vars.clear(); + } + + string dvm_comm = ""; + int dir_pos = 0; + int dir_line = dvm_dirs.size() ? dvm_dirs[dir_pos]->lineNumber() : -1; + + for (SgStatement* st = funcs[i]; st != last; st = st->lexNext()) + { + int curr_line = st->lineNumber(); + while (dir_line < curr_line && dir_line != -1) + { + SgStatement* dir = dvm_dirs[dir_pos]; + if (dir->variant() == DVM_PARALLEL_ON_DIR) + { + vector rems; + vector addS; + + SgStatement* tmp0 = new SgAssignStmt(*new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "tmp0")), *dir->expr(0)); + SgStatement* tmp2 = new SgAssignStmt(*new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "tmp2")), *dir->expr(2)); + + SgExpression* list = dir->expr(1); + while (list) + { + SgExpression* item = list->lhs(); + if (item->variant() != REMOTE_ACCESS_OP) + { + string s = item->unparse(); + convertToLower(s); + addS.push_back(s); + } + else + rems.push_back(new SgAssignStmt(*new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "tmp1")), *item->lhs())); + list = list->rhs(); + } + + SgCExpStmt* conv0 = (SgCExpStmt*)Translate_Fortran_To_C(tmp0, true); + SgCExpStmt* conv2 = (SgCExpStmt*)Translate_Fortran_To_C(tmp2, true); + + Set_Function_Language(C_LANG); + string array = conv0->expr()->rhs()->unparse(); + string rule = conv2->expr()->rhs()->unparse(); + + for (auto& conv : rems) + { + SgCExpStmt* convE = (SgCExpStmt*)Translate_Fortran_To_C(conv, true); + string s = convE->expr()->rhs()->unparse(); + convertToLower(s); + addS.push_back(string("remote_access(") + s + ")"); + } + Unset_Function_Language(); + + char buf[1024]; + sprintf(buf, "#pragma dvm parallel([%s] on %s) ", rule.c_str(), array.c_str()); + string pragma = buf; + + for (int z = 0; z < addS.size(); ++z) + { + pragma += addS[z]; + if (z != addS.size() - 1) + pragma += ", "; + } + + if (dvm_comm.size()) + dvm_comm += "\n"; + dvm_comm += pragma; + } + else if (dir->variant() == ACC_END_REGION_DIR) + { + if (dvm_comm.size()) + dvm_comm += "\n"; + dvm_comm += " }"; + } + else if (dir->variant() == ACC_REGION_DIR) + { + if (dvm_comm.size()) + dvm_comm += "\n"; + + string type = ""; + if (dir->expr(0)) + { + type = dir->expr(0)->unparse(); + convertToLower(type); + } + dvm_comm += string("#pragma dvm region ") + type + "\n"; + dvm_comm += " {"; + } + else if (dir->variant() == ACC_GET_ACTUAL_DIR) + { + if (dvm_comm.size()) + dvm_comm += "\n"; + + SgStatement* tmp0 = new SgAssignStmt(*new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "tmp0")), *dir->expr(0)); + SgCExpStmt* conv0 = (SgCExpStmt*)Translate_Fortran_To_C(tmp0, true); + + Set_Function_Language(C_LANG); + string array = conv0->expr()->rhs()->unparse(); + Unset_Function_Language(); + + dvm_comm += "#pragma dvm get_actual(" + array + ")"; + } + + dir_pos++; + dir_line = (dir_pos < dvm_dirs.size()) ? dvm_dirs[dir_pos]->lineNumber() : -1; + } + + if (isSgExecutableStatement(st)) + { + SgStatement* conv = Translate_Fortran_To_C(st, true); + if (st->comments()) + { + string str(st->comments()); + vector result; + splitString(str, '\n', result); + str = ""; + for (int z = 0; z < result.size(); ++z) + { + str += "//" + result[z].substr(1, result[z].size()); + if (z != result.size() - 1) + str += "\n"; + } + conv->addComment(str.c_str()); + } + + if (dvm_comm.size()) + { + conv->addComment(dvm_comm.c_str()); + dvm_comm.clear(); + } + lastOfFunc->insertStmtBefore(*conv, *func); + //printf("on line %d\n%s\n", st->lineNumber(), conv->unparse(C_LANG)); + st = st->lastNodeOfStmt(); + } + } + funcs[i]->extractStmt(); + } + + /*string includes; + includes += "#include \n"; + includes += "#include \n"; + includes += "#include \n"; + + global->addComment(includes.c_str());*/ + + FILE* file_out = fopen((OnlyName(file->filename()) + ".cdv").c_str(), "w"); + fprintf(file_out, "%s\n", global->unparse(C_LANG)); + fclose(file_out); }