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