improved f2c convertation

dvm/fdvm/trunk/fdvm/acc_f2c.cpp

@@ -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)
+        if (lhs == NULL || SAPFOR_CONV)
-            retSt = new SgCExpStmt(*new SgFunctionCallExp(*st->symbol()));
+        {
+            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)
+        if (converted.first)
-            copyFSt->insertStmtBefore(*tmp.first, *copyFSt->controlParent());
+            copyFSt->insertStmtBefore(*converted.first, *copyFSt->controlParent());
 
         copyFSt->deleteStmt();
     }
         
-    for (set<int>::iterator i = unSupportedVars.begin(); i != unSupportedVars.end(); i++)
+    if (first_do_par)
-        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)
+        for (set<int>::iterator i = unSupportedVars.begin(); i != unSupportedVars.end(); i++)
-        Error("Internal inconsistency in F->C convertation", "", 654, first_do_par);
+            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());
+                copyFSt->insertStmtBefore(*converted.first, *copyFSt->controlParent());
-                replaced[tmp.first] = copyFSt;
+                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;

dvm/fdvm/trunk/include/dvm.h

@@ -2075,7 +2075,7 @@ char *Check_Correct_Name(const char *name);
 char *Check_Correct_Name(const char *name);
 
 /* acc_f2c.cpp */
-void Translate_Fortran_To_C(SgStatement *stat, SgStatement *last, std::vector <std::stack <SgStatement*> > &, int);
+void Translate_Fortran_To_C(SgStatement *stat, SgStatement *last, std::vector <std::stack <SgStatement*> > &, int);
 SgStatement* Translate_Fortran_To_C(SgStatement* Stmt, bool isSapforConv = false);
 
 SgSymbol* createNewFunctionSymbol(const char *name);

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<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);
 }