/*********************************************************************/
/*                   Inline Expansion    2006                        */
/*********************************************************************/


/*********************************************************************/
/*                         Inliner                                   */
/*********************************************************************/

#include <stdio.h>
#include <string.h>
#include "inline.h"

#ifdef __SPF
extern "C" void printLowLevelWarnings(const char *fileName, const int line, const wchar_t *messageR, const char *messageE, const int group) { }
extern "C" void addToCollection(const int line, const char *file, void *pointer, int type) { }
extern "C" void removeFromCollection(void *pointer) { }

#include <map>
#include <string>

std::map<PTR_BFND, std::pair<std::string, int>> sgStats;
std::map<PTR_LLND, std::pair<std::string, int>> sgExprs;
void addToGlobalBufferAndPrint(const std::string &toPrint) { }
#endif

void Inliner(graph_node *gtop)
{
    SgStatement *header, *stmt, *last, *newst;
    int i;

    header = gtop->st_header;
    top_header = header;
    if (with_cmnt)
        top_header->addComment("!*****AFTER INLINE EXPANSION******\n");
    top_node = gtop;
    vcounter = 0;
    max_lab = getLastLabelId();
    num_lab = 0;
    for (i = 0; i < 10; i++)
        do_var[i] = NULL;
    top_temp_vars = NULL;

    if (deb_reg)
        printf("\nINLINER  %s [%d]\n", gtop->symb->identifier(), gtop->symb->id());

    //Find all entry points
    EntryPointList(gtop->file);

    //Substitute all integer symbolic constants in "top level" routine
    IntegerConstantSubstitution(header);

    //Clean "top level" routine (precalculation of function call and actual parameter expressions)
    RoutineCleaning(header);
    SetScopeToLabels(header);

    // for debugging
    if (deb_reg > 1)
        PrintSymbolTable(gtop->file);

    // Perform the inline expansion
    // for each call site to be expanded (as encountered at "top level")
    last = header->lastNodeOfStmt();
    top_last = last;
    for (stmt = header; stmt && (stmt != last); stmt = stmt->lexNext())
        if (isSgExecutableStatement(stmt) && stmt->variant() != FORMAT_STAT) {
            top_first_executable = stmt; break;
        }
    top_last_declaration = top_first_executable->lexPrev();

    newst = new SgStatement(CONT_STAT);
#if __SPF
    insertBfndListIn(newst->thebif, top_last_declaration->thebif, NULL);
#else
    top_last_declaration->insertStmtAfter(*newst);
#endif
    top_first_executable = newst;

    MakeDeclarationForTempVarsInTop();  //finish cleaning

    for (stmt = top_first_executable; stmt && (stmt != last); )
    {
        switch (stmt->variant())
        {
        case ASSIGN_STAT:
            if (stmt->expr(1)->variant() == FUNC_CALL)
                stmt = InlineExpansion(gtop, stmt, stmt->expr(1)->symbol(), stmt->expr(1)->lhs()); //stmt = first inserted statement or next statement
            else
                stmt = stmt->lexNext();
            continue;
        case PROC_STAT:
            stmt = InlineExpansion(gtop, stmt, stmt->symbol(), stmt->expr(0));  //stmt = first inserted statement or next statement
            continue;
        default:
            stmt = stmt->lexNext();
            continue;
        }
    }
    // Make delarations for temporary variables created by translation algorithm (TranslateSubprogramReferences()) 
    MakeDeclarationForTempVarsInTop();

    // Transform declaration part of top level routine
    // DATA and statement functions -> after all specification statements (standard F77)
    TransformForFortran77();

    newst->extractStmt();

    // Extract routines for all the graph nodes except top node
    if (deb_reg && gtop && gtop->to_called)
        printf("\n   T a b l e   o f   I n l i n e   E x p a n s i o n s  i n  %s\n\n", gtop->symb->identifier());

    ExtractSubprogramsOfCallGraph(gtop);

    //
    if (deb_reg > 2)
        PrintSymbolTable(gtop->file);
    return;
}

void EntryPointList(SgFile *file)
//find entry point in the inline flow DAG 
{
    SgStatement *first_st, *stmt;
    first_st = file->firstStatement();
    for (stmt = first_st; stmt; stmt = stmt->lexNext())
        if (stmt->variant() == ENTRY_STAT)
            entryst_list = addToStmtList(entryst_list, stmt);
}

void IntegerConstantSubstitution(SgStatement *header)
//Substitute all integer symbolic constants in  routine
{
    SgStatement *last, *stmt;
    SgExpression *e;
    SgExprListExp *el;
    SgConstantSymb  *sc;
    // PTR_LLND ranges;
    int i;
    last = header->lastNodeOfStmt();
    for (stmt = header; stmt && (stmt != last); stmt = stmt->lexNext())
    {  // PARAMETER statement
        if (stmt->variant() == PARAM_DECL)

        {
            for (el = isSgExprListExp(stmt->expr(0)); el; el = el->next())
            {
                e = el->lhs(); sc = isSgConstantSymb(e->symbol());
                SYMB_VAL(sc->thesymb) = ReplaceIntegerParameter(&(sc->constantValue()->copy()))->thellnd;
            }
            //printf("PARAM_DECL\n");
            continue;
        }
        if (stmt->variant() == VAR_DECL)
            ReplaceIntegerParameter_InType(stmt->expr(1)->type());

        // any other statement
        for (i = 0; i < 3; i++)
            if (stmt->expr(i))
                stmt->setExpression(i, *ReplaceIntegerParameter(stmt->expr(i)));

    }
    ReplaceIntegerParameterInTypeOfVars(header, last);
}

void ReplaceIntegerParameterInTypeOfVars(SgStatement *header, SgStatement *last)
{
    SgSymbol *s, *sl;
    // PTR_LLND ranges;
    sl = last->lexNext() ? last->lexNext()->symbol() : NULL;

    //if(sl) printf("%s  %s\n",header->symbol()->identifier(),sl->identifier());
    for (s = header->symbol(); s != sl && s != NULL; s = s->next())
        if (s->scope() == header)   //local variable
            ReplaceIntegerParameter_InType(s->type());
    return;
}
void ReplaceIntegerParameter_InType(SgType *t)
{
    PTR_LLND ranges;
    SgExpression *ne;
    if (!t) return;
    if ((ranges = TYPE_RANGES(t->thetype)) != 0)
    {
        ne = ReplaceIntegerParameter(LlndMapping(ranges));
        // if(isSgArrayType(t))     //ranges->variant() == EXPR_LIST
          //  Calculate_List(ne); 
    }
    if ((ranges = TYPE_KIND_LEN(t->thetype)) != 0)
        ne = ReplaceIntegerParameter(LlndMapping(ranges));

}


void MakeDeclarationForTempVarsInTop()
{
    symb_list *sl;
    for (sl = top_temp_vars; sl; sl = sl->next)
        MakeDeclarationStmtInTop(sl->symb);
    top_temp_vars = NULL;
}

void TransformForFortran77()
{
    SgStatement *stmt, *st1;
    for (stmt = top_header; stmt != top_last_declaration; )
    {
        if (stmt->variant() == DATA_DECL || stmt->variant() == STMTFN_STAT)
        {
            st1 = stmt;
            stmt = stmt->lexNext();
            st1->extractStmt();
            top_first_executable->insertStmtBefore(*st1, *top_header);
        }
        else
            stmt = stmt->lexNext();
    }
}

void ExtractSubprogramsOfCallGraph(graph_node *gtop)
{
    edge *el;
    // graph_node *nd;

    for (el = gtop->to_called; el; el = el->next)
    {
        if (el->to->st_header)
        {
            el->to->st_header->extractStmt();
            el->to->st_header = NULL;
            if (deb_reg)
                printf("  %s: %d\n", el->to->symb->identifier(), el->to->count);
            ExtractSubprogramsOfCallGraph(el->to);
        }
    }
}

//-------------------------------------------------------------------------------------------
//-------------------------------------------------------------------------------------------
//                 R O U T I N E   C L E A N I N G
//-------------------------------------------------------------------------------------------
//-------------------------------------------------------------------------------------------

void RoutineCleaning(SgStatement *header)
{
    SgStatement *last, *stmt;
    //SgExpression *e;
    //SgExprListExp *el;
    //SgConstantSymb  *sc;
    SgSymbol *s;
    //int i;
    cur_func = header;
    last = header->lastNodeOfStmt();
    //scanning local symbols,
    // if symbol used as a variable and is an intrinsic function name,
    // rename the symbol to not conflict with any intrinsic function names 
    for (s = header->symbol(); s; s = s->next())
        if (s->scope() == header && isSgVariableSymb(s) && isIntrinsicFunctionName(s->identifier()))
            SYMB_IDENT(s->thesymb) = ChangeIntrinsicFunctionName(s->identifier());
    // cleaning each executable statement 
    for (stmt = header; stmt && (stmt != last); stmt = stmt->lexNext())
    {
        if (isSgExecutableStatement(stmt)) //is not Fortran specification statement        
            StatementCleaning(stmt);
    }
}


void StatementCleaning(SgStatement *stmt)
{
    SgAssignStmt *asst;
    SgSymbol *sf;
    if ((asst = isSgAssignStmt(stmt)) != 0)
        //if(stmt->variant() == ASSIGN_STAT)
    {
        if ((asst->rhs()->variant() == FUNC_CALL) &&
            (isSgVarRefExp(asst->lhs())
                ||
                (isSgArrayRefExp(asst->lhs()) && !isSgArrayType(asst->lhs()->type()))))
        {
            ReplaceContext(stmt);
            SearchFunction(asst->lhs(), stmt);
            SearchFunction(asst->rhs()->lhs(), stmt); // actual parameter expression list
            PrecalculateActualParameters(asst->rhs()->symbol(), asst->rhs()->lhs(), stmt);
            return;
        }

    }
    if ((sf = SearchFunction(stmt->expr(0), stmt)) != 0)   stmt->setExpression(0, *new SgVarRefExp(sf));
    if ((sf = SearchFunction(stmt->expr(1), stmt)) != 0)   stmt->setExpression(1, *new SgVarRefExp(sf));
    if ((sf = SearchFunction(stmt->expr(2), stmt)) != 0)   stmt->setExpression(2, *new SgVarRefExp(sf));

    if (stmt->variant() == PROC_STAT)
    {
        ReplaceContext(stmt);
        PrecalculateActualParameters(stmt->symbol(), stmt->expr(0), stmt);
    }
}

SgSymbol *SearchFunction(SgExpression *e, SgStatement *stmt)
{
    SgSymbol *sf;
    if (!e)
        return(NULL);
    if (e->variant() == FUNC_CALL)
    {
        return(PrecalculateFtoVar(e, stmt));
    }

    if ((sf = SearchFunction(e->lhs(), stmt)) != 0)  e->setLhs(new SgVarRefExp(sf));
    if ((sf = SearchFunction(e->rhs(), stmt)) != 0)  e->setRhs(new SgVarRefExp(sf));
    return (NULL);
}

SgSymbol *PrecalculateFtoVar(SgExpression *e, SgStatement *stmt)
{
    SgStatement *newst;
    SgSymbol *sf;
    SgType *t;
    t = TypeOfResult(e);
    if (!t)
        err("Wrong type", 2, stmt);
    sf = GetTempVarForF(e->symbol(), t);
    newst = new SgAssignStmt(*new SgVarRefExp(sf), *e);
    InsertNewStatementBefore(newst, stmt);
    StatementCleaning(newst);
    return(sf);
}

void PrecalculateActualParameters(SgSymbol *s, SgExpression *e, SgStatement *stmt)
{// Precalculate actual parameter expressions
 //e - actual parameter list
    int i;
    SgExpression *el;
    SgSymbol *sp;
    if (!e) return;
    if (is_NoExpansionFunction(s)) return; // expansion may not be made
    i = 1;
    for (el = e; el; el = el->rhs(), i++)
        switch (ParameterType(el->lhs(), stmt))
        {
        case 1:  break; //actual parameter can be accessed by reference
       //case 2:  PrecalculateSubscripts(el->lhs(),stmt); break;
        default: sp = GetTempVarForArg(i, s, el->lhs()->type());
            PrecalculateExpression(sp, el->lhs(), stmt); //to support access by reference 
            el->setLhs(new SgVarRefExp(sp)); //replace actual parameter expression by 'sp' reference
            break;
        }
}

