improved f2c convertation
This commit is contained in:
ALEXks
@@ -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<string>& 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<string>& 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<string>& 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<SgStatement*> 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<string> for_vars;
|
||||
vector<SgStatement*> 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<SgStatement*> rems;
|
||||
vector<string> 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<string> 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 <math.h>\n";
|
||||
includes += "#include <stdlib.h>\n";
|
||||
includes += "#include <stdio.h>\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);
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user