fixed dead flag for functions

2025-02-09 20:48:06 +03:00
parent c6b09ad285
commit 68c779790d
19 changed files with 897 additions and 241 deletions
--- a/dvm/fdvm/trunk/fdvm/calls.cpp
+++ b/dvm/fdvm/trunk/fdvm/calls.cpp
@@ -41,7 +41,9 @@ int isStatementFunction(SgSymbol *s);
 int isHeaderNode(graph_node *gnode);
 int isDeadNode(graph_node *gnode);
 int isNoBodyNode(graph_node *gnode);
-void PrototypeOfFunctionFromOtherFile(graph_node *node, SgStatement *after);
+void InsertPrototypesOfFunctionFromOtherFile(graph_node *node, SgStatement *after);
+void PrototypeOfFunctionFromOtherFile(graph_node *node, SgStatement *after, argument_numbers *arg_numbs);
+void InsertCopiesOfProcedure(graph_node *ndl, SgStatement *after);
 graph_node_list  *addToNodeList(graph_node_list *pnode, graph_node *gnode);
 graph_node_list  *delFromNodeList(graph_node_list *pnode, graph_node *gnode);
 graph_node_list  *isInNodeList(graph_node_list *pnode, graph_node *gnode);
@@ -58,6 +60,7 @@ void ScanSymbolTable(SgFile *f);
 void ScanTypeTable(SgFile *f);
 void printSymb(SgSymbol *s);
 void printType(SgType *t);
+void replaceVectorRef(SgExpression *e);
 //-------------------------------------------------------------------------------------
 extern SgExpression *private_list;
 extern map <string, vector<vector<SgType*> > > interfaceProcedures;
@@ -103,7 +106,7 @@ int IsInternalProcedure(SgSymbol *s)

 SgStatement *hasInterface(SgSymbol *s)
 {
-      return (ATTR_NODE(s) ? GRAPHNODE(s)->st_interface : NULL);
+    return (ATTR_NODE(s) ? GRAPHNODE(s)->st_interface : NULL);
 }

 void SaveInterface(SgSymbol *s, SgStatement *interface)
@@ -140,6 +143,25 @@ int isInParameter(SgSymbol *s, int i)
 {
    return (s && ((SgFunctionSymb *) s)->parameter(i) && (((SgFunctionSymb *) s)->parameter(i)->attributes() & IN_BIT) ? 1 : 0);
 }