void PrecalculateExpression(SgSymbol *sp, SgExpression *e, SgStatement *stmt)
{
    SgStatement *newst;
    newst = new SgAssignStmt(*new SgVarRefExp(sp), *e);
    InsertNewStatementBefore(newst, stmt);
}


int ParameterType(SgExpression *e, SgStatement *stmt)
{
    if (isSgVarRefExp(e) ||                                      // scalar variable
        (isSgArrayRefExp(e) && !e->lhs()) ||                     // array variable whithout subscript or string variable
        e->variant() == CONST_REF ||                              // symbol (named) constant
        (isSgValueExp(e) && e->type()->variant() != T_STRING) || // literal constant
        (isSgArrayRefExp(e) && TestSubscripts(e->lhs(), stmt)) || // array reference whose subscripts are constant or scalar
        (e->variant() == ARRAY_OP && isSgVarRefExp(e->lhs()) &&
            TestRange(e->rhs(), stmt)) ||// substring reference whose subscripts are constant or scalar
            (e->variant() == ARRAY_OP && isSgArrayRefExp(e->lhs())
                && TestSubscripts(e->lhs()->lhs(), stmt)
                && TestRange(e->rhs(), stmt)))    // substring reference whose subscripts are constant or scalar                                                    
        return(1); // actual parameter can be accessed by reference

    //  else if(isSgArrayRefExp(e))
    //    return(2);
    //  else if(e->variant()==ARRAY_OP)
    //    return(3);

    else
        return(0); // precalculation expression is needed to support access by reference   
}

int TestSubscripts(SgExpression *e, SgStatement *stmt)
{
    SgExpression *el, *ei;
    //SgSymbol *sp;
    for (el = e; el; el = el->rhs()) {
        ei = el->lhs(); // a subscript
        if (isSgVarRefExp(ei) || (ei->variant() == CONST_REF) || isSgValueExp(ei)) // constant or scalar
            continue;
        else
            //return(0);
        {//sp=GetTempVarForSubscr(ei->type());
         //PrecalculateExpression(sp,ei,stmt); //to support access by reference 
         //el->setLhs(new SgVarRefExp(sp)); //replace subscript expression by 'sp' reference
            continue;
        }
    }
    return(1);
}

int TestRange(SgExpression *e, SgStatement *stmt)
{
    SgExpression *ei;
    SgSymbol *sp;

    int ret;
    ret = 0;
    //e->unparsestdout();  (e->lhs())->unparsestdout(); //(e->rhs())->unparsestdout();
    //printf("  testrange %d  %d\n", e->variant(), (e->lhs())->variant());

    ei = e->lhs();

    if (!ei || isSgVarRefExp(ei) || (ei->variant() == CONST_REF) || isSgValueExp(ei))
        ret = 1;
    else
    {
        sp = GetTempVarForSubscr(ei->type());
        PrecalculateExpression(sp, ei, stmt); //to support access by reference 
        e->setLhs(new SgVarRefExp(sp)); //replace subrange expression by 'sp' reference
    }

    ei = e->rhs();
    if (!ei || isSgVarRefExp(ei) || (ei->variant() == CONST_REF) || isSgValueExp(ei))
        return(1);
    else
        //return(0);
    {
        sp = GetTempVarForSubscr(ei->type());
        PrecalculateExpression(sp, ei, stmt); //to support access by reference 
        e->setRhs(new SgVarRefExp(sp)); //replace subscript expression by 'sp' reference
        return(1);
    }

    return 1;
}

void LabelList(SgStatement *header)
{
    SgStatement *last, *stmt;

    last = header->lastNodeOfStmt();
    for (stmt = header; stmt && (stmt != last); stmt = stmt->lexNext())
    {
        if (stmt->hasLabel())
            proc_labels = addToLabelList(proc_labels, stmt->label());
    }
}

void SetScopeToLabels(SgStatement *header)
{
    SgStatement *last, *stmt;

    last = header->lastNodeOfStmt();
    for (stmt = header; stmt && (stmt != last); stmt = stmt->lexNext())
    {
        if (stmt->hasLabel())
            LABEL_SCOPE(stmt->label()->thelabel) = header->thebif;
    }
}


//-------------------------------------------------------------------------------------------
//-------------------------------------------------------------------------------------------
//            I N L I N E    E X P A N S I O N
//-------------------------------------------------------------------------------------------
//-------------------------------------------------------------------------------------------

SgStatement *InlineExpansion(graph_node *gtop, SgStatement *stmt, SgSymbol *sf, SgExpression *args)
// return next processed statement in top level routine:
// first of inline expansion statements (inserted in top level routine)
//  or
// next statement following stmt in top level routine ( stmt->lexNext()), if it is not inlined call
{
    graph_node *gnode;
    SgStatement *header_tmplt, *global_st, *header_work, *calling_stmt, *expanded_stmt;
    SgSymbol *scopy;
    SgLabel *lab;
    /*
      if(!(pnode = ATTR_NODE(sf)))
      { printf("Error: NO ATTRIBUTE \n");
        return (stmt->lexNext());
      } else
        gnode = *pnode;
      if(!isInlinedCall(gtop,gnode))
         return(stmt->lexNext());
    */
    //gnode = getAttrNodeForSymbol(sf);
    if (deb_reg > 1)
        printf("INLINE EXPANSION %s \n", sf->identifier());
    if (!ATTR_NODE(sf))   // call without inline expansion (dummy argument, statement function) 15.03.07
        return(stmt->lexNext());
    gnode = getNodeForSymbol(gtop, sf->identifier());
    if (!gnode)
        return(stmt->lexNext());
    if (deb_reg > 1)
        printf("node %d for symbol %s\n", gnode->id, sf->identifier());
    //if(!isInlinedCallSite(stmt))  // if there is assertion (special comment) in program for call site 
      // return(stmt->lexNext());

    (gnode->count)++;
    // 1. if gnode is not template object 
    //    create a template inline object by performing site-independent transformations
    if (!gnode->tmplt)
        header_tmplt = CreateTemplate(gnode);

    // 2. clone the "template" inline object to create work inline object:  
    //    copying subprogram, inserting after global statement of file (in beginning of file)
    global_st = gtop->file->firstStatement();
    top_global = global_st;
    scopy = &((gnode->symb)->copySubprogram(*(global_st)));
    header_work = scopy->body(); //global_st->lexNext();


// 3. perform site_specific transformations
    if (stmt->variant() == ASSIGN_STAT)
        RemapFunctionResultVar(stmt->expr(0), scopy);
    ConformActualAndFormalParameters(scopy, args, stmt);

    // 4. transform all references to subprogram variables to "top level" form
    expanded_stmt = TranslateSubprogramReferences(header_work);

    // debugging
    if (deb_reg > 1)
        (gtop->file)->unparsestdout();
    if (deb_reg > 2)
    {
        printf("---------------------\n");
        expanded_stmt->unparsestdout();
        printf("---------------------\n");
        printf("\n");
    }
    // 5. replace the calling statement in the "top level" routine by transformed statements
    calling_stmt = stmt;
    /*  if(sf->variant() == FUNCTION_NAME)   //calling_stmt->variant()==ASSIGN_STAT
      {
           newst = new SgAssignStmt(*stmt->expr(0),*new SgVarRefExp(sf) );
           InsertNewStatementAfter(newst,stmt,stmt->controlParent());
      }
     */
    if (with_cmnt)
    {
        char *buf;
        buf = stmt->lexNext()->comments();
        BIF_CMNT(stmt->lexNext()->thebif) = NULL;
        Add_Comment(gnode, stmt->lexNext(), 1);
        stmt->lexNext()->addComment(buf);
    }
    InsertBlockAfter(stmt, expanded_stmt, header_work);

    if (with_cmnt)
    {
        expanded_stmt->addComment(stmt->comments());
        Add_Comment(gnode, expanded_stmt, 0);
    }
    lab = (stmt->hasLabel()) ? stmt->label() : NULL;
    if (lab)
    {
        if (expanded_stmt->hasLabel())
            InsertNewStatementBefore(new SgStatement(CONT_STAT), stmt);
        else
            BIF_LABEL(expanded_stmt->thebif) = lab->thelabel;
    }
    calling_stmt->extractStmt();

    // temporary !!!!
    //   return(stmt->lexNext());

    return(expanded_stmt);
}

void Add_Comment(graph_node *g, SgStatement *stmt, int flag)
{
    char *buf;
    buf = new char[80];
    if (!flag)
        sprintf(buf, "!*********INLINE EXPANSION %s[%d]*********\n", g->symb->identifier(), g->count);
    else
        sprintf(buf, "!*********END OF EXPANSION %s[%d]*********\n", g->symb->identifier(), g->count);
    stmt->addComment(buf);
}


graph_node *getNodeForSymbol(graph_node *gtop, char *name)
{
    edge *el;
    graph_node *nd;
    for (el = gtop->to_called; el; el = el->next)
    {
        if (!strcmp(el->to->symb->identifier(), name))
            return(el->to);
        else if ((nd = getNodeForSymbol(el->to, name)) != 0)
            return(nd);
    }
    return NULL;
}

graph_node *getAttrNodeForSymbol(SgSymbol *sf)
{
    graph_node *gnode, **pnode;
    if (!(pnode = ATTR_NODE(sf)))
    {
        printf("Warning: NO ATTRIBUTE FOR  %s\n", sf->identifier());
        gnode = NULL;
    }
    else
        gnode = *pnode;
    return(gnode);
}

int isInlinedCall(graph_node *gtop, graph_node *gnode)
{
    edge  *edgl;

    // testing incoming edge list of called routine graph-node: gnode 
    for (edgl = gnode->from_calling; edgl; edgl = edgl->next)
        if (edgl->from == gtop) //there is incoming edge: : gtop->[gnode] 
            return(1);
    return(0);
}

SgStatement * CreateTemplate(graph_node *gnode)
{ // Create a template inline object by performing site-independent transformations
    gnode->tmplt = 1;
    // routine cleaning
    RoutineCleaning(gnode->st_header);
    SetScopeToLabels(gnode->st_header);
    // site-independent transformation
    SiteIndependentTransformation(gnode);
    if (deb_reg > 1)
        printf("template for %s\n", gnode->st_header->symbol()->identifier());
    return(gnode->st_header);
}

//-------------------------------------------------------------------------------------------
//-------------------------------------------------------------------------------------------
//    S I T E   I N D E P E N D E N T   T R A N S F O R M A T I O N S
//-------------------------------------------------------------------------------------------
//-------------------------------------------------------------------------------------------

void SiteIndependentTransformation(graph_node *gnode) //(SgStatement *header)

{// Perform site-independent transformation

    SgStatement *last, *first_executable, *last_declaration, *stmt, *return_st, *prev;
    SgStatement *header;
    SgLabel *lab_return;
    int has_return;
    stmt_list *DATA_list = NULL;
    header = gnode->st_header;
    last = header->lastNodeOfStmt();
    first_executable = NULL;
    for (stmt = header; stmt && (stmt != last); stmt = stmt->lexNext())
        if (isSgExecutableStatement(stmt) && stmt->variant() != FORMAT_STAT) {
            first_executable = stmt; break;
        }
    //last_declaration = first_executable->lexPrev();

   //----------------------------
   //Move all entry points to the top of the subprogram
    for (stmt = first_executable; stmt && (stmt != last); stmt = stmt->lexNext())
        if (stmt->variant() == ENTRY_STAT)
            MoveToTopOfRoutine(stmt, first_executable);

    //stmt_list *entryl;
    //for(entryl=entryst_list; entryl; entryl=entryl->next)
    //   if(entryl->st->controlParent() == header)
    //      MoveToTop(entryl->st, first_executable);
    //   else
    //      continue;

//----------------------------
//Move all return points to the bottom of the subprogram
    prev = last->lexPrev();
    return_st = NULL;
    lab_return = NULL;
    has_return = 0;
    if (prev->variant() == RETURN_STAT && prev->controlParent()->variant() != LOGIF_NODE)
    {
        return_st = prev;
        if (return_st->hasLabel())
            lab_return = return_st->label();
    }
    if (!lab_return)
    {
        lab_return = NewLabel();
        SetScopeOfLabel(lab_return, header);
    }

    for (stmt = first_executable; stmt && (stmt != return_st) && (stmt != last); stmt = stmt->lexNext())
        if (stmt->variant() == RETURN_STAT)
        {
            stmt = ReplaceByGoToBottomOfRoutine(stmt, lab_return);
            has_return = 1;
        }
    if (has_return)
    {
        if (!return_st)
        {
            stmt = new SgStatement(CONT_STAT);
            InsertNewStatementBefore(stmt, last);
            stmt->setLabel(*lab_return);
        }
        else
        {
            return_st->setLabel(*lab_return);
            ReplaceReturnByContinue(return_st);
        }
    }
    else if (return_st)
        ReplaceReturnByContinue(return_st);

    //----------------------------
    //Substitute all integer symbolic constants in subprogram
    IntegerConstantSubstitution(header);

    //----------------------------
    //Move all FORMAT statements into the top level routine
    format_labels = NULL;
    for (stmt = header; stmt && (stmt != last); )
        if (stmt->variant() == FORMAT_STAT)
            //MoveFormatToTopOfRoutine(stmt, last_declaration);
            stmt = MoveFormatIntoTopLevel(stmt, gnode->clone);
        else if (stmt->variant() == DATA_DECL)
        {
            DATA_list = addToStmtList(DATA_list, stmt);
            stmt = stmt->lexNext();
            //!!!!
            Error("DATA statement in procedure %s. Sorry, not implemented yet", header->symbol()->identifier(), 1, stmt);
        }
        else
            stmt = stmt->lexNext();
    ReplaceFormatLabelsInStmts(header);
    //----------------------------
    //Precalculate all of the subprogram's adjustable array bounds
    last_declaration = first_executable->lexPrev();

    AdjustableArrayBounds(header, last_declaration);
    first_executable = last_declaration->lexNext();
    //---------------------------- 
    //Replace each reference to whole formal array in I/O statements
    //by implied DO-loop 
    ReplaceWholeArrayRefInIOStmts(header);
    //---------------------------- 
    //Remap all local subprogram variables by creating new unconflicting top level variables
    top_symb_list = CreateListOfLocalVariables(top_header);
    sub_symb_list = CreateListOfLocalVariables(header);
    //PrintTopSymbList();

    //PrintSymbList(sub_symb_list, header);


    RemapConstants(header, first_executable);
    RemapLocalVariables(header);

    //---------------------------- 
    //Remap COMMON bloks
    CreateTopCommonBlockList();
    RemapCommonBlocks(header);
    //----------------------------
    //Remap EQUIVALENCE blocks 
    //---------------------------- 
    //Move all DATA statements into top level routine
      //DATA_list has been created: list of DATA statements
      // internal form of DATA statement must be changed in parser and unparser
      //if(DATA_list)   // temporary !!!
        //printf("There are DATA statements in procedure. Sorry, not implemented yet \n" );

}

void MoveToTopOfRoutine(SgStatement *entrystmt, SgStatement *first_executable)
{//Move entry point to the top of the subprogram
 // generate GO TO statement (will be removed after expansion)
    SgStatement *go_to;
    SgLabel *entry_lab;

    if (!entrystmt->lexNext()->hasLabel())
    {
        entry_lab = NewLabel();
        SetScopeOfLabel(entry_lab, entrystmt->controlParent());
        entrystmt->lexNext()->setLabel(*entry_lab);
    }
    else
        entry_lab = entrystmt->lexNext()->label();
    go_to = new SgGotoStmt(*entry_lab);
    entrystmt->extractStmt();
    InsertNewStatementBefore(entrystmt, first_executable);
    InsertNewStatementAfter(go_to, entrystmt, entrystmt->controlParent());
}

//-------------------------------------------------------------------------------------------
SgStatement *ReplaceByGoToBottomOfRoutine(SgStatement *retstmt, SgLabel *lab_return)
{//Replace return point by goto to the bottom of the subprogram
 // generate GO TO statement 
    SgStatement *go_to;
    go_to = new SgGotoStmt(*lab_return);
    InsertNewStatementBefore(go_to, retstmt);
    retstmt->extractStmt();
    return(go_to);
}

void ReplaceReturnByContinue(SgStatement *return_st)
{
    InsertNewStatementBefore(new SgStatement(CONT_STAT), return_st);
    return_st->extractStmt();
}

//-------------------------------------------------------------------------------------------
void MoveFormatToTopOfRoutine(SgStatement *format_stmt, SgStatement *last_declaration)
{//Move FORMAT statements  to the top of the subprogram
    SgLabel *format_lab;
    // SgLabel *label_insection[200];

    if (format_stmt->hasLabel())
    {
        format_lab = format_stmt->label();
        if (!TestFormatLabel(format_stmt->label()))
        {
            format_lab = NewLabel();
            format_stmt->setLabel(*format_lab);
        }
        format_stmt->extractStmt();
        InsertNewStatementAfter(format_stmt, last_declaration, last_declaration->controlParent());
        last_declaration = format_stmt;
    }
}

SgStatement *MoveFormatIntoTopLevel(SgStatement *format_stmt, int clone)
{
    SgStatement *next;
    SgLabel *format_lab;
    next = format_stmt->lexNext();
    format_lab = format_stmt->label();
    if (!clone && isLabelOfTop(format_stmt->label()))
    {
        if (deb_reg > 2)
            printf("new label: %d -> ", (int)LABEL_STMTNO(format_lab->thelabel));
        format_labels = addToLabelList(format_labels, format_lab);
        format_lab = NewLabel();
        format_stmt->setLabel(*format_lab);
        format_labels->newlab = format_lab;
        if (deb_reg > 2)
            printf(" %d\n", (int)LABEL_STMTNO(format_lab->thelabel));
    }

    format_stmt->extractStmt();
    InsertNewStatementAfter(format_stmt, top_last_declaration, top_header);
    SetScopeOfLabel(format_lab, top_header);
    //top_last_declaration = format_stmt;

    return(next);
}

label_list  *addToLabelList(label_list *lablist, SgLabel *lab)
{
    // adding the label to the beginning of label list 

    label_list * nl;
    if (!lablist) {
        lablist = new label_list;
        lablist->lab = lab;
        lablist->next = NULL;
    }
    else {
        nl = new label_list;
        nl->lab = lab;
        nl->next = lablist;
        lablist = nl;
    }
    return (lablist);
}

int isInLabelList(SgLabel *lab, label_list *lablist)
{
    label_list *ll;
    for (ll = lablist; ll; ll = ll->next)
        if (LABEL_STMTNO(ll->lab->thelabel) == LABEL_STMTNO(lab->thelabel))
            return(1);
    return(0);
}

int isLabelOfTop(SgLabel *lab)
{
    return(isLabelWithScope(LABEL_STMTNO(lab->thelabel), top_header) != NULL);
}

void ReplaceFormatLabelsInStmts(SgStatement *header)
{
    SgStatement *stmt, *last;
    if (!format_labels)
        return;
    if (deb_reg > 2)
        printf("replace format labels in %s\n", header->symbol()->identifier());
    last = header->lastNodeOfStmt();
    for (stmt = header; stmt && (stmt != last); stmt = stmt->lexNext())
    {
        switch (stmt->variant())
        {
        case WRITE_STAT:
        case READ_STAT:
        case PRINT_STAT:
        { SgKeywordValExp *kwe;
        SgExpression *e, *ee, *el, *fmt;
        fmt = NULL;
        e = stmt->expr(1); // IO control list
        if (e->variant() == SPEC_PAIR)
        {
            if (stmt->variant() == PRINT_STAT)
                fmt = e;
            else
            {
                kwe = isSgKeywordValExp(e->lhs());
                if (!kwe)
                    break;
                if (!strcmp(kwe->value(), "fmt"))
                    fmt = e;
                else
                    break;;
            }
        }
        else if (e->variant() == EXPR_LIST)
        {
            for (el = e; el; el = el->rhs())
            {
                ee = el->lhs();
                if (ee->variant() != SPEC_PAIR)
                    break; // IO_control list error
                kwe = isSgKeywordValExp(ee->lhs());
                if (!kwe)
                    break;
                if (!strcmp(kwe->value(), "fmt"))
                {
                    fmt = ee;
                    break;
                }
            }
        }
        else
            break;

        // analis  fmt
        { SgLabel *lab, *newlab;
        lab = NULL;
        if (deb_reg > 2)
            printf("fmt variant %d\n", fmt->rhs()->variant());
        if (fmt && fmt->rhs()->variant() == LABEL_REF)
        {
            lab = ((SgLabelRefExp *)(fmt->rhs()))->label();
            if (deb_reg > 2)
                printf("label [%d] \n", lab->id());
        }
        else if (fmt && fmt->rhs()->variant() == INT_VAL)  //!!!parser error
        {
            if (deb_reg > 2)
                printf("variant fmt = %d  %d\n", fmt->rhs()->variant(), ((SgValueExp *)(fmt->rhs()))->intValue());
            lab = isLabelWithScope(((SgValueExp *)(fmt->rhs()))->intValue(), header);
            if (lab)
                fmt->setRhs(new SgLabelRefExp(*lab));
        }
        if (!lab)  break;
        //printf("label [%d] %d\ n",lab->id(),LABEL_STMTNO(lab->thelabel));
      // replace label in fmt->lhs() 
        if ((newlab = isInFormatMap(lab)) != NULL)
            NODE_LABEL(fmt->rhs()->thellnd) = newlab->thelabel;
        }
        }
        break;
        default:
            break;
        }
    }
    return;
}

SgLabel *isInFormatMap(SgLabel *lab)
{
    label_list *ll;
    for (ll = format_labels; ll; ll = ll->next)
    {
        if (ll->lab == lab)
            return(ll->newlab);
    }
    return(NULL);
}

//-------------------------------------------------------------------------------------------
void AdjustableArrayBounds(SgStatement *header, SgStatement *after)
{
    int npar, i, j, rank;
    SgExpression *bound;
    SgSymbol *param;

    cur_func = header;
    npar = ((SgProgHedrStmt *)header)->numberOfParameters();
    for (i = 0; i < npar; i++)
    {
        param = ((SgProgHedrStmt *)header)->parameter(i);
        if (isSgArrayType(param->type()))  // is array
        {
            rank = Rank(param);
            for (j = 0; j < rank; j++)
            {
                if (isAdustableBound(bound = LowerBound(param, j)))
                    PrecalculateArrayBound(param, bound, after, header);

                if (isAdustableBound(bound = UpperBound(param, j)))
                    PrecalculateArrayBound(param, bound, after, header);
            } //end for j
        }
    } // end for i
}

int isAdustableBound(SgExpression *bound)
{
    if (!bound)
        return 0;
    if (bound->variant() == INT_VAL)
        return 0;
    return(SearchVarRef(bound));
}

int SearchVarRef(SgExpression *e)
{
    if (!e)
        return 0;
    if (isSgVarRefExp(e) && e->symbol()->variant() == VARIABLE_NAME)
        return 1;
    if (SearchVarRef(e->lhs()) || SearchVarRef(e->rhs()))
        return 1;
    else
        return 0;
}
void PrecalculateArrayBound(SgSymbol *ar, SgExpression *bound, SgStatement *after, SgStatement *header)

{
    SgStatement *newst;
    SgSymbol *sb;
    SgExpression **pbe = new (SgExpression *);

    sb = GetTempVarForBound(ar);
    newst = new SgAssignStmt(*new SgVarRefExp(sb), bound->copy());
    InsertNewStatementAfter(newst, after, header);
    *pbe = new SgVarRefExp(sb);
    bound->addAttribute(PRE_BOUND, (void *)pbe, sizeof(SgExpression *));

    return;
}

//-------------------------------------------------------------------------------------------
void ReplaceWholeArrayRefInIOStmts(SgStatement *header)
{
    SgStatement *stmt, *last;
    SgExpression *iol, *e;

    cur_func = header;

    last = header->lastNodeOfStmt();

    for (stmt = header; stmt && (stmt != last); stmt = stmt->lexNext())
    {
        switch (stmt->variant())
        {
        case WRITE_STAT:
        case READ_STAT:
        case PRINT_STAT:
            iol = stmt->expr(0); //input-output list
            for (; iol; iol = iol->rhs())
            {
                e = iol->lhs();  // list item
                if (isSgArrayRefExp(e) && isSgArrayType(e->symbol()->type()) && !e->lhs() && isDummyArgument(e->symbol())) //whole formal array ref
                    iol->setLhs(ImplicitLoop(e->symbol()));
            }
            break;
        default:
            break;
        }
    } //end for
}


SgExpression *ImplicitLoop(SgSymbol *ar)
{
    SgExpression *ei[10];
    SgArrayRefExp *eref;
    int rank, i;

    rank = Rank(ar);
    for (i = 0; i < rank; i++)
        if (!do_var[i])
        {
            do_var[i] = GetImplicitDoVar(i);
            MakeDeclarationStmtInTop(do_var[i]);
        }
    //ei[0] = new SgIOAccessExp(*do_var[0], *LowerLoopBound(ar,0), *UpperLoopBound(ar,0));
    ei[0] = new SgExpression(IOACCESS);
    ei[0]->setSymbol(do_var[0]);
    ei[0]->setRhs(new SgExpression(SEQ, new SgExpression(DDOT, LowerLoopBound(ar, 0), UpperLoopBound(ar, 0), NULL), NULL, NULL));
    eref = new SgArrayRefExp(*ar);
    for (i = 0; i < rank; i++)
        eref->addSubscript(*new SgVarRefExp(do_var[i]));
    ei[0]->setLhs(new SgExprListExp(*eref));

    for (i = 1; i < rank; i++)
    {  //ei[i] = new SgIOAccessExp(*si[i], LowerBound(ar,i)->copy(), UpperBound(ar,i)->copy());
        ei[i] = new SgExpression(IOACCESS);
        ei[i]->setSymbol(do_var[i]);
        ei[i]->setRhs(new SgExpression(SEQ, new SgExpression(DDOT, LowerLoopBound(ar, i), UpperLoopBound(ar, i), NULL), NULL, NULL));
        ei[i]->setLhs(new SgExprListExp(*ei[i - 1]));
    }
    return(ei[rank - 1]);
}

SgExpression * LowerLoopBound(SgSymbol *ar, int i)
{
    SgExpression *e;
    e = LowerBound(ar, i);
    if (PREBOUND(e))
        e = *PREBOUND(e);
    return(&(e->copy()));
}

SgExpression * UpperLoopBound(SgSymbol *ar, int i)
{
    SgExpression *e;
    e = UpperBound(ar, i);
    if (PREBOUND(e))
        e = *PREBOUND(e);
    return(&(e->copy()));
}


//-------------------------------------------------------------------------------------------
void RemapConstants(SgStatement *header, SgStatement *first_exec)
{
    SgStatement *stmt;
    common_list = common_list_l = NULL;
    equiv_list = equiv_list_l = NULL;
    for (stmt = header; stmt && (stmt != first_exec); stmt = stmt->lexNext())
    {
        switch (stmt->variant())
        {
        case PARAM_DECL:
        {SgExpression *el;
        for (el = stmt->expr(0); el; el = el->rhs())
        {
            RemapLocalObject(el->lhs()->symbol());
        }
        continue;
        }
        case COMM_STAT:
            CommonBlockList(stmt);
            continue;
        case EQUI_STAT:
            EquivBlockList(stmt);
            continue;

        default:
            continue;
        }
    }
}

void RemapLocalVariables(SgStatement *header)
{
    SgSymbol  *s;
    for (s = sub_symb_list; s; s = NextSymbol(s))
    {  //printf("*****%s\n",s->identifier());
        if (s->variant() == CONST_NAME)
            continue;
        if (IN_COMMON(s))
            continue;

        RemapLocalObject(s);
    }
}

/*
void RemapLocalVariables(SgStatement *header)
{ SgSymbol *symb_list, *s, *ts, *snew;
  int is_in_top;
  top_symb_list = CreateListOfLocalVariables(top_header);
      symb_list = CreateListOfLocalVariables(header);
  for(s=symb_list; s; s=NextSymbol(s) )
  {  //printf("*****%s\n",s->identifier());
     RemapLocalObject(s);
       if(isDummyArgument(s))
        continue;
     if(s->variant() == CONST_NAME && s->type()->variant() == T_INT)
        continue;
     is_in_top = 0;
     for(ts=top_symb_list; ts; ts=NextSymbol(ts) )
     {
        if(!strcmp(s->identifier(),ts->identifier()))
          {is_in_top = 1; break;}
     }
     if(is_in_top)
     {
        if((s->variant()==CONST_NAME) && (ts->variant()==CONST_NAME) && CompareConstants(s,ts)) // is the same constant
        {  s->thesymb->entry.Template.declared_name = ts->thesymb;    // symbol map
             continue;
        }
        else
        { snew = GetNewTopSymbol(s);  //create new symbol of top_header scope
          s->thesymb->entry.Template.declared_name = snew->thesymb;    // symbol map
        }
     }
     else
     {  snew = s;
        SYMB_SCOPE(snew->thesymb) = top_header->thebif; //move symbol into top level routine
     }
     if(snew->variant() == CONST_NAME)
       MakeDeclarationStmtsForConstant(snew);
     else
       MakeDeclarationStmtInTop(snew);

  }

}
*/

void RemapLocalObject(SgSymbol *s)
{
    int is_in_top, md;
    SgSymbol *ts, *snew;

    if (isDummyArgument(s))
        return;
    if (s->variant() == CONST_NAME && s->type()->variant() == T_INT)
        return;
    if (s->variant() == CONST_NAME)
        TranslateExpression(((SgConstantSymb *)s)->constantValue(), &md);

    is_in_top = 0;
    for (ts = top_symb_list; ts; ts = NextSymbol(ts))
    {
        if (!strcmp(s->identifier(), ts->identifier()))
        {
            is_in_top = 1; break;
        }
    }
    if (is_in_top)
    {
        if ((s->variant() == CONST_NAME) && (ts->variant() == CONST_NAME) && CompareConstants(s, ts)) // is the same constant
        {
            s->thesymb->entry.Template.declared_name = ts->thesymb;    // symbol map
            return;
        }
        else
        {
            snew = GetNewTopSymbol(s);  //create new symbol of top_header scope
            s->thesymb->entry.Template.declared_name = snew->thesymb;    // symbol map
        }
    }
    else
    {
        snew = s;
        SYMB_SCOPE(snew->thesymb) = top_header->thebif; //move symbol into top level routine
    }
    if (snew->variant() == CONST_NAME)
        MakeDeclarationStmtsForConstant(snew);
    else
        MakeDeclarationStmtInTop(snew);

}

void RemapCommonObject(SgSymbol *s, SgSymbol *tops)
{
    s->thesymb->entry.Template.declared_name = tops->thesymb;    // symbol map
}

SgSymbol *CreateListOfLocalVariables(SgStatement *header)
{
    SgSymbol *s, *first, *symb_list;
    //first = header->symbol(); 
    first = (header == top_header) ? top_node->file->firstSymbol() : header->symbol();
    symb_list = NULL;
    for (s = first; s; s = s->next())
        if (SYMB_SCOPE(s->thesymb) == header->thebif) //if( s->scope() == header )
        {
            SYMB_LIST(s->thesymb) = symb_list ? symb_list->thesymb : NULL;    //s->thesymb->id_list
            symb_list = s;
        }

    return symb_list;
}

SgSymbol *NextSymbol(SgSymbol *s)
{
    return(SymbMapping(SYMB_LIST(s->thesymb)));
}

void MakeDeclarationStmtInTop(SgSymbol *s)
{
    SgStatement *st;
    st = s->makeVarDeclStmt();
#if __SPF
    insertBfndListIn(st->thebif, top_last_declaration->thebif, NULL);
#else
    top_last_declaration->insertStmtAfter(*st);
#endif
    top_last_declaration = st;
    if (IS_ALLOCATABLE(s)) {
        SgDeclarationStatement *allocatableStmt = new SgDeclarationStatement(ALLOCATABLE_STMT);
        SgVarRefExp *expr = new SgVarRefExp(s);
        SgExprListExp *list = new SgExprListExp(*expr);
        allocatableStmt->setExpression(0, *list);
#if __SPF        
        BIF_CP(allocatableStmt->thebif) = top_last_declaration->controlParent()->thebif;
#else
        allocatableStmt->setControlParent(top_last_declaration->controlParent());
#endif

#if __SPF
        insertBfndListIn(allocatableStmt->thebif, top_last_declaration->thebif, NULL);
#else
        top_last_declaration->insertStmtAfter(*allocatableStmt);
#endif
        top_last_declaration = allocatableStmt;
    }
}
void MakeDeclarationStmtsForConstant(SgSymbol *s)
{
    SgStatement *st;
    SgExpression *eel;
    st = new SgStatement(PARAM_DECL);
    eel = new SgExprListExp(*new SgRefExp(CONST_REF, *((SgConstantSymb *)s)));
    eel->setRhs(NULL);
    st->setExpression(0, *eel);
#if __SPF
    insertBfndListIn(st->thebif, top_last_declaration->thebif, NULL);
#else
    top_last_declaration->insertStmtAfter(*st);
#endif
    //top_header -> insertStmtAfter(*st);
    st = s->makeVarDeclStmt();
    //top_header -> insertStmtAfter(*st);
#if __SPF
    insertBfndListIn(st->thebif, top_last_declaration->thebif, NULL);
#else
    top_last_declaration->insertStmtAfter(*st);
#endif
    top_last_declaration = st->lexNext();
}
// SgConstantSymb * sc =  isSgConstantSymb(e->symbol());
//  return(ReplaceIntegerParameter(&(sc->constantValue()->copy())));

int CompareConstants(SgSymbol *rs, SgSymbol *ts)
{
    PTR_LLND cers, cets;
    int ic;
    cers = SYMB_VAL(rs->thesymb);
    cets = SYMB_VAL(ts->thesymb);
    if (cers->variant != cets->variant)
        return(0);

    /*
     if(cers->variant==FLOAT_VAL || cers->variant==DOUBLE_VAL || cers->variant==STRING_VAL)
     {   if(!strcmp(NODE_STR(cers),NODE_STR(cets)) )
           return(1);
         else
           return(0);
     }
     if(cers->variant==COMPLEX_VAL) {
         int icm;
         icm = CompareConstants(NODE_TEMPLATE_LL1(cers)) && CompareConstants(cers->rhs());
         return(icm);
     }
     if(cers->variant==BOOL_VAL)
         if(NODE_BV(cers) == NODE_BV(cets))
           return(1);
         else
           return(0);
     return(0);
    */

    ic = 0;
    switch (cers->variant)
    {
    case (FLOAT_VAL):
    case (DOUBLE_VAL):
    case (STRING_VAL):
        if (!strcmp(NODE_STR(cers), NODE_STR(cets)))
            ic = 1;
        break;
    case (BOOL_VAL):
        if (NODE_BV(cers) == NODE_BV(cets))
            ic = 1;;
        break;
    case (COMPLEX_VAL):
        ic = CompareValues(NODE_TEMPLATE_LL1(cers), NODE_TEMPLATE_LL1(cets)) && CompareValues(NODE_TEMPLATE_LL2(cers), NODE_TEMPLATE_LL2(cets));
        break;
    default:
        break;
    }
    return (ic);
}

int CompareValues(PTR_LLND pe1, PTR_LLND pe2)
{
    if (pe1->variant != pe2->variant)
        return(0);
    if ((pe1->variant != FLOAT_VAL) && (pe1->variant != DOUBLE_VAL))
        return(0);
    if (!strcmp(NODE_STR(pe1), NODE_STR(pe2)))
        return(1);
    return(0);
}

void CommonBlockList(SgStatement *stmt)
{
    SgExpression *ec, *el;
    SgSymbol *sc;
    for (ec = stmt->expr(0); ec; ec = ec->rhs()) // looking through COMM_LIST
    { //if(isInCommonList(common_list->block->symbol(),common_list)
        common_list_l = AddToBlockList(common_list_l, ec);
        if (!common_list) common_list = common_list_l;
        for (el = ec->lhs(); el; el = el->rhs())
        {
            sc = el->lhs()->symbol();
            //if(sc && ((sc->attributes() & ALIGN_BIT) || (sc->attributes() & DISTRIBUTE_BIT)) )
              // el->lhs()->setLhs(NULL);  
            if (sc)
                SYMB_ATTR(sc->thesymb) = SYMB_ATTR(sc->thesymb) | COMMON_BIT;
        }
    }
}

void TopCommonBlockList(SgStatement *stmt)
{
    SgExpression *ec, *el;
    SgSymbol *sc;
    for (ec = stmt->expr(0); ec; ec = ec->rhs()) // looking through COMM_LIST
    {
        top_common_list_l = AddToBlockList(top_common_list_l, ec);
        if (!top_common_list) top_common_list = top_common_list_l;
        for (el = ec->lhs(); el; el = el->rhs())
        {
            sc = el->lhs()->symbol();
            //if(sc && ((sc->attributes() & ALIGN_BIT) || (sc->attributes() & DISTRIBUTE_BIT)) )
              // el->lhs()->setLhs(NULL);  
            if (sc)
                SYMB_ATTR(sc->thesymb) = SYMB_ATTR(sc->thesymb) | COMMON_BIT;
        }
    }
}

void CreateTopCommonBlockList()
{
    SgStatement *stmt;
    top_common_list = top_common_list_l = NULL;
    top_equiv_list = top_equiv_list_l = NULL;
    for (stmt = top_header; stmt && (stmt != top_first_executable); stmt = stmt->lexNext())
    {
        switch (stmt->variant())
        {
        case COMM_STAT:
            TopCommonBlockList(stmt);
            continue;
        case EQUI_STAT:
            //TopEquivBlockList(stmt);
            continue;

        default:
            continue;
        }
    }
}


block_list *AddToBlockList(block_list *blist_last, SgExpression *eb)
{
    block_list * bl;
    bl = new block_list;
    bl->block = eb;
    bl->next = NULL;
    if (!blist_last) {
        blist_last = bl;
    }
    else {
        blist_last->next = bl;
        blist_last = bl;
    }
    return(blist_last);
}

void EquivBlockList(SgStatement *stmt)
{
    SgExpression *ec;
    // SgSymbol *sc; 
    for (ec = stmt->expr(0); ec; ec = ec->rhs()) // looking through LIST
    {
        equiv_list_l = AddToBlockList(equiv_list_l, ec);
        if (!equiv_list) equiv_list = equiv_list_l;
    }
}

void RemapCommonBlocks(SgStatement *header)
{
    block_list *bl, *topbl;
    SgStatement *com;
    SgExpression *tl, *rl;
    SgSymbol *tops = NULL;
    //int md[1];
   // for each subprogram COMMON block 
    for (bl = common_list; bl; bl = bl->next)
        if (!(topbl = isConflictingCommon(bl->block->symbol())))  //unconflicting common
        {  //bl->block->lhs()->unparsestdout();
            RemapCommonList(bl->block->lhs());
            EditExpressionList(bl->block->lhs());
            TranslateExpressionList(bl->block->lhs());
            //bl->block->lhs()->unparsestdout();
            com = DeclaringCommonBlock(bl->block); //creating new COMMON statement and inserting one in top routine
#if __SPF
            insertBfndListIn(com->thebif, top_last_declaration->thebif, NULL);
#else
            top_last_declaration->insertStmtAfter(*com);
#endif
            top_last_declaration = com;
        }
        else
        {
            tl = topbl->block->lhs();
            rl = bl->block->lhs();
            while (tl && rl)
            {
                if (!areOfSameType(tl->lhs()->symbol(), rl->lhs()->symbol()))
                {
                    Error("COMMON block in procedure  %s  with unconformable reference. Sorry, not implemented yet", header->symbol()->identifier(), 1, header);  //tops = generate an equivalenced top level variable
                    printf("%s    %s\n", tl->lhs()->symbol()->identifier(), rl->lhs()->symbol()->identifier());
                }
                else
                    tops = tl->lhs()->symbol();
                RemapCommonObject(rl->lhs()->symbol(), tops); //!!! remake after realizing CalculateTopLevelRef()
                CalculateTopLevelRef(tops, tl->lhs(), rl->lhs());
                MakeRefsConformable(tl->lhs(), rl->lhs());
                tl = tl->rhs();
                rl = rl->rhs();
            }
        }
}
void RemapCommonList(SgExpression *el)
{
    SgExpression *coml;
    coml = el;
    while (coml)
    {
        RemapLocalObject(coml->lhs()->symbol());
        coml = coml->rhs();
    }
}

int areOfSameType(SgSymbol *st, SgSymbol *sr)
{
    int res;
    SgType *tt, *rt;
    tt = BaseType(st->type());
    rt = BaseType(sr->type());
    res = tt->variant() == rt->variant() && TypeSize(tt) && TypeSize(tt) == TypeSize(rt);
    return(res);
}

int IntrinsicTypeSize(SgType *t)
{
    switch (t->variant()) {
    case T_INT:
    case T_BOOL:     return (4);
    case T_FLOAT:    return (4);
    case T_COMPLEX:  return (8);
    case T_DOUBLE:   return (8);

    case T_DCOMPLEX: return(16);

    case T_STRING:
    case T_CHAR:
        return(1);
    default:
        return(0);
    }
}

int TypeSize(SgType *t)
{
    //SgExpression *le;
    int len;
    if (!TYPE_RANGES(t->thetype) && !TYPE_KIND_LEN(t->thetype))       return (IntrinsicTypeSize(t));

    if ((len = TypeLength(t)))    return(len);

    //le = TypeLengthExpr(t);
    //if(le->isInteger()){
    //  len = le->valueInteger();
    //  len = len < 0 ? 0 : len; //according to standard F90
    //} else
    //  len = -1; //may be error situation

    return(0);
}

int TypeLength(SgType *t)
{
    SgExpression *le;
    SgValueExp *ve;
    //if(t->variant() == T_STRING)   return (0);
    if (TYPE_RANGES(t->thetype)) {
        le = t->length();
        if ((ve = isSgValueExp(le)))
            return (ve->intValue());
        else
            return (0);
    }
    if (TYPE_KIND_LEN(t->thetype)) {        /*22.04.14*/
        le = t->selector()->lhs();
        if ((ve = isSgValueExp(le)))
            if (t->variant() == T_COMPLEX || t->variant() == T_DCOMPLEX)
                return (2 * ve->intValue());
            else
                return (ve->intValue());
        else
            return (0);
    }

    return(0);
}

SgType *BaseType(SgType *type)
{
    return (isSgArrayType(type) ? type->baseType() : type);
}

int isUnconflictingCommon(SgSymbol *s)
{
    block_list *bl;
    for (bl = top_common_list; bl; bl = bl->next)
        if (bl->block->symbol() == s)
            return(0);
    return(1);
}

block_list *isConflictingCommon(SgSymbol *s)
{
    block_list *bl;
    //printSymb(s);
    //printf("  variant %d\n",s->variant());
    for (bl = top_common_list; bl; bl = bl->next) {
        //if(bl && bl->block ) printSymb(bl->block->symbol());
        if (bl->block->symbol() == s)
            return(bl);
    }
    //printf("NO\n");
    return(NULL);
}

block_list *isInCommonList(SgSymbol *s, block_list *blc)
{
    block_list *bl;
    for (bl = blc; bl; bl = bl->next)
        if (bl->block->symbol() == s)
            return(bl);
    return(NULL);
}


SgStatement *DeclaringCommonBlock(SgExpression *bl)
{
    SgStatement *com;
    //SgExpression *eeq;
        // eeq = new SgExpression (COMM_LIST);
        // eeq -> setSymbol(*bl->symbol());
        // eeq -> setLhs(*bl->lhs());
        // com = new SgStatement(COMM_STAT);
        // com->setExpression(0,*eeq);
    com = new SgStatement(COMM_STAT);
    com->setExpression(0, *bl);

    return(com);
}
//-------------------------------------------------------------------------------------------



//-------------------------------------------------------------------------------------------
//-------------------------------------------------------------------------------------------
//    S I T E - S P E C I F I C    T R A N S F O R M A T I O N S
//-------------------------------------------------------------------------------------------
//-------------------------------------------------------------------------------------------

void RemapFunctionResultVar(SgExpression *topref, SgSymbol *sf)
{
    SgSymbol *topvar;
    topvar = topref->symbol();
    sf->thesymb->entry.Template.declared_name = topvar->thesymb;    // symbol map
    if (isSgArrayRefExp(topref) && topref->lhs())
        sf->addAttribute(ARRAY_MAP_1, (void *)topref, 0);
}

void ConformActualAndFormalParameters(SgSymbol *scopy, SgExpression *args, SgStatement *parentSt)
{
    PTR_SYMB  dummy;
    SgSymbol *darg;
    SgExpression *fact, *farglist;
    //int cnf_type;
    int adj;
    adj = 0;
    farglist = args;
    dummy = scopy->thesymb->entry.proc_decl.in_list;
    /*
      if(!dummy) return;
        printf("dummy of %s: %s\n",scopy->identifier(),dummy->ident);
      next = dummy->entry.var_decl.next_in ;
      while(next)
      {   //if(!next) return;
        printf("dummy of %s: %s\n",scopy->identifier(),next->ident);
        next = next->entry.var_decl.next_in ;
      }
   */


   // alternative return, dummy is *, represented by symbol with kind DEFAULT and name "*" !!!!????

    while (dummy && farglist)
    {  // printf("dummy of %s: %s\n",scopy->identifier(),dummy->ident);
        fact = farglist->lhs();
        darg = SymbMapping(dummy);
        if (isAdjustableArray(darg))
        {
            adj = 1;
            darg->addAttribute(ADJUSTABLE_, (void *)fact, 0);
        }
        else
            ConformReferences(darg, fact, parentSt);
        dummy = dummy->entry.var_decl.next_in;
        farglist = farglist->rhs();
    }
    dummy = scopy->thesymb->entry.proc_decl.in_list;
    while (adj && dummy)
    {
        darg = SymbMapping(dummy);
        if ((fact = ADJUSTABLE(darg)))
        {
            TranslateArrayTypeExpressions(darg);
            ConformReferences(darg, fact, parentSt);
        }
        dummy = dummy->entry.var_decl.next_in;
    }

}

void ConformReferences(SgSymbol *darg, SgExpression *fact, SgStatement *parentSt)
{
    int cnf_type;

    cnf_type = TestConformability(darg, fact, parentSt);
    if (!cnf_type)
    {
        Error("Non conformable %s. Case not implemented yet", darg->identifier(), 1, parentSt); // not realized
        //fact->unparsestdout(); printf("\n"); darg->scope()->unparsestdout();
        if (deb_reg)
            printf("Non conformable. Case not implemented yet\n");
    }

    switch (cnf_type)
    {
    case _IDENTICAL_:
        darg->thesymb->entry.Template.declared_name = fact->symbol()->thesymb;
        break;

    case SCALAR_ARRAYREF:
        darg->thesymb->entry.Template.declared_name = fact->symbol()->thesymb;
        darg->addAttribute(ARRAY_MAP_1, (void *)fact, 0);
        break;

    case _SUBARRAY_:
        darg->thesymb->entry.Template.declared_name = fact->symbol()->thesymb;
        darg->addAttribute(ARRAY_MAP_1, (void *)(fact->lhs()), 0);
        break;
    case _CONSTANT_:
        darg->addAttribute(CONSTANT_MAP, (void *)fact, 0);
        break;
    case VECTOR_ARRAYREF:
        darg->thesymb->entry.Template.declared_name = fact->symbol()->thesymb;
        //if(fact->lhs()->lhs())
        darg->addAttribute(ARRAY_MAP_2, (void *)(fact->lhs()), 0);
        break;
    case _ARRAY_:
        break;
    }
}

int isAdjustableArray(SgSymbol *param)
{
    int rank, j;
    if (!isSgArrayType(param->type()))
        return(0);
    rank = Rank(param);
    for (j = 0; j < rank; j++)
    {
        if (isAdustableBound(LowerBound(param, j)))
            return(1);;

        if (isAdustableBound(UpperBound(param, j)))
            return(1);;
    }
    return(0);
}

SgSymbol *FirstDummy(SgSymbol *sf)
{
    return(SymbMapping(sf->thesymb->entry.proc_decl.in_list));
}


SgSymbol *NextDummy(SgSymbol *s)
{    
    return(SymbMapping(s->thesymb->entry.var_decl.next_in));
}

int TestConformability(SgSymbol *darg, SgExpression *fact, SgStatement *parentSt)
{
    SgArrayType *ftp;

    if (isFormalProcedure(darg))
        return(_IDENTICAL_);

    if (!SameType(darg, fact))
        return(NON_CONFORMABLE);

    if (isSgValueExp(fact))
        return(_CONSTANT_);

    if (isScalar(darg))
    {  //printf("scalar %s(%d): %s\n", darg->identifier(),darg->variant(),fact->symbol()->identifier());
        if (isSgArrayRefExp(fact) && fact->lhs() && !isSgArrayType(fact->type()))
            return(SCALAR_ARRAYREF);
        else
            return(_IDENTICAL_);
    }

    if (isArray(darg))
    {  //printf("array %s(%d): %s\n", darg->identifier(),darg->variant(),fact->symbol()->identifier()); 
        if ((ftp = isSgArrayType(fact->symbol()->type())) && fact->lhs() && TestShapes(ftp, (SgArrayType *)(darg->type())) && TestBounds(fact, ftp, (SgArrayType *)(darg->type())))
            return(_SUBARRAY_);
        if ((ftp = isSgArrayType(fact->symbol()->type())) && fact->lhs() && TestVector(fact, ftp, (SgArrayType *)(darg->type())))
            return(VECTOR_ARRAYREF);

        if ((ftp = isSgArrayType(fact->symbol()->type())) && !fact->lhs() && SameShapes(ftp, (SgArrayType *)(darg->type())))
            return(_IDENTICAL_);

    }
    Error("TestConformability(%s,...). Case not implemented yet", darg->identifier(), 1, parentSt);
    if (deb_reg)
        printf("TestConformability(). Case not implemented yet\n");
    return(NON_CONFORMABLE);
}

int SameType(SgSymbol *darg, SgExpression *fact)
{
    SgType *dtype, *fact_type, *fstype;
    SgSymbol *fsymb;
    dtype = darg->type();
    if (isSgArrayType(dtype))
        dtype = dtype->baseType();
    fact_type = fact->type();
    fsymb = fact->symbol();

    // if(isSgVarRefExp(fact) && !isSgArrayType(fact->symbol()->type()) && 
    //    Same(dtype,fact->symbol()->type())
    //   return(1);

     //if(isScalar(darg) && !isSgArrayType(fact->type()))
    {   if (isSgVarRefExp(fact) || fact->variant() == CONST_REF)
        return(Same(fsymb->type(), dtype));
    if (isSgArrayRefExp(fact) && isSgArrayType(fsymb->type()))
        return(Same(fsymb->type()->baseType(), dtype));
    if (isSgValueExp(fact))
        return(Same(fact->type(), dtype));
    if (isSgArrayRefExp(fact) && fsymb->type()->variant() == T_STRING)
        return(Same(fsymb->type(), dtype));
    if (fact->variant() == ARRAY_OP)
    {
        if (isSgArrayType(fstype = fact->lhs()->symbol()->type()))
            fstype = fstype->baseType();
        return(Same(fstype, dtype));
    }
    }
    ////!!!!!!!
    return(0);
}

int Same(SgType *ft, SgType *dt)
{
    //TYPE_RANGES((T)->thetype)

    if (!ft || !dt)
        return(1);
    if ((dt->variant() == T_STRING) != 0)
    {
        if (ft->variant() == dt->variant())
            return(1);
        else
            return(0);
    }

    if (ft->variant() == dt->variant() && TypeSize(ft) && TypeSize(ft) == TypeSize(dt))
        return(1);

    if (ft->variant() == T_DOUBLE && dt->variant() == T_FLOAT && TypeSize(ft) == TypeSize(dt))
        return(1);
    if (dt->variant() == T_DOUBLE && ft->variant() == T_FLOAT && TypeSize(ft) == TypeSize(dt))
        return(1);

    if (ft->variant() == T_DCOMPLEX && dt->variant() == T_COMPLEX && TypeSize(ft) == TypeSize(dt))
        return(1);
    if (dt->variant() == T_DCOMPLEX && ft->variant() == T_COMPLEX && TypeSize(ft) == TypeSize(dt))
        return(1);
    return(0);

    //return(1); // temporary!!!!
}

int isScalar(SgSymbol *symb)
{
    if ((symb->variant() == VARIABLE_NAME) && !isSgArrayType(symb->type()))
        return(1);
    else
        return(0);
}

int isArray(SgSymbol *symb)
{
    if ((symb->variant() == VARIABLE_NAME) && isSgArrayType(symb->type()))
        return(1);
    else
        return(0);
}

int isFormalProcedure(SgSymbol *symb)
{
    switch (symb->variant())
    {
    case PROCEDURE_NAME:
    case FUNCTION_NAME:
    case ROUTINE_NAME:
        return(1);
    default:
        return(0);
    }
}

/*
int TestShapes(SgArrayType *ftp, SgArrayType *dtp)
{SgExpression *fe, *de;

 if(dtp && dtp->dimension() == 1 && ftp->dimension() > 1 && IdenticalValues((fe=ftp->sizeInDim(0)),(de=dtp->sizeInDim(0))) && IdenticalValues(LowerBoundOfDim(fe),LowerBoundOfDim(de)) )
    return(1);
 else
    return(0);
}
*/

int TestShapes(SgArrayType *ftp, SgArrayType *dtp)
{
    SgExpression *fe, *de;
    int rank, i;
    if (!dtp || !ftp) return(0);
    rank = dtp->dimension();
    if (rank > ftp->dimension())
        return(0);

    for (i = 0; i < rank; i++)
    {
        fe = ftp->sizeInDim(i);
        de = dtp->sizeInDim(i);
        if (!SameDims(fe, de))
            return(0);
    }
    return(1);
}

int TestBounds(SgExpression *fact, SgArrayType *ftp, SgArrayType *dtp)
{
    SgExpression *fe, *fl;
    int rank, i;
    if (!dtp || !ftp) return(0);
    rank = dtp->dimension();
    fl = fact->lhs();
    for (i = 0; i < rank; i++, fl = fl->rhs())
    {
        fe = ftp->sizeInDim(i);
        if (!isSgSubscriptExp(fe) && fl->lhs()->isInteger() && fl->lhs()->valueInteger() == 1)
            continue;
        if (IdenticalValues(fl->lhs(), LowerBoundOfDim(fe)))
            continue;
        else
            return(0);
    }
    return(1);
}

int TestVector(SgExpression *fact, SgArrayType *ftp, SgArrayType *dtp)
{//SgExpression *fe, *de, *e1;
    int rank;
    if (!dtp || !ftp) return(0);
    rank = dtp->dimension();
    if (rank > 1) return(0);
    //fl = fact->lhs();
    //de=dtp->sizeInDim(0);
    //fe=ftp->sizeInDim(0);
   /* e1=&(*(fl->lhs()) - (LowerBoundOfDim(de)->copy()));
    fl->setLhs(e1);
    if(e1->isInteger() && e1->valueInteger()==0)
      fl->setLhs(NULL);
   */
    return(1);
}


int SameDims(SgExpression *fe, SgExpression *de)
{
    if (isSgSubscriptExp(fe) || isSgSubscriptExp(de))
    {
        if (!IdenticalValues(LowerBoundOfDim(fe), LowerBoundOfDim(de)))
            return(0);
    }
    if (!IdenticalValues(UpperBoundOfDim(fe), UpperBoundOfDim(de)))
        return(0);

    return(1);
}


int SameShapes(SgArrayType *ftp, SgArrayType *dtp)
{
    SgExpression *fe, *de;
    int rank, i;
    if (!dtp || !ftp) return(0);
    rank = dtp->dimension();
    if (rank != ftp->dimension())
        return(0);

    for (i = 0; i < rank; i++)
    {
        fe = ftp->sizeInDim(i);
        de = dtp->sizeInDim(i);
        if (isSgSubscriptExp(fe) || isSgSubscriptExp(de))
        {
            if (!IdenticalValues(LowerBoundOfDim(fe), LowerBoundOfDim(de)))
                return(0);
        }
        if (i < rank - 1 && !IdenticalValues(UpperBoundOfDim(fe), UpperBoundOfDim(de)))
            return(0);
    }
    return(1);
}

SgExpression *LowerBoundOfDim(SgExpression *e)
// lower bound of dimension e
{
    SgSubscriptExp *sbe;

    if (!e)
        return(NULL);

    if ((sbe = isSgSubscriptExp(e)) != NULL) {
        if (sbe->lbound())
            return(sbe->lbound());
        else
            return(new SgValueExp(1));
    }
    else
        return(new SgValueExp(1));  // by default lower bound = 1      
}

SgExpression *UpperBoundOfDim(SgExpression *e)
// upper bound of dimension e
{
    SgSubscriptExp *sbe;

    if (!e)
        return(NULL);
    if ((sbe = isSgSubscriptExp(e)) != NULL) {
        if (sbe->ubound())
            return(sbe->ubound());
    }
    return(e);

}


SgExpression *FirstIndexChange(SgExpression *e, SgExpression *index)
{ //SgExpression *e0;
  //e0 = e->lhs();
    if (!index)
        return(e);
    e->setLhs(index->copy());
    return(e);
}

SgExpression *IndexChange(SgExpression *e, SgExpression *index, SgExpression *lbe)
{
    SgExpression *e0;
    int iv;
    if (!index)
        return(e);
    //e->setLhs(index->copy()+*(e->lhs())-lbe->copy());

    e0 = &(*(e->lhs()) - lbe->copy());

    if (e0->isInteger())
    {
        if ((iv = e0->valueInteger()) == 0)
            e->setLhs(index->copy());
        else
            e->setLhs(index->copy() + *new SgValueExp(iv));
    }
    else
        e->setLhs(index->copy() + *e0);
    return(e);
}

SgExpression *FirstIndexesChange(SgExpression *mape, SgExpression *re)
{
    SgExpression *el, *mel;
    for (el = re, mel = mape; el; el = el->rhs(), mel = mel->rhs())
        mel->setLhs(el->lhs());
    return(mape);
}



int IdenticalValues(SgExpression *e1, SgExpression *e2)
{
    //return(ExpCompare(Calculate(e1), Calculate(e2)));
    if (!e1 || !e2)
        return(0);
    if (e1->isInteger() && e2->isInteger())
    {
        if (e1->valueInteger() == e2->valueInteger())
            return(1);
        else
            return(0);
    }
    else
        return(0);
}

void TranslateArrayTypeExpressions(SgSymbol *darg)
{
    SgArrayType *arrtype;
    SgExpression *el;
    int rank, md;
    arrtype = isSgArrayType(darg->type());
    rank = arrtype->dimension();
    el = arrtype->getDimList();
    TranslateExpression(el, &md);

}

SgStatement *TranslateSubprogramReferences(SgStatement *header)
{
    SgStatement *stmt, *last, *first_executable = NULL, *last_decl;
    SgSymbol *s_top;
    int mdfd[3];
    last = header->lastNodeOfStmt();
    cur_func = top_header;
    for (stmt = header->lexNext(); stmt && (stmt != last); stmt = stmt->lexNext())
        if (isSgExecutableStatement(stmt) && stmt->variant() != FORMAT_STAT) {
            first_executable = stmt;  break;
        }
    last_decl = stmt->lexPrev();
    for (stmt = first_executable; stmt && (stmt != last); stmt = stmt->lexNext())
    {
        mdfd[0] = mdfd[1] = mdfd[2] = 0; //modified=0;
        switch (stmt->variant())
        {
            /* case OPEN_STAT:
               case CLOSE_STAT:
               case INQUIRE_STAT:
               case BACKSPACE_STAT:
               case ENDFILE_STAT:
               case REWIND_STAT:
                    break;
            */
        case WRITE_STAT:
        case READ_STAT:
        case PRINT_STAT:
            //mdfd[0]=mdfd[1]=0; //modified=0;
            if (stmt->expr(1))
                stmt->setExpression(1, *TranslateExpression(stmt->expr(1), &mdfd[1]));
            if (stmt->expr(0))
                stmt->setExpression(0, *TranslateExpression(stmt->expr(0), &mdfd[0]));
            if (mdfd[0] || mdfd[1])
                StatementCleaning(stmt);
            continue;

        case FOR_NODE:
        case PROC_STAT:
            if ((s_top = SymbolMap(stmt->symbol())) != 0)
            {
                stmt->setSymbol(*s_top);
                if (stmt->variant() == PROC_STAT)
                    mdfd[0] = 1;
            }

        default:
            //mdfd[0]=mdfd[1]=mdfd[2]=0; //modified=0;
            if (stmt->expr(0))
                stmt->setExpression(0, *TranslateExpression(stmt->expr(0), &mdfd[0]));
            if (stmt->expr(1))
                stmt->setExpression(1, *TranslateExpression(stmt->expr(1), &mdfd[1]));
            if (stmt->expr(2))
                stmt->setExpression(2, *TranslateExpression(stmt->expr(2), &mdfd[2]));
            if (mdfd[0] || mdfd[1] || mdfd[2])
                StatementCleaning(stmt);
            continue;
        }

    }
    return(last_decl->lexNext());
}

SgExpression *TranslateExpression(SgExpression *e, int *md)
{
    SgExpression *el, *aref, *cref;
    SgSymbol *s_top, *s;
    if (!e)
        return(e);

    if (isSgArrayRefExp(e))
    {
        for (el = e->lhs(); el; el = el->rhs())
            el->setLhs(TranslateExpression(el->lhs(), md));
        s = e->symbol();
        /* if((s_top=SymbolMap(s)))
          if(!(aref=ArrayMap(s)))
            e->setSymbol(s_top);
          else if(aref->variant() == EXPR_LIST)
          { e->setSymbol(s_top);
            e->setLhs(FirstIndexesChange(&(aref->copy()),e->lhs()));
            *md = 1;
          }
        */
        if ((s_top = SymbolMap(s)))
            e->setSymbol(s_top);
        if ((aref = ArrayMap(s)) && (aref->variant() == EXPR_LIST))
        {
            e->setLhs(FirstIndexesChange(&(aref->copy()), e->lhs()));
            *md = 1;
        }
        if ((aref = ARRAYMAP2(s)))
        {
            e->setLhs(IndexChange(&(aref->copy()), e->lhs(), LowerBound(s, 0)));
            *md = 1;
        }
        return(e);
    }
    //if(e->variant()==ARRAY_OP)
    // ;
    if (isSgVarRefExp(e))
    {
        s = e->symbol();
        //if((s_top=SymbolMap(s)) && !ArrayMap(s))
         // e->setSymbol(s_top);
        if ((s_top = SymbolMap(s)) != 0)
        {
            if (!(aref = ArrayMap(s)))
                e->setSymbol(s_top);
            else      //if(aref->variant() == ARRAY_REF)
            {
                NODE_CODE(e->thellnd) = ARRAY_REF;   //e->setVariant(ARRAY_REF);
                e->setSymbol(s_top);
                e->setLhs(aref->lhs()->copy());
            }
        }

        if ((cref = CONSTANTMAP(s)))
        {
            return(&(cref->copy()));
        }

        return(e);
    }

    if (e->variant() == CONST_REF)
    {
        s = e->symbol();
        if ((s_top = SymbolMap(s)))
            e->setSymbol(s_top);
        return(e);
    }


    if (isSgFunctionCallExp(e))
    {
        s = e->symbol();
        if ((s_top = SymbolMap(s)))
        {
            e->setSymbol(s_top);
            *md = 1;
        }
    }

    e->setLhs(TranslateExpression(e->lhs(), md));
    e->setRhs(TranslateExpression(e->rhs(), md));
    return(e);
}


/*
void TranslateExpression(SgExpression *e, int *md)
{  SgExpression *el, *aref;
   SgSymbol *s_top, *s;
 if(!e)
  return;
 if(isSgArrayRefExp(e))
 {
   for(el=e->lhs();el;el=el->rhs())
      TranslateExpression(el->lhs(),md);
   s= e->symbol();
   if((s_top=SymbolMap(s)))
    if(!(aref=ArrayMap(s)))
      e->setSymbol(s_top);
    else if(aref->variant() == EXPR_LIST)
    { e->setSymbol(s_top);
      e->setLhs(FirstIndexChange(&(aref->copy()),e->lhs()->lhs()));
      *md = 1;
    }
   return;
 }
 //if(e->variant()==ARRAY_OP)
 // ;
 if(isSgVarRefExp(e))
 { s= e->symbol();
   //if((s_top=SymbolMap(s)) && !ArrayMap(s))
    // e->setSymbol(s_top);
   if((s_top=SymbolMap(s)) )
     if(!(aref=ArrayMap(s)))
       e->setSymbol(s_top);
     else      //if(aref->variant() == ARRAY_REF)
     { NODE_CODE(e->thellnd) = ARRAY_REF;   //e->setVariant(ARRAY_REF);
       e->setSymbol(s_top);
       e->setLhs(aref->lhs()->copy());
     }
   return;
 }
 TranslateExpression(e->lhs(),md);
 TranslateExpression(e->rhs(),md);
}
*/

void TranslateExpression_1(SgExpression *e)
{
    SgExpression *el;
    SgSymbol *s_top, *s;
    if (!e)
        return;
    if (isSgArrayRefExp(e))
    {
        for (el = e->lhs(); el; el = el->rhs())
            TranslateExpression_1(el->lhs());
        s = e->symbol();
        if ((s_top = SymbolMap(s)) && !ArrayMap(s))
            e->setSymbol(s_top);
        return;
    }
    //if(e->variant()==ARRAY_OP)
    // ;
    if (isSgVarRefExp(e))
    {
        s = e->symbol();
        if ((s_top = SymbolMap(s)) && !ArrayMap(s))
            e->setSymbol(s_top);
        return;
    }
    TranslateExpression_1(e->lhs());
    TranslateExpression_1(e->rhs());
}

void EditExpressionList(SgExpression *e)
{
    SgExpression *el;
    for (el = e; el; el = el->rhs())
        el->lhs()->setLhs(NULL);
}


void TranslateExpressionList(SgExpression *e)
{
    SgExpression *el;
    for (el = e; el; el = el->rhs())
        TranslateExpression_1(el->lhs());
}

SgSymbol *SymbolMap(SgSymbol *s)
{
    return(SymbMapping(s->thesymb->entry.Template.declared_name));
}

SgExpression *ArrayMap(SgSymbol *s)
{
    SgExpression *aref;
    if ((aref = ARRAYMAP(s)))
        return(aref);
    else
        return(NULL);
}

SgExpression *ArrayMap2(SgSymbol *s)
{
    SgExpression *aref;
    if ((aref = ARRAYMAP2(s)))
        return(aref);
    else
        return(NULL);
}

void InsertBlockAfter(SgStatement *after, SgStatement *first, SgStatement *header)
{
    SgStatement *prevst, *last;
    last = header->lastNodeOfStmt();
    if ((prevst = last->lexPrev()) && prevst->variant() == CONT_STAT && !(prevst->hasLabel()))
        prevst->extractStmt();
    header->extractStmt();
#if __SPF
    insertBfndListIn(first->thebif, after->thebif, NULL);
#else
    after->insertStmtAfter(*first);
#endif
    last->extractStmt();  //extract  END

}
//-------------------------------------------------------------------------------------------
//-------------------------------------------------------------------------------------------
//      S T A T E M E N T S  (inserting, creating and so all)
//-------------------------------------------------------------------------------------------
//-------------------------------------------------------------------------------------------

void InsertNewStatementBefore(SgStatement *stat, SgStatement *current) {
    //SgExpression *le;
    //SgValueExp * index;
    SgStatement *st;

    st = current->controlParent();
    if (st->variant() == LOGIF_NODE) { // Logical IF
       // change by construction IF () THEN <current> ENDIF and
       // then insert statement before current statement
        st->setVariant(IF_NODE);
#if __SPF
        insertBfndListIn((new SgStatement(CONTROL_END))->thebif, current->thebif, NULL);
#else
        current->insertStmtAfter(*new SgStatement(CONTROL_END));
#endif

#if __SPF
        insertBfndListIn(stat->thebif, st->thebif, NULL);
#else
        st->insertStmtAfter(*stat);
#endif
        return;
    }

    if (current->hasLabel() && current->variant() != FORMAT_STAT && current->variant() != DATA_DECL && current->variant() != ENTRY_STAT) { //current statement has label
      //insert statement before current and set on it the label of current
        SgLabel *lab;
        lab = current->label();
        BIF_LABEL(current->thebif) = NULL;
        current->insertStmtBefore(*stat, *current->controlParent());//inserting before current statement
        stat->setLabel(*lab);
        return;
    }
    current->insertStmtBefore(*stat, *current->controlParent());//inserting before current statement 
}

void InsertNewStatementAfter(SgStatement *stat, SgStatement *current, SgStatement *cp)
{
    SgStatement *st;
    st = current;
    if (current->variant() == LOGIF_NODE)   // Logical IF
        st = current->lexNext();
    if (cp->variant() == LOGIF_NODE)
        LogIf_to_IfThen(cp);
    st->insertStmtAfter(*stat, *cp);
    // cur_st = stat;
}

void LogIf_to_IfThen(SgStatement *stmt)
{
    //replace Logical IF statement: IF ( <condition> ) <statement>
    // by construction:  IF  ( <condition> ) THEN
    //                         <statement> 
    //                   ENDIF
    stmt->setVariant(IF_NODE);
    (stmt->lexNext())->insertStmtAfter(*new SgControlEndStmt(), *stmt);
}

void ReplaceContext(SgStatement *stmt)
{
    if (isDoEndStmt(stmt))
        ReplaceDoNestLabel(stmt, NewLabel());
    else if (isSgLogIfStmt(stmt->controlParent())) {
        if (isDoEndStmt(stmt->controlParent()))
            ReplaceDoNestLabel(stmt->controlParent(), NewLabel());
        LogIf_to_IfThen(stmt->controlParent());
    }
}

int isDoEndStmt(SgStatement *stmt)
{
    SgLabel *lab, *do_lab;
    SgForStmt *parent;
    if (!(lab = stmt->label()) && stmt->variant() != CONTROL_END) //the statement has no label and
        return(0);                                               //is not ENDDO 
    parent = isSgForStmt(stmt->controlParent());
    if (!parent)  //parent isn't DO statement
        return(0);
    do_lab = parent->endOfLoop(); // label of loop end or NULL
    if (do_lab) //  DO statement with label
        if (lab && LABEL_STMTNO(lab->thelabel) == LABEL_STMTNO(do_lab->thelabel))
            // the statement label is the label of loop end  
            return(1);
        else
            return(0);
    else   //  DO statement without label
        if (stmt->variant() == CONTROL_END)
            return(1);
        else
            return(0);
}
void ReplaceDoNestLabel(SgStatement *last_st, SgLabel *new_lab)
//replaces the label of DO statement nest, which is ended by last_st,
// by new_lab
//         DO 1 I1 = 1,N1                              DO 99999 I1 = 1,N1
//         DO 1 I2 = 1,N2                              DO 99999 I2 = 1,N2
//          .  .   .                                      .  .   .       
//         DO 1 IK = 1,NK                              DO 99999 IK = 1,NK
//           . . .                                      .  .   . 
// 1       statement                              1     statement   
//                                            99999    CONTINUE
{
    SgStatement *parent, *st;
    SgLabel *lab;
    SgForStmt *do_st;
    parent = last_st->controlParent();
    lab = last_st->label();
    while ((do_st = isSgForStmt(parent)) != NULL && do_st->endOfLoop()) {
        if (LABEL_STMTNO(lab->thelabel) == LABEL_STMTNO(do_st->endOfLoop()->thelabel)) {
            if (!new_lab)
                new_lab = NewLabel();
            BIF_LABEL_USE(do_st->thebif) = new_lab->thelabel;
            parent = parent->controlParent();
        }
        else
            break;
    }
    //inserts CONTINUE statement with new_lab as label  
    st = new SgStatement(CONT_STAT);
    st->setLabel(*new_lab);
    SetScopeOfLabel(new_lab, cur_func);
    // for debug regim
    LABEL_BODY(new_lab->thelabel) = st->thebif;
    //BIF_LINE(st->thebif) = (last_st->lineNumber()) ? last_st->lineNumber() : LineNumberOfStmtWithLabel(lab);
    if (last_st->variant() != LOGIF_NODE)
        last_st->insertStmtAfter(*st, *last_st->controlParent());
    else
        (last_st->lexNext())->insertStmtAfter(*st, *last_st->controlParent());
}

//-------------------------------------------------------------------------------------------
//-------------------------------------------------------------------------------------------
//   T E M P O R A R Y   V A R I B L E S
//-------------------------------------------------------------------------------------------
//-------------------------------------------------------------------------------------------

SgSymbol *GetTempVarForF(SgSymbol *sf, SgType *t)
{
    char *name;
    SgSymbol *sn;
    name = new char[80];
    sprintf(name, "%s_%d_%d", sf->identifier(), sf->id(), vcounter++);
    sn = new SgVariableSymb(name, *t, *cur_func);
    if (isInSymbolTable(sn))
        sn = GetTempVarForF(sf, t);
    if (cur_func == top_header)
        top_temp_vars = AddToSymbList(top_temp_vars, sn);
    return(sn);
}

SgType * TypeOfResult(SgExpression *e)
{
    int indf;
    SgSymbol *sf;
    sf = e->symbol();
    indf = is_IntrinsicFunction(sf);
    if (deb_reg > 2)
        printf("indf: %d\n", indf);
    if (indf > 0)
        return(TypeF(indf, e));
    else
        return(sf->type());
}

SgType *TypeF(int indf, SgExpression *e)
{
    graph_node *gnode;
    //SgFile *f;
    gnode = getAttrNodeForSymbol(e->symbol());
    current_file = gnode->file;

    switch (intrinsic_type[indf])
    {
    case 1:    return(SgTypeInt());
    case 2:    return(SgTypeBool());
    case 3:    return(SgTypeFloat());
    case 4:    return(SgTypeDouble());
    case 5:    return(SgTypeComplex(current_file));
    case 6:    return(SgTypeDoubleComplex(current_file));
    case 7:    return(SgTypeChar());
    case (-1): //return(e->lhs()->lhs()->type()); //type of first argument
        return(TypeOfArgument(e->lhs()->lhs()));
    default:
        return(NULL);
    }
}

SgType *TypeOfArgument(SgExpression *e)
//set_expr_type() in types.c
{
    SgType *t;
    //int indf;
    //SgSymbol *sf;
    t = e ? e->type() : NULL;
    switch (e->variant()) {
    case (FUNC_CALL):
    {
        /*  sf = e->symbol();
          indf=is_IntrinsicFunction(sf);
          if(indf>0 )
          { t=TypeF(indf,e);
            if(!t)
              t=sf->type();
          }
          else
            t=sf->type();
        */
        t = TypeOfResult(e);
        break;
    }
    /*    case (VAR_REF):
             if(e->symbol())
               t=e->symbol()->type();
             else
               t=NULL;
        case (ARRAY_REF):

        case (AND_OP):
        case (OR_OP):
        case (EQ_OP):
        case (LT_OP):
        case (GT_OP):
        case (NOTEQL_OP):
        case (LTEQL_OP):
        case (EQV_OP):
        case (NEQV_OP):
        case (GTEQL_OP):
    */
    case (DIV_OP):
    case (ADD_OP):
    case (SUBT_OP):
    case (MULT_OP):
    case (EXP_OP):
    {PTR_LLND expr, len;
    PTR_TYPE l_operand, r_operand;
    int l_type, r_type, ilen = 0;
    expr = e->thellnd;
    l_operand = expr->entry.binary_op.l_operand->type;
    r_operand = expr->entry.binary_op.r_operand->type;
    if (!l_operand || !r_operand)
        break;
    else {
        if (l_operand->variant == T_ARRAY)
            l_type = l_operand->entry.ar_decl.base_type->variant;
        else
            l_type = l_operand->variant;
        if (r_operand->variant == T_ARRAY)
            r_type = r_operand->entry.ar_decl.base_type->variant;
        else
            r_type = r_operand->variant;
        if (l_operand->entry.Template.ranges)
        {
            len = (l_operand->entry.Template.ranges)->entry.Template.ll_ptr1;
            if (len && len->variant == INT_VAL)
                ilen = len->entry.ival;
            if (l_type == T_FLOAT && ilen == 8)
                l_type = T_DOUBLE;
            if (l_type == T_COMPLEX && ilen == 16)
                l_type = T_DCOMPLEX;
        }
        if (r_operand->entry.Template.ranges)
        {
            len = (r_operand->entry.Template.ranges)->entry.Template.ll_ptr1;
            if (len && len->variant == INT_VAL)
                ilen = len->entry.ival;
            if (r_type == T_FLOAT && ilen == 8)
                r_type = T_DOUBLE;
            if (r_type == T_COMPLEX && ilen == 16)
                r_type = T_DCOMPLEX;
        }

        if (l_type == T_DCOMPLEX || r_type == T_DCOMPLEX)
            t = SgTypeDoubleComplex(current_file);
        else if (l_type == T_COMPLEX || r_type == T_COMPLEX)
            t = SgTypeComplex(current_file);
        else if (l_type == T_DOUBLE || r_type == T_DOUBLE)
            t = SgTypeDouble();
        else if (l_type == T_FLOAT || r_type == T_FLOAT)
            t = SgTypeFloat();
        else if (l_type == T_INT && r_type == T_INT)
            t = SgTypeInt();

        else t = NULL;
        /*
      if (l_operand->variant == T_ARRAY)
      {
           expr->type = copy_type_node(expr->entry.binary_op.l_operand->type);
           expr->type->entry.ar_decl.base_type =  temp;
      }
                  else if (r_operand->variant == T_ARRAY)
          {
              expr->type = copy_type_node(expr->entry.binary_op.r_operand->type);
              expr->type->entry.ar_decl.base_type =  temp;
          }
      else  expr->type =  temp;
                 */
    }
    break;
    }
    case (NOT_OP):
    case (UNARY_ADD_OP):
    case (MINUS_OP):
    case (CONCAT_OP):
        //expr->type = expr->entry.unary_op.operand->type;
        t = e->lhs()->type();
        break;
    default:
        //err("Expression variant not known",322);
        break;
    }
    e->setType(t);
    return(t);

}




SgType * SgTypeComplex(SgFile *f)
{
    SgType *t;
    for (t = f->firstType(); t; t = t->next())
        if (t->variant() == T_COMPLEX)
            return(t);

    return(new SgType(T_COMPLEX));
}

SgType * SgTypeDoubleComplex(SgFile *f)
{
    SgType *t;
    for (t = f->firstType(); t; t = t->next())
        if (t->variant() == T_DCOMPLEX)
            return(t);

    return(new SgType(T_DCOMPLEX));
}

int is_IntrinsicFunction(SgSymbol *sf)
{
    graph_node *gnode;
    //printf("is intrinsic ?\n");
    gnode = getAttrNodeForSymbol(sf);
    //printf("gnode:%d\n",gnode);
    if (!gnode) return (-1);
    if (isNoBodyNode(gnode))
        return(IntrinsicInd(sf));
    else
        return(-1);
}

int is_NoExpansionFunction(SgSymbol *sf)
{
    graph_node *gnode;
    //printf("is no body ?\n");
    gnode = getAttrNodeForSymbol(sf);
    //printf("gnode:%d\n",gnode);
    if (isDummyArgument(sf)) return(0);
    if (!gnode) return (1);
    return(isNoBodyNode(gnode));
}

int IntrinsicInd(SgSymbol *sf)
{
    int i;
    if (deb_reg > 2)
        printf("is intrinsic %s\n", sf->identifier());
    for (i = 0; i < MAX_INTRINSIC_NUM; i++)
    {
        if (!intrinsic_name[i])
            break;
        //printf("%d   %s = %s\n", i, intrinsic_name[i], sf->identifier());
        if (!strcmp(sf->identifier(), intrinsic_name[i]))
            return(i);
    }
    return(-1);
}


SgSymbol *GetTempVarForArg(int i, SgSymbol *sf, SgType *t)
{
    char *name;
    SgSymbol *sn;
    name = new char[80];
    sprintf(name, "%s_%d_arg%d_%d", sf->identifier(), sf->id(), i, vcounter++);
    sn = new SgVariableSymb(name, *t, *cur_func);
    if (isInSymbolTable(sn))
        sn = GetTempVarForArg(i, sf, t);
    if (cur_func == top_header)
        top_temp_vars = AddToSymbList(top_temp_vars, sn);

    return(sn);
}

SgSymbol *GetTempVarForSubscr(SgType *t)
{
    char *name;
    SgSymbol *sn;
    name = new char[80];
    sprintf(name, "sbscr_arg_%d", vcounter++);
    sn = new SgVariableSymb(name, *t, *cur_func);
    if (isInSymbolTable(sn))
        sn = GetTempVarForSubscr(t);
    if (cur_func == top_header)
        top_temp_vars = AddToSymbList(top_temp_vars, sn);

    return(sn);
}


SgSymbol *GetTempVarForBound(SgSymbol *sa)
{
    char *name;
    SgSymbol *sn;
    name = new char[80];
    sprintf(name, "%s_%d_%d", sa->identifier(), sa->id(), vcounter++);
    sn = new SgVariableSymb(name, *SgTypeInt(), *(sa->scope()));
    if (isInSymbolTable(sn))
        sn = GetTempVarForBound(sa);
    return(sn);
}

SgSymbol *GetImplicitDoVar(int j)
{
    char *name;
    SgSymbol *sn;
    name = new char[80];
    sprintf(name, "i0%d", j + 1);
    name = NewName(name);

    //if(sn = isTopName(name)
     // if(sn->type == SgTypeInt())
       //  return(sn);
     // else
        // return(GetImplicitDoVar
    //else

    sn = new SgVariableSymb(name, *SgTypeInt(), *top_header);
    return(sn);
}

int isInSymbolTable(SgSymbol *sym)
{
    SgSymbol *s;
    for (s = cur_func->symbol(); s; s = s->next())
        if (sym != s && !strcmp(sym->identifier(), s->identifier()))
            return(1);
    return(0);
}

char *NewName(char *name)
{
    if (isTopName(name))
    {
        sprintf(name, "%s_", name);
        name = NewName(name);
    }
    return(name);
}

SgSymbol *isTopName(char *name)
{
    SgSymbol *s;
    for (s = top_header->symbol(); s; s = s->next())
        if (s->scope() == top_header && !strcmp(name, s->identifier()))
            return(s);
    return(NULL);
}

SgSymbol *isTopNameOfType(char *name, SgType *type)
{
    SgSymbol
        *s;
    for (s = top_header->symbol(); s; s = s->next())
        if (s->scope() == top_header && !strcmp(name, s->identifier()) && type == s->type())
            return(s);
    return(NULL);
}

SgSymbol *GetNewTopSymbol(SgSymbol *s)
{
    char *name;
    SgSymbol *sn;
    name = new char[80];

    sprintf(name, "%s__%d", s->identifier(), vcounter++);
    sn = new SgSymbol(s->variant(), name, *s->type(), *top_header);
    if (sn->variant() == CONST_NAME)
        SYMB_VAL(sn->thesymb) = SYMB_VAL(s->thesymb);

    if (isInTopSymbList(sn))
        sn = GetNewTopSymbol(s);

    return(sn);

}

int isInTopSymbList(SgSymbol *sym)
{
    SgSymbol *s;
    for (s = top_symb_list; s; s = NextSymbol(s))
        if (sym != s && !strcmp(sym->identifier(), s->identifier()))
            return(1);
    return(0);
}

void PrintTopSymbList()
{
    SgSymbol *s;
    printf("\nSymbol List of Top:\n");
    for (s = top_symb_list; s; s = NextSymbol(s))
        printf("    %s", s->identifier());
    return;
}

void PrintSymbList(SgSymbol *slist, SgStatement *header)
{
    SgSymbol *s;
    printf("\nSymbol List of  %s:\n", header->symbol()->identifier());
    for (s = slist; s; s = NextSymbol(s))
        printf("    %s", s->identifier());
    return;
}


//-------------------------------------------------------------------------------------------
//-------------------------------------------------------------------------------------------
//   N O T   R E A L I S E D  ! ! !
//-------------------------------------------------------------------------------------------
//-------------------------------------------------------------------------------------------

int isIntrinsicFunctionName(char *name)
{
    return(0);
}

char *ChangeIntrinsicFunctionName(char *name)
{
    return(name);
}

int isInlinedCallSite(SgStatement *stmt)
{ // !!!!! temporary
    return(1);
}
int TestFormatLabel(SgLabel *lab)
{
    return 0;
}

void MakeRefsConformable(SgExpression *tref, SgExpression *ref)
{
    return;
}

void CalculateTopLevelRef(SgSymbol *tops, SgExpression *tref, SgExpression *ref)
{
    return;
}