void Fortran_to_C::translateArraySubscript(SgPntrArrRefExp* pntrArrRefExp)
{
// get lhs operand
SgVarRefExp* arrayName = isSgVarRefExp(pntrArrRefExp->get_lhs_operand());
SgExpression* baseExp = isSgExpression(arrayName);
// get array symbol
SgVariableSymbol* arraySymbol = arrayName->get_symbol();
// get array type and dim_info
SgArrayType* arrayType = isSgArrayType(arraySymbol->get_type());
ROSE_ASSERT(arrayType);
SgExprListExp* dimInfo = arrayType->get_dim_info();
// get rhs operand
SgExprListExp* arraySubscript = isSgExprListExp(pntrArrRefExp->get_rhs_operand());
if(arrayType->findBaseType()->variantT() == V_SgTypeString)
{
arraySubscript->prepend_expression(buildIntVal(1));
}
/*
No matter it is single or multi dimensional array, pntrArrRefExp always has a
child, SgExprListExp, to store the subscript information.
*/
if(arraySubscript != NULL)
{
// get the list of subscript
SgExpressionPtrList subscriptExprList = arraySubscript->get_expressions();
// get the list of dimension inforamtion from array definition.
SgExpressionPtrList dimExpressionPtrList = dimInfo->get_expressions();
// Create new SgExpressionPtrList for the linearalized array subscript.
SgExpressionPtrList newSubscriptExprList;
// rank info has to match between subscripts and dim_info
ROSE_ASSERT(arraySubscript->get_expressions().size() == dimInfo->get_expressions().size());
if(subscriptExprList.size() == 1)
{
Rose_STL_Container<SgExpression*>::iterator j1 = subscriptExprList.begin();
Rose_STL_Container<SgExpression*>::iterator j2 = dimExpressionPtrList.begin();
SgExpression* newIndexExp = get0basedIndex(*j1, *j2);
pntrArrRefExp->set_rhs_operand(newIndexExp);
}
else
{
Rose_STL_Container<SgExpression*>::reverse_iterator j1 = subscriptExprList.rbegin();
Rose_STL_Container<SgExpression*>::reverse_iterator j2 = dimExpressionPtrList.rbegin();
SgExpression* newIndexExp = get0basedIndex(*j1, *j2);
SgPntrArrRefExp* newPntrArrRefExp = buildPntrArrRefExp(baseExp, newIndexExp);
baseExp->set_parent(newPntrArrRefExp);
j1 = j1 + 1;
j2 = j2 + 1;
for(; j1< (subscriptExprList.rend()-1); ++j1, ++j2)
{
SgExpression* newIndexExp = get0basedIndex(*j1, *j2);
baseExp = isSgExpression(newPntrArrRefExp);
newPntrArrRefExp = buildPntrArrRefExp(baseExp, newIndexExp);
baseExp->set_parent(newPntrArrRefExp);
}
newIndexExp = get0basedIndex(*j1, *j2);
pntrArrRefExp->set_lhs_operand(newPntrArrRefExp);
pntrArrRefExp->set_rhs_operand(newIndexExp);
newIndexExp->set_parent(pntrArrRefExp);
}
}
}
void Fortran_to_C::linearizeArraySubscript(SgPntrArrRefExp* pntrArrRefExp)
{
// get lhs operand
SgVarRefExp* arrayName = isSgVarRefExp(pntrArrRefExp->get_lhs_operand());
// get array symbol
SgVariableSymbol* arraySymbol = arrayName->get_symbol();
// get array type and dim_info
SgArrayType* arrayType = isSgArrayType(arraySymbol->get_type());
ROSE_ASSERT(arrayType);
SgExprListExp* dimInfo = arrayType->get_dim_info();
// get rhs operand
SgExprListExp* arraySubscript = isSgExprListExp(pntrArrRefExp->get_rhs_operand());
/*
No matter it is single or multi dimensional array, pntrArrRefExp always has a
child, SgExprListExp, to store the subscript information.
*/
if(arrayType->findBaseType()->variantT() == V_SgTypeString)
{
arraySubscript->prepend_expression(buildIntVal(1));
}
if(arraySubscript != NULL)
{
// get the list of subscript
SgExpressionPtrList subscriptExprList = arraySubscript->get_expressions();
// get the list of dimension inforamtion from array definition.
SgExpressionPtrList dimExpressionPtrList = dimInfo->get_expressions();
// Create new SgExpressionPtrList for the linearalized array subscript.
SgExpressionPtrList newSubscriptExprList;
// rank info has to match between subscripts and dim_info
ROSE_ASSERT(arraySubscript->get_expressions().size() == dimInfo->get_expressions().size());
/*
The subscript conversion is following this example:
case 1:
dimension a(d1,d2,d3,d4) ====> dimension a(d1*d2*d3*d4)
a(s1,s2,s3,s4) ====> a(s1-1 + d1*(s2-1 + d2*( s3-1 + d3*(s4-1))))
case 2:
dimension a(d1L:d1H,d2L:d2H) ====> dimension a((d1H-d1L+1)*(d2H-d2L+1))
a(s1,s2) ====> a(s1-d1L + (d1H-d1L+1)*(s2-d2L))
*/
Rose_STL_Container<SgExpression*>::reverse_iterator j1 = subscriptExprList.rbegin();
Rose_STL_Container<SgExpression*>::reverse_iterator j2 = dimExpressionPtrList.rbegin();
// Need to know current size of both current and previous dimension
SgExpression* newSubscript;
while((j1 != subscriptExprList.rend()) && (j2 != dimExpressionPtrList.rend()))
{
// get the lowerBound for each dimension
SgExpression* newDimIndex;
SgExpression* dimSize;
/*
get the dimension size at each dimension
*/
SgSubscriptExpression* subscriptExpression = isSgSubscriptExpression(*j2);
/*
This is for the 1st type of array declaration: a(10,15,20)
Fortran is 1-based array. Lowerbound is 1 by default.
*/
if(subscriptExpression == NULL)
{
dimSize = deepCopy(*j2);
}
/*
This is for the 2nd type of array declaration: a(1:10,5:15,10:20)
Actual dimension size = upperBound - lowerBound + 1
*/
else
{
dimSize = buildAddOp(buildSubtractOp(deepCopy(subscriptExpression->get_upperBound()),
deepCopy(subscriptExpression->get_lowerBound())),
buildIntVal(1));
}
// convert the 1-based subscript to 0-based subscript
newDimIndex = get0basedIndex(*j1, *j2);
if(j1 != subscriptExprList.rbegin())
{
newSubscript = buildAddOp(newDimIndex,
buildMultiplyOp(dimSize,newSubscript));
}
else
{
newSubscript = newDimIndex;
delete(dimSize);
}
++j1;
++j2;
} // end of while loop
newSubscriptExprList.push_back(newSubscript);
SgExprListExp* newSubscriptList = buildExprListExp(newSubscriptExprList);
// un-link and remove the rhs operand
pntrArrRefExp->get_rhs_operand()->set_parent(NULL);
removeList.push_back(pntrArrRefExp->get_rhs_operand());
// add the new subscriptExpression into rhs operand
pntrArrRefExp->set_rhs_operand(newSubscriptList);
newSubscriptList->set_parent(pntrArrRefExp);
} // end of arraySubscript != NULL
}
int main( int argc, char * argv[] )
{
// Option to linearize the array.
Rose_STL_Container<std::string> localCopy_argv = CommandlineProcessing::generateArgListFromArgcArgv(argc, argv);
int newArgc;
char** newArgv = NULL;
vector<string> argList = localCopy_argv;
if (CommandlineProcessing::isOption(argList,"-f2c:","linearize",true) == true)
{
isLinearlizeArray = true;
}
CommandlineProcessing::generateArgcArgvFromList(argList,newArgc, newArgv);
// Build the AST used by ROSE
SgProject* project = frontend(newArgc,newArgv);
AstTests::runAllTests(project);
if (SgProject::get_verbose() > 2)
generateAstGraph(project,8000,"_orig");
// Traversal with Memory Pool to search for variableDeclaration
variableDeclTraversal translateVariableDeclaration;
traverseMemoryPoolVisitorPattern(translateVariableDeclaration);
for(vector<SgVariableDeclaration*>::iterator dec=variableDeclList.begin(); dec!=variableDeclList.end(); ++dec)
{
/*
For the Fortran AST, a single variableDeclaration can be shared by multiple variables.
This violated the normalization rules for C unparser. Therefore, we have to transform it.
*/
SgVariableDeclaration* variableDeclaration = isSgVariableDeclaration(*dec);
ROSE_ASSERT(variableDeclaration);
if((variableDeclaration->get_variables()).size() != 1)
{
updateVariableDeclarationList(variableDeclaration);
statementList.push_back(variableDeclaration);
removeList.push_back(variableDeclaration);
}
}
// reset the vector that collects all variable declaration. We need to walk through memory pool again to find types
variableDeclList.clear();
traverseMemoryPoolVisitorPattern(translateVariableDeclaration);
for(vector<SgVariableDeclaration*>::iterator dec=variableDeclList.begin(); dec!=variableDeclList.end(); ++dec)
{
SgVariableDeclaration* variableDeclaration = isSgVariableDeclaration(*dec);
ROSE_ASSERT(variableDeclaration);
SgInitializedNamePtrList initializedNameList = variableDeclaration->get_variables();
for(SgInitializedNamePtrList::iterator i=initializedNameList.begin(); i!=initializedNameList.end();++i)
{
SgInitializedName* initiallizedName = isSgInitializedName(*i);
SgType* baseType = initiallizedName->get_type();
if(baseType->variantT() == V_SgArrayType)
{
SgArrayType* arrayBase = isSgArrayType(baseType);
// At this moment, we are still working on the Fortran-stype AST. Therefore, there is no nested types for multi-dim array.
if(arrayBase->findBaseType()->variantT() == V_SgTypeString)
{
arrayBase->reset_base_type(translateType(arrayBase->findBaseType()));
arrayBase->set_rank(arrayBase->get_rank()+1);
}
}
else
{
initiallizedName->set_type(translateType(baseType));
}
}
}
// replace the AttributeSpecificationStatement
Rose_STL_Container<SgNode*> AttributeSpecificationStatement = NodeQuery::querySubTree (project,V_SgAttributeSpecificationStatement);
for (Rose_STL_Container<SgNode*>::iterator i = AttributeSpecificationStatement.begin(); i != AttributeSpecificationStatement.end(); i++)
{
SgAttributeSpecificationStatement* attributeSpecificationStatement = isSgAttributeSpecificationStatement(*i);
ROSE_ASSERT(attributeSpecificationStatement);
translateAttributeSpecificationStatement(attributeSpecificationStatement);
statementList.push_back(attributeSpecificationStatement);
removeList.push_back(attributeSpecificationStatement);
}
// replace the parameter reference
parameterTraversal translateParameterRef;
traverseMemoryPoolVisitorPattern(translateParameterRef);
for(vector<SgVarRefExp*>::iterator i=parameterRefList.begin(); i!=parameterRefList.end(); ++i)
{
SgVarRefExp* parameterRef = isSgVarRefExp(*i);
if(parameterSymbolList.find(parameterRef->get_symbol()) != parameterSymbolList.end())
{
SgExpression* newExpr = isSgExpression(deepCopy(parameterSymbolList.find(parameterRef->get_symbol())->second));
ROSE_ASSERT(newExpr);
newExpr->set_parent(parameterRef->get_parent());
replaceExpression(parameterRef,
newExpr,
false);
}
}
/*
Parameters will be replaced by #define, all the declarations should be removed
*/
for(map<SgVariableSymbol*,SgExpression*>::iterator i=parameterSymbolList.begin();i!=parameterSymbolList.end();++i)
{
SgVariableSymbol* symbol = i->first;
SgInitializedName* initializedName = symbol->get_declaration();
SgVariableDeclaration* decl = isSgVariableDeclaration(initializedName->get_parent());
statementList.push_back(decl);
removeList.push_back(decl);
}
// Traversal with Memory Pool to search for arrayType
arrayTypeTraversal translateArrayType;
traverseMemoryPoolVisitorPattern(translateArrayType);
for(vector<SgArrayType*>::iterator i=arrayTypeList.begin(); i!=arrayTypeList.end(); ++i)
{
if(isLinearlizeArray)
{
linearizeArrayDeclaration(*i);
}
else
{
translateArrayDeclaration(*i);
}
}
// Traversal with Memory Pool to search for pntrArrRefExp
pntrArrRefTraversal translatePntrArrRefExp;
traverseMemoryPoolVisitorPattern(translatePntrArrRefExp);
for(vector<SgPntrArrRefExp*>::iterator i=pntrArrRefList.begin(); i!=pntrArrRefList.end(); ++i)
{
if(isLinearlizeArray)
{
linearizeArraySubscript(*i);
}
else
{
translateArraySubscript(*i);
}
}
Rose_STL_Container<SgNode*> functionList = NodeQuery::querySubTree (project,V_SgFunctionDeclaration);
for (Rose_STL_Container<SgNode*>::iterator i = functionList.begin(); i != functionList.end(); i++)
{
if((isSgProcedureHeaderStatement(*i) != NULL) ||
(isSgProgramHeaderStatement(*i) != NULL)){
SgFunctionDeclaration* functionBody = isSgFunctionDeclaration(*i);
bool hasReturnVal = false;
if(isSgProcedureHeaderStatement(functionBody))
{
hasReturnVal = isSgProcedureHeaderStatement(functionBody)->isFunction();
}
fixFortranSymbolTable(functionBody->get_definition(),hasReturnVal);
}
}
// Traversal with Memory Pool to search for equivalenceStatement
equivalencelTraversal translateEquivalenceStmt;
traverseMemoryPoolVisitorPattern(translateEquivalenceStmt);
for(vector<SgEquivalenceStatement*>::iterator i=equivalenceList.begin(); i!=equivalenceList.end(); ++i)
{
SgEquivalenceStatement* equivalenceStatement = isSgEquivalenceStatement(*i);
ROSE_ASSERT(equivalenceStatement);
translateEquivalenceStatement(equivalenceStatement);
statementList.push_back(equivalenceStatement);
removeList.push_back(equivalenceStatement);
}
// Simple traversal, bottom-up, to translate the rest
f2cTraversal f2c;
f2c.traverseInputFiles(project,postorder);
// removing all the unsed statement from AST
for(vector<SgStatement*>::iterator i=statementList.begin(); i!=statementList.end(); ++i)
{
removeStatement(*i);
(*i)->set_parent(NULL);
}
// deepDelete the removed nodes
for(vector<SgNode*>::iterator i=removeList.begin(); i!=removeList.end(); ++i)
{
deepDelete(*i);
}
/*
1. There should be no Fortran-specific AST nodes in the whole
AST graph after the translation.
TODO: make sure translator generating clean AST
*/
//generateDOT(*project);
if (SgProject::get_verbose() > 2)
generateAstGraph(project,8000);
return backend(project);
}