+
+int isArrayParameter(SgSymbol *s, int i)
+{
+    return (s && ((SgFunctionSymb *) s)->parameter(i) && (((SgFunctionSymb *) s)->parameter(i)->attributes() & DIMENSION_BIT) ? 1 : 0);
+}
+
+int isArrayParameterWithAssumedShape(SgSymbol *s, int i)
+{
+    return (isArrayParameter(s,i) && AssumedShape(isSgArrayType(((SgFunctionSymb *) s)->parameter(i)->type())->getDimList()));
+}
+
+int isPrivateArrayDummy(SgSymbol *s)
+{
+   int *private_attr = (int *) s->attributeValue(0, DUMMY_PRIVATE_AR);
+   if (!private_attr) 
+       return 0;
+   else
+       return *private_attr;   
+}
 
 SgSymbol *ProcedureSymbol(SgSymbol *s)
 {
@@ -204,6 +226,7 @@ void MarkAsCalled(SgSymbol *s)
 {
    graph_node *gnode;
    edge *gedge;
+
    if (!ATTR_NODE(s))
        return;
    gnode = GRAPHNODE(s);
@@ -215,6 +238,21 @@ void MarkAsCalled(SgSymbol *s)

 }

+void MarkPrivateArgumentsOfRoutine(SgSymbol *s, SgExpression *private_args)
+{
+     SgExpression *el; 
+     for (el=private_args; el; el=el->rhs())
+     {
+          SgSymbol *arg = el->lhs()->symbol();
+          if (IS_ARRAY(arg) && !IS_DVM_ARRAY(arg))
+          {
+              int i = findParameterNumber(s,arg->identifier());
+              if (i>=0)
+                  addArgumentNumber(findParameterNumber(s,arg->identifier()), s); 
+          }    
+     } 
+}
+
 void MakeFunctionCopy(SgSymbol *s)
 {
    SgSymbol *s_header;
@@ -262,11 +300,13 @@ void InsertCalledProcedureCopies()
        {
            if (ndl->st_header && current_file_id == ndl->file_id)  //procedure from current_file
            {
-                ndl->st_copy = InsertProcedureCopy(ndl->st_header, ndl->st_header->symbol(), ndl->is_routine, after); //C_Cuda ? mod_gpu : mod_gpu->lexNext());
+                InsertCopiesOfProcedure(ndl, after);
                n++;
            }
            else     //procedure from other file
-                PrototypeOfFunctionFromOtherFile(ndl,after);
+             {
+                InsertPrototypesOfFunctionFromOtherFile(ndl,after);
+             }

            ndl->count = 0;
            ndl->st_interface = NULL;
@@ -345,11 +385,181 @@ int HasDerivedTypeVariables(SgStatement *header)
    return 0;
 }

-SgStatement *InsertProcedureCopy(SgStatement *st_header, SgSymbol *sproc, int is_routine, SgStatement *after)
+argument_numbers *GetFirstLenPlus(argument_numbers *source, int source_len, int list_len)
 {
+ // copy first (list_len+1) elements of source
+    if (list_len == source_len)
+        return NULL;
+    argument_numbers *cur_list, *source_list, *new_list, *new_elem;
+    new_list = new argument_numbers; 
+    new_list->number = source->number;
+    new_list->next = NULL;
+    int i;
+    for (i=2, cur_list=new_list, source_list = source->next; i<=list_len+1; i++, source_list = source_list->next)
+    {   
+            new_elem  = new argument_numbers; 
+            new_elem->number = source_list->number; 
+            new_elem->next=NULL;
+            cur_list->next = new_elem;
+            cur_list = new_elem;
+    }
+    return new_list;
+}
+
+argument_numbers *elementByValue(int numb, argument_numbers *nlist)
+{
+    for (; nlist; nlist=nlist->next)
+        if (nlist->number == numb)
+            return nlist;
+    return NULL;
+}
+
+argument_numbers *element(int n, argument_numbers *nlist)
+{
+    for (int i=1; nlist; nlist=nlist->next, i++)
+        if (i == n)
+            return nlist;
+    return NULL;
+}
+
+int numberOfElements(argument_numbers *nlist)
+{
+    int i;
+    for (i=0; nlist; nlist=nlist->next, i++)
+         ;
+    return i;
+}
+
+void printValueList(argument_numbers *nlist)
+{
+    printf(" (");
+    for (; nlist; nlist=nlist->next)
+         printf("%d ",nlist->number);
+    printf(")  ");
+}  
+
+argument_numbers *GetNextWithChange(argument_numbers *source, int source_len, argument_numbers *nlist, int list_len)
+{
+    int i;
+    argument_numbers *elem, *source_elem;
+    for (i=1, elem=nlist; elem; i++, elem=elem->next)
+        if ( elem->number == (source_elem=element(source_len+i-list_len, source))->number )
+            break;
+
+    if (i == 1) return NULL;
+    elem = element(i-1, nlist); //element with serial number i-1
+    int numb = elem->number;
+    source_elem = elementByValue(numb, source)->next;
+    for (int j=i-1; j<=list_len; j++, elem=elem->next, source_elem=source_elem->next)
+        elem->number = source_elem->number; 
+
+    return nlist;
+}
+
+argument_numbers *GetNextNumberList(argument_numbers *source, argument_numbers *nlist)
+{
+    if (!source) return NULL;
+    if (!nlist)
+    {
+        nlist = new argument_numbers;
+        nlist->next = NULL;
+        nlist->number = source->number; 
+        return nlist;
+    }
+    int source_len = numberOfElements(source);
+    int list_len = numberOfElements(nlist);
+    argument_numbers * last_elem = element(list_len, nlist); 
+    argument_numbers *last_in_source = element(source_len, source);  
+
+    if (list_len == source_len) return NULL;
+
+    argument_numbers *elem_in_source = elementByValue(last_elem->number, source);
+    if (elem_in_source != last_in_source)
+    {   //get next in row
+        last_elem->number = elem_in_source->next->number;
+        return nlist; 
+    }
+    else if ((nlist = GetNextWithChange(source, source_len, nlist, list_len)))
+        return nlist;
+    else
+        return GetFirstLenPlus(source, source_len, list_len);
+}
+
+argument_numbers *correctArgList(argument_numbers *arg_numbs, SgStatement *st_header)
+{
+     SgSymbol *s = st_header->symbol();
+     int i;
+    
+     argument_numbers *numb_list=NULL, *elem;
+     for (i=0; arg_numbs; arg_numbs=arg_numbs->next, i++)
+     {      
+         if ( !isArrayParameterWithAssumedShape(s, arg_numbs->number) )
+         {       
+                 elem = new argument_numbers;
+                 elem->number = arg_numbs->number;
+
+             if (numb_list)
+             {  
+                 elem->next = numb_list;
+                 numb_list =elem;
+             }
+             else 
+                 elem->next = NULL;
+                 numb_list = elem;
+         } 
+     }        
+     return numb_list;
+}
+
+void InsertCopiesOfProcedure(graph_node *ndl, SgStatement *after)
+{
+    //insert copies of procedure after statement 'after'
+    argument_numbers *numb_list = NULL;
+    ndl->st_copy = InsertProcedureCopy(ndl->st_header, ndl->st_header->symbol(), ndl->is_routine, numb_list, after);
+    ndl->st_copy_first = ndl->st_copy;
+
+    if (ndl->arg_numbs)
+    {
+        argument_numbers *arg_numbs = correctArgList(ndl->arg_numbs, ndl->st_header);
+        while ((numb_list = GetNextNumberList(arg_numbs, numb_list)))
+            ndl->st_copy = InsertProcedureCopy(ndl->st_header, ndl->st_header->symbol(), ndl->is_routine, numb_list, after);       
+    }    
+}
+
+SgExpression *PrivateArrayDummyList(SgStatement *new_header, argument_numbers *arg_numbs)
+{
+    SgSymbol *s = new_header->symbol();
+    SgExpression *pList = NULL;
+    SgExpression *ae;
+    int *id;
+    int n = ((SgFunctionSymb *)s)->numberOfParameters();
+    for (int i = 0; i < n; i++)
+    {
+        SgSymbol *sarg = ((SgFunctionSymb *)s)->parameter(i);
+        if (isArrayParameterWithAssumedShape(s, i))
+        {
+            id = new int;
+            *id = 1;
+        } 
+        else if (arg_numbs && elementByValue(i, arg_numbs)) 
+        { 
+            id = new int;
+            *id = 2;
+        }
+        else
+            continue;
+        sarg->addAttribute(DUMMY_PRIVATE_AR, (void *)id, sizeof(int));
+        ae =  new SgArrayRefExp(*sarg);
+        ae ->setType(sarg->type());
+        pList = AddListToList(pList, new SgExprListExp(*ae));       
+    }
+    return pList;
+}
+
+SgStatement *InsertProcedureCopy(SgStatement *st_header, SgSymbol *sproc, int is_routine, argument_numbers *arg_numbs, SgStatement *after)
+{    //InsertProcedureCopy(ndl->st_header, ndl->st_header->symbol(), ndl->is_routine, after)
    //insert copy of procedure after statement 'after'
    SgStatement *new_header, *end_st;
-    
    SgSymbol *new_sproc = &sproc->copySubprogram(*after);
    new_header = after->lexNext(); // new procedure header  //new_sproc->body()
    SYMB_SCOPE(new_sproc->thesymb) = mod_gpu->thebif;
@@ -362,13 +572,15 @@ SgStatement *InsertProcedureCopy(SgStatement *st_header, SgSymbol *sproc, int is
        int flagHasDerivedTypeVariables = HasDerivedTypeVariables(new_header); 
       
        end_st = new_header->lastNodeOfStmt();
-        ConvertArrayReferences(new_header->lexNext(), end_st);  //!!!! 
+     
+        private_list =  PrivateArrayDummyList(new_header,arg_numbs);
+        ConvertArrayReferences(new_header->lexNext(), end_st);
+       
+        TranslateProcedureHeader_To_C(new_header,arg_numbs);

-        TranslateProcedureHeader_To_C(new_header);
+        // extract specification statements and add local arrays to private_list
+        ExtractDeclarationStatements(new_header); 

-        private_list = NULL;
-
-        ExtractDeclarationStatements(new_header);
        SgSymbol *s_last = LastSymbolOfFunction(new_header);
        if (sproc->variant() == FUNCTION_NAME)
        {  
@@ -378,20 +590,19 @@ SgStatement *InsertProcedureCopy(SgStatement *st_header, SgSymbol *sproc, int is
           
            InsertReturnBeforeEnd(new_header, end_st);
        }
-
        swapDimentionsInprivateList();
-        //std::vector < std::stack < SgStatement*> > zero = std::vector < std::stack < SgStatement*> >(0);
-        //cur_func = after;
-        Translate_Fortran_To_C(new_header, end_st, 0, st_header);   //TranslateProcedure_Fortran_To_C(after->lexNext());
-        cur_func = after; 
+
+        Translate_Fortran_To_C(new_header, end_st, 0, st_header);
+        cur_func = after;
        if (sproc->variant() == FUNCTION_NAME)
        {   
            new_header->insertStmtAfter(*Declaration_Statement(new_sproc), *new_header);
            ChangeReturnStmts(new_header, end_st, returnSymbol);
        }
+       
        if(!flagHasDerivedTypeVariables) //!!! derived data type is not supported          
            MakeFunctionDeclarations(new_header, s_last);
-        
+       
        newVars.clear();
        private_list = NULL;
        // generate prototype of function and insert it before 'after'
@@ -405,7 +616,7 @@ SgStatement *InsertProcedureCopy(SgStatement *st_header, SgSymbol *sproc, int is
        new_header->addComment("\n");  // add comment (empty line) to new procedure header
        ReplaceInterfaceBlocks(new_header);
    }
-    
+
    return(new_header);
 }

@@ -434,13 +645,15 @@ void doPrototype(SgStatement *func_hedr, SgStatement *block_header, int static_f
    block_header->insertStmtAfter(*st, *block_header);        //before->insertStmtAfter(*st,*before->controlParent());
 }

-SgStatement  *TranslateProcedureHeader_To_C(SgStatement *new_header)
+SgStatement  *TranslateProcedureHeader_To_C(SgStatement *new_header, argument_numbers *arg_numbs)
 {
    SgSymbol *new_sproc =  new_header->symbol();
    SgFunctionRefExp *fe = new SgFunctionRefExp(*new_sproc);
    fe->setSymbol(*new_sproc);
    new_header->setExpression(0, *fe);
+
    SgSymbol *returnSymbol = getReturnSymbol(new_header, new_sproc);
+
    if (new_sproc->variant() == PROCEDURE_NAME)
        new_sproc->setType(C_VoidType());
    else                     // FUNCTION_NAME
@@ -449,14 +662,30 @@ SgStatement  *TranslateProcedureHeader_To_C(SgStatement *new_header)
        new_sproc->setType(C_Type(returnSymbol->type()));
    }
    fe->setType(new_sproc->type());
-    fe->setLhs(FunctionDummyList(new_sproc));
+    fe->setLhs(FunctionDummyList(new_sproc, new_header, arg_numbs));
    BIF_LL3(new_header->thebif) = NULL; 
    new_header->addDeclSpec(BIT_CUDA_DEVICE);
    new_header->setVariant(FUNC_HEDR); 
+
    return new_header;
 }

-void PrototypeOfFunctionFromOtherFile(graph_node *node, SgStatement *after)
+void InsertPrototypesOfFunctionFromOtherFile(graph_node *node, SgStatement *after)
+{
+    if (options.isOn(RTC)) return;
+    //insert prototypes of procedure after statement 'after'
+    argument_numbers *numb_list = NULL;
+    PrototypeOfFunctionFromOtherFile(node, after, numb_list);
+
+    if (node->arg_numbs)
+    {
+        argument_numbers *arg_numbs = correctArgList(node->arg_numbs, node->st_header);
+        while ((numb_list = GetNextNumberList(arg_numbs, numb_list)))
+            PrototypeOfFunctionFromOtherFile(node, after, numb_list);
+    }    
+}
+
+void PrototypeOfFunctionFromOtherFile(graph_node *node, SgStatement *after, argument_numbers *arg_numbs)
 {
    if (options.isOn(RTC)) return;
    if(!node->st_interface) return;
@@ -469,9 +698,9 @@ void PrototypeOfFunctionFromOtherFile(graph_node *node, SgStatement *after)
    SYMB_SCOPE(sh->thesymb) = current_file->firstStatement()->thebif;
    SgStatement *new_hedr = &(interface->copy()); 
    new_hedr->setSymbol(*sh);
-    TranslateProcedureHeader_To_C(new_hedr);
+    TranslateProcedureHeader_To_C(new_hedr, arg_numbs);
    doPrototype(new_hedr, mod_gpu, !STATIC);
-    
+
    //current_file->firstStatement()->insertStmtAfter(*new_hedr, *current_file->firstStatement()); 
    //SYMB_FUNC_HEDR(sh->thesymb) = new_hedr->thebif; 

@@ -483,12 +712,11 @@ void PrototypeOfFunctionFromOtherFile(graph_node *node, SgStatement *after)
    return;
 }

-SgExpression *FunctionDummyList(SgSymbol *s)
+SgExpression *FunctionDummyList(SgSymbol *s, SgStatement *st_header, argument_numbers *arg_numbs)
 {
    SgExpression *arg_list = NULL, *ae = NULL;

    int n = ((SgFunctionSymb *)s)->numberOfParameters();
-    
    //insert at 0-th position inf-argument
    //check for optional arguments, if some argunemt exist with optional then add argument-mask
    
@@ -548,21 +776,73 @@ SgExpression *FunctionDummyList(SgSymbol *s)
                }
                dimList = dimList->rhs();
            }
+            int rank =  Rank(sarg);
+            SgType *ar_type = sarg->type();
+            SgType *tbase = C_Type(sarg->type()->baseType());
+            SgType *t = C_PointerType(tbase);
+            SgSymbol *new_arg = &sarg->copy();//new SgVariableSymb(sarg->identifier(), *t, *st_header);
+            //new_arg->thesymb->entry.var_decl.local = IO; // is new dummy argument
+            new_arg->setType(t);
+            ae = new SgVarRefExp(new_arg);
+            //ae->setType(t);

-            SgType *t = C_PointerType(C_Type(sarg->type()->baseType()));
-            sarg->setType(t);
-            ae = new SgVarRefExp(sarg);
-            ae->setType(t);
            if (needChanged)
-            {
-                sarg->setType(new SgDerivedTemplateType(new SgTypeRefExp(*t), new SgSymbol(TYPE_NAME, "s_array")));
-                ae = new SgVarRefExp(sarg);
+            {                                        
+                    SgExpression *ce = new SgExprListExp(*new SgTypeRefExp(*tbase));
+                    SgDerivedTemplateType *tpc = new SgDerivedTemplateType(ce, private_array_class); 
+                    tpc->addArg(new SgValueExp(rank));
+                    new_arg->setType(tpc);
+                    //int *id = new int;
+                    //*id = 1;
+                    //sarg->addAttribute(DUMMY_PRIVATE_AR, (void *)id, sizeof(int));
+                    ae = &SgAddrOp(*new SgVarRefExp(new_arg));                              
+                //}
+                //else
+                //{                   else
+
+                //    sarg->setType(new SgDerivedTemplateType(new SgTypeRefExp(*t), new SgSymbol(TYPE_NAME, "s_array")));
+                //    ae = new SgVarRefExp(sarg);
+                //}
                ae = new SgExprListExp(*ae);
                arg_list = AddListToList(arg_list, ae);
                continue;
            }

-            //ae->setType(C_ReferenceType(sarg->type())); 
+            if (arg_numbs && elementByValue(i, arg_numbs)) 
+            {        
+                     //SgType *tp = C_Type(sarg->type()->baseType()); 
+                     t = C_PointerType(C_VoidType());
+                     SgSymbol *sp = new SgSymbol(VARIABLE_NAME, PointerNameForPrivateArray(sarg), *t, *st_header);
+                     //sp->thesymb->entry.var_decl.local = IO;
+                     SgSymbol **symb = new (SgSymbol *);
+                     *symb= sarg;
+                     sp->addAttribute(FUNCTION_AR_DUMMY, (void*) symb, sizeof(SgSymbol *));
+                     ae->setSymbol(*sp);
+                     //ae->setType(t);
+                     //sarg->setType(ar_type);  // restoration of argument type
+                     //int *id = new int;
+                     //*id = 2;
+                     //sarg->addAttribute(DUMMY_PRIVATE_AR, (void *)id, sizeof(int));
+
+                                          //ae->setType(C_ReferenceType(t));
+                     //ae = new SgPointerDerefExp(*ae);
+                     //ae = new SgCastExp(*C_PointerType(C_VoidType()), *ae);
+                     //arg_list = AddListToList(                    int *id = new int;
+                     //continue;
+
+                     //ae = new SgCastExp(*C_PointerType( t), *new SgVarRefExp(sp));
+                    // ae = new SgVarRefExp(sp);
+                     //ae = new SgExprListExp(*ae); 
+                     //arg_list = AddListToList(arg_list, ae);
+                     //continue;
+
+            }
+                            
+            //sarg->setType(t);
+            //ae = new SgVarRefExp(sarg);
+            //ae->setType(t);
+
+            ae->setType(C_ReferenceType(t));//(sarg->type())); //t
            ae = new SgExprListExp(*new SgPointerDerefExp(*ae));
            arg_list = AddListToList(arg_list, ae);
            //SgSymbol *arr_info = new SgSymbol(VAR_REF, ("inf_" + std::string(sarg->identifier())).c_str());
@@ -679,11 +959,11 @@ void ExtractDeclarationStatements(SgStatement *header)
    if(stmt->variant()==CONTROL_END)
        return;

-    while (stmt && !isSgExecutableStatement(stmt)) //is Fortran specification statement
-    {   
+    while (stmt && (!isSgExecutableStatement(stmt) || stmt->variant()==ACC_ROUTINE_DIR)) //is Fortran specification statement or ROUTINE directive
+    {
        cur_st = stmt;     
        stmt = stmt->lexNext();
-        if(cur_st->variant() == INTERFACE_STMT || cur_st->variant() == INTERFACE_ASSIGNMENT || cur_st->variant() == INTERFACE_OPERATOR)
+        if (cur_st->variant() == INTERFACE_STMT || cur_st->variant() == INTERFACE_ASSIGNMENT || cur_st->variant() == INTERFACE_OPERATOR)
        {
            SgStatement *last = cur_st->lastNodeOfStmt();
            SgStatement *start = cur_st;
@@ -722,7 +1002,7 @@ void ExtractDeclarationStatements(SgStatement *header)
        }
        //if(cur_st->variant()==IMPL_DECL || cur_st->variant()==DATA_DECL || cur_st->variant()==USE_STMT || cur_st->variant()==FORMAT_STAT || cur_st->variant()==ENTRY_STAT || cur_st->variant()==COMM_STAT || cur_st->variant()==STMTFN_STAT )
        if(!isSgVarDeclStmt(cur_st) && !isSgVarListDeclStmt(cur_st))
-        {  
+        {
            cur_st->extractStmt(); 
            continue;     
        }
@@ -858,6 +1138,27 @@ void CorrectSubscript(SgExpression *e)
    e->setLhs((new SgExprListExp(*line)));
 }

+void replaceArgument(SgSymbol *fsym, SgExpression *arg, int i)
+{
+     if (isSgArrayRefExp(arg) && !arg->lhs()) //argument is  whole array (array name)
+     {
+         if (fsym && isPrivateArrayDummy(arg->symbol()) && !isArrayParameterWithAssumedShape(ProcedureSymbol(fsym),i))
+             arg->setLhs(FirstArrayElementSubscriptsOfPrivateArray(arg->symbol()));            
+         return;
+     }
+     replaceVectorRef(arg);
+     return;
+}
+
+void replaceArgumentList(SgSymbol *fsym, SgExpression *arg_list)
+{
+     if (!arg_list) return;
+     int i;
+     SgExpression *el;
+     for (el=arg_list, i=0; el; el=el->rhs(),i++)
+         replaceArgument(fsym, el->lhs(), i);
+}
+
 void replaceVectorRef(SgExpression *e)
 {
    SgType *type;
@@ -868,11 +1169,16 @@ void replaceVectorRef(SgExpression *e)
        type = isSgArrayType(e->symbol()->type());
        if (IS_DUMMY(e->symbol()) && type)
        {
-            CorrectSubscript(e);
+            if (!isPrivateArrayDummy(e->symbol()))  //isPrivate(e->symbol()->identifier())
+                CorrectSubscript(e);
        }
        return;
    }
-
+    if (isSgFunctionCallExp(e))
+    {
+        replaceArgumentList(e->symbol(),e->lhs());
+        return;
+    }
    replaceVectorRef(e->lhs());
    replaceVectorRef(e->rhs());
 }
@@ -882,6 +1188,16 @@ void ConvertArrayReferences(SgStatement *first, SgStatement *last)
    SgStatement *st;
    for (st = first; st != last; st = st->lexNext())
    {
+        if (isInterfaceStatement(st))
+        {
+            st = st->lastNodeOfStmt();
+            continue;
+        }
+        if (st->variant() == PROC_STAT) // call statement
+        {
+            replaceArgumentList(st->symbol(), st->expr(0));
+            continue; 
+        }
        if (st->expr(0))
            replaceVectorRef(st->expr(0));
        if (st->expr(1))
@@ -939,7 +1255,7 @@ void MakeFunctionDeclarations(SgStatement *header, SgSymbol *s_last)
        int flags = s->attributes();

        if (IS_DUMMY(s))
-        {
+        {             
            if (flags & (IN_BIT | OUT_BIT | INOUT_BIT))
                ;
            else if(!options.isOn(NO_PURE_FUNC))
@@ -957,13 +1273,23 @@ void MakeFunctionDeclarations(SgStatement *header, SgSymbol *s_last)
            //printf("%s: %d \n",s->identifier(),s->scope()->variant());  //printf("%s: %d %s \n",s->identifier(),s->scope()->variant(),s->scope()->symbol()->identifier());
            continue;
        }
+       
+        SgSymbol **sarg = (SgSymbol **) s->attributeValue(0, FUNCTION_AR_DUMMY);
+        if (sarg)  // pointer for PrivateArray class object
+        {
+            SgExpression *elist = NULL;
+            int rank = Rank(*sarg);
+            if (rank > 1)
+                for (int i=rank-1; i; i--)
+                    elist = AddListToList(elist, new SgExprListExp(*Calculate(ArrayDimSize(*sarg,i))));
+            makeClassObjectDeclaration(*sarg, s, header, C_UnsignedLongLongType(), elist, 1); //makeSymbolDeclaration(s);  //MakePrivateArrayDeclaration(*sarg, s);
+            continue;
+        }
        if (!isSgArrayType(s->type()))  //scalar variable
            s->setType(C_Type(s->type()));
        else
-        {
            continue;
-        }
-
+         
        if (isSgConstantSymb(s))
        {   
            SgExpression *ce = ((SgConstantSymb *)s)->constantValue();            
@@ -978,9 +1304,10 @@ void MakeFunctionDeclarations(SgStatement *header, SgSymbol *s_last)
        cur_stat->insertStmtAfter(*st);
        cur_stat = st;
    }
-                //printf("\n"); if(private_list) private_list->unparsestdout(); printf("\n");  
+
    for (el = private_list; el; el = el->rhs())
    {
+        if (IS_DUMMY(el->lhs()->symbol())) return;  
        convertArrayDecl(el->lhs()->symbol());
        st = makeSymbolDeclaration(el->lhs()->symbol());
        cur_stat->insertStmtAfter(*st);
@@ -1005,6 +1332,7 @@ void ProjectStructure(SgProject &project)
    int n = project.numberOfFiles();
    SgFile *file;
    int i;
+     
    // building program structure 
    // looking through the file list of project (first time)
    for (i = n - 1; i >= 0; i--)
@@ -1246,6 +1574,7 @@ END_:
        PrintGraphNode(cur_node);
    in_routine = 0;
    return(last);
+
 }

 void FunctionCallSearch(SgExpression *e)
@@ -1609,13 +1938,13 @@ void Call_Site(SgSymbol *s, int inlined, SgStatement *stat, SgExpression *e)
    graph_node * gnode, *node_by_attr = NULL;
    SgSymbol *s_new = s;
    SgStatement *interface_st = NULL;
-    //printf("\n%s  id= %d \n", s->identifier(), s->id());
+    //printf("\n%s  id= %d type= %d\n", s->identifier(), s->id(), s->type() ? s->type()->variant() : 0);
    if (!do_dummy  && isDummyArgument(s)) return;
    if (!do_stmtfn && isStatementFunction(s)) return;
    // if(isIntrinsicFunction(s)) return; 
    //printf("\nLINE %d", cur_st->lineNumber());
-   
-    if(s->variant() == INTERFACE_NAME && in_region)
+    
+    if(s->variant() == INTERFACE_NAME && (in_region || in_routine))
    {
        //printf("INTERFACE_NAME %s\n",s->identifier());
        interface_st = getGenericInterface(s, stat ? stat->expr(0) : e->lhs());
@@ -1816,7 +2145,8 @@ graph_node *NewGraphNode(SgSymbol *s, SgStatement *header_st)
    gnode->clone = 0;
    gnode->count = 0;
    gnode->is_routine = 0;
-    gnode->st_interface = NULL;    
+    gnode->st_interface = NULL;  
+    gnode->arg_numbs = NULL;  
    //printf("%s --- %d %d\n",gnode->name,gnode->id,gnode->type);
    return(gnode);
 }
@@ -1981,6 +2311,24 @@ graph_node_list  *isInNodeList(graph_node_list *pnode, graph_node *gnode)
    return (NULL);
 }

+void addArgumentNumber(int i, SgSymbol *s)
+{
+    if (!ATTR_NODE(s))
+        return;
+    graph_node *gnode = GRAPHNODE(s); 
+    argument_numbers *nl;   
+    for (nl=gnode->arg_numbs; nl; nl=nl->next)
+        if(i == nl->number) return;
+    nl = new argument_numbers;
+    nl->number = i;
+    if (gnode->arg_numbs)
+    {
+        nl->next = gnode->arg_numbs;
+        gnode->arg_numbs = nl;
+    } 
+    else
+        gnode->arg_numbs = nl;
+}

 void PrintGraphNode(graph_node *gnode)
 {
@@ -2167,6 +2515,14 @@ void printSymb(SgSymbol *s)
    head = isHeaderStmtSymbol(s) ? "HEADER  " : "        ";
    printf("SYMB[%3d]  scope=STMT[%3d] : %s    %s", s->id(), (s->scope()) ? (s->scope())->id() : -1, s->identifier(), head);
    printType(s->type());
+    if(s->variant() == CONST_NAME)
+    {
+       printf(" CONST_NAME ");
+       if(IS_BY_USE(s))
+          printf(" BY_USE");
+       printf("\n");
+       return;
+    }
    if(IS_BY_USE(s))
       printf(" BY_USE %s", ORIGINAL_SYMBOL(s)->scope()->symbol()->identifier());
    if(ATTR_NODE(s))