void examineInitializedName(SgInitializedName *name, ostream &out) {
SgSymbol* symbol = name->get_symbol_from_symbol_table();
if (NULL == symbol)
return;
SgType *type = symbol->get_type();
int nr_stars = 0;
stringstream ss1;
while (isSgArrayType(type) ||
isSgPointerType(type)) {
if (isSgArrayType(type)) {
SgArrayType *atype = isSgArrayType(type);
SgExpression *expr = atype->get_index();
type = atype->get_base_type();
ss1 << "[";
if (expr)
examineExpr(expr, ss1);
ss1 << "]";
} else {
SgPointerType *ttype = isSgPointerType(type);
type = ttype->get_base_type();
nr_stars++;
}
}
examinePrimTypeName(type, out);
out << " ";
for (int i = 0; i < nr_stars; ++i)
out << "*";
out << symbol->get_name().getString();
out << ss1.str();
SgInitializer *initer = name->get_initializer();
if (initer) {
switch (initer->variantT()) {
case V_SgAssignInitializer:
SgAssignInitializer *ai = isSgAssignInitializer(initer);
SgExpression *expr = ai->get_operand();
if (expr) {
out << "=";
examineExpr(expr, out);
}
break;
default:
break;
}
}
}
VariableIdTypeInfo getVariableIdTypeInfo(VariableId vid, VariableIdMapping& vidm)
{
SgSymbol* symb = vidm.getSymbol(vid); ROSE_ASSERT(symb);
SgType* sgn_type = symb->get_type();
VariableIdTypeInfo sgn_type_info;
if(isSgArrayType(sgn_type))
sgn_type_info = arrayType;
else if(isSgPointerType(sgn_type))
sgn_type_info = pointerType;
else if(isSgReferenceType(sgn_type))
sgn_type_info = referenceType;
else if(isSgClassType(sgn_type))
sgn_type_info = classType;
else
sgn_type_info = variableType;
return sgn_type_info;
}
void FortranAnalysis::visit(SgFunctionDefinition * func_def)
{
SgFunctionDeclaration * func_decl = isSgFunctionDeclaration(func_def->get_declaration());
if (func_decl == NULL) return;
SgInitializedNamePtrList func_args = func_decl->get_parameterList()->get_args();
SgInitializedNamePtrList::iterator arg = func_args.begin();
// for (it_args = func_args.begin(); it_args != func_args.end(); it_args++) {
while (arg != func_args.end()) {
SgInitializedName * func_arg = isSgInitializedName(*arg++);
SgSymbol * sym = func_def->lookup_symbol(func_arg->get_name());
SgType * type = sym->get_type();
if (sym == NULL) {
printf("FortranAnalysis::visit: no symbol for name %s\n",
func_arg->get_name().getString().c_str());
}
else if (isSgArrayType(type) != NULL) {
printf("WARNING: arg %s must be a scalar\n", func_arg->get_name().str());
sym->setAttribute("dummy_attr", new AstTextAttribute("DUMMY_ARRAY_TYPE_ARG"));
}
else if (isSgNamedType(type)) {
sym->setAttribute("dummy_attr", new AstTextAttribute("DUMMY_NAMED_TYPE_ARG"));
}
else {
sym->setAttribute("dummy_attr", new AstTextAttribute("DUMMY_ARG"));
}
if (sym != NULL && isElementalArrayType(func_arg)) {
sym->setAttribute("elemental_attr", new AstTextAttribute("ELEMENTAL_ARRAY"));
sym->setAttribute("index_attr", new AstTextAttribute("idx"));
}
if (sym != NULL && hasArrayDescriptor(func_arg)) {
sym->setAttribute("descriptor_attr", new AstTextAttribute("desc_"+func_arg->get_name()));
sym->setAttribute("index_attr", new AstTextAttribute("idx_"+func_arg->get_name()));
}
}
}
PrologCompTerm*
RoseToTerm::getVariableDeclarationSpecific(SgVariableDeclaration* d) {
ROSE_ASSERT(d != NULL);
/* add base type forward declaration */
SgNode *baseTypeDecl = NULL;
if (d->get_variableDeclarationContainsBaseTypeDefiningDeclaration()) {
baseTypeDecl = d->get_baseTypeDefiningDeclaration();
} else {
/* The complication is that in the AST, the type declaration member is
* only set if it is a type definition, not if it is a forward
* declaration. So we need to check whether the base type (possibly
* below layers of pointers) is a class type, and whether its first
* declaration appears to be hidden here in the variable declaration. */
SgClassType *ctype = isSgClassType(d->get_variables().front()
->get_type()->findBaseType());
if (ctype) {
/* See if the type is declared in the scope where it belongs. If no,
* then the declaration is apparently inside this variable
* declaration, so we add it as a subterm. */
SgDeclarationStatement *cdecl = ctype->get_declaration();
SgSymbol *symbol = cdecl->get_symbol_from_symbol_table();
if (!typeWasDeclaredBefore(
getTypeSpecific(symbol->get_type())->getRepresentation())) {
baseTypeDecl = cdecl;
}
}
}
return new PrologCompTerm
("variable_declaration_specific", //3,
getDeclarationModifierSpecific(&(d->get_declarationModifier())),
(baseTypeDecl != NULL
? traverseSingleNode(baseTypeDecl)
: new PrologAtom("null")),
PPI(d));
}
ExprSynAttr *examineVariableDeclaration(SgVariableDeclaration* decl, ostream &out) {
SgInitializedNamePtrList& name_list = decl->get_variables();
SgInitializedNamePtrList::const_iterator name_iter;
ExprSynAttr *ret = NULL;
ExprSynAttr *gc = NULL;
ret = new ExprSynAttr();
for (name_iter = name_list.begin();
name_iter != name_list.end();
name_iter++) {
SgInitializedName* name = *name_iter;
SgSymbol* symbol = name->get_symbol_from_symbol_table();
SgType *type = symbol->get_type();
int nr_stars = 0;
stringstream ss1;
while (isSgArrayType(type) ||
isSgPointerType(type)) {
if (isSgArrayType(type)) {
SgArrayType *atype = isSgArrayType(type);
SgExpression *expr = atype->get_index();
type = atype->get_base_type();
ss1 << "[";
if (expr)
examineExpr(expr, ss1);
ss1 << "]";
} else {
SgPointerType *ttype = isSgPointerType(type);
type = ttype->get_base_type();
nr_stars++;
}
}
examinePrimTypeName(type, ret->code);
ret->code << " ";
for (int i = 0; i < nr_stars; ++i)
ret->code << "*";
ret->code << symbol->get_name().getString();
ret->code << ss1.str();
ss1.str("");
SgInitializer *initer = name->get_initializer();
if (initer) {
switch (initer->variantT()) {
case V_SgAssignInitializer:
SgAssignInitializer *ai = isSgAssignInitializer(initer);
SgExpression *expr = ai->get_operand();
if (expr) {
ret->code << "=";
gc = examineExpr(expr, ret->code);
if (gc != NULL)
delete gc;
}
break;
default:
break;
}
}
/* end of this decl */
ret->code << ";";
out << ret->code.str();
return ret;
/*
cout << "[Decl] Variable (name:"<<symbol->get_name().getString();
cout << ",type:"<<symbol->get_type()->class_name();
cout << ",init:";
SgInitializer* init_expr = name->get_initializer();
if (init_expr)
cout << init_expr->class_name();
else
cout << "none";
cout << ")" << endl;
*/
}
}
void
TransformationSupport::getTransformationOptions ( SgNode* astNode, list<OptionDeclaration> & generatedList, string identifingTypeName )
{
// This function searches for variables of type ScopeBasedTransformationOptimization. Variables
// of type ScopeBasedTransformationOptimization are used to communicate optimizations from the
// application to the preprocessor. If called from a project or file object it traverses down to
// the global scope of the file and searches only the global scope, if called from and other
// location within the AST it searches the current scope and then traverses the parent nodes to
// find all enclosing scopes until in reaches the global scope. At each scope it searches for
// variables of type ScopeBasedTransformationOptimization.
// printf ("######################### START OF TRANSFORMATION OPTION QUERY ######################## \n");
ROSE_ASSERT (astNode != NULL);
ROSE_ASSERT (identifingTypeName.c_str() != NULL);
#if 0
printf ("In getTransformationOptions(): astNode->sage_class_name() = %s generatedList.size() = %d \n",
astNode->sage_class_name(),generatedList.size());
SgLocatedNode* locatedNode = isSgLocatedNode(astNode);
if (locatedNode != NULL)
{
printf (" locatedNode->get_file_info()->get_filename() = %s \n",locatedNode->get_file_info()->get_filename());
printf (" locatedNode->get_file_info()->get_line() = %d \n",locatedNode->get_file_info()->get_line());
}
#endif
switch (astNode->variant())
{
case ProjectTag:
{
SgProject* project = isSgProject(astNode);
ROSE_ASSERT (project != NULL);
//! Loop through all the files in the project and call the mainTransform function for each file
int i = 0;
for (i=0; i < project->numberOfFiles(); i++)
{
SgFile* file = &(project->get_file(i));
// printf ("Calling Query::traverse(SgFile,QueryFunctionType,QueryAssemblyFunctionType) \n");
getTransformationOptions ( file, generatedList, identifingTypeName );
}
break;
}
case SourceFileTag:
{
SgSourceFile* file = isSgSourceFile(astNode);
ROSE_ASSERT (file != NULL);
SgGlobal* globalScope = file->get_globalScope();
ROSE_ASSERT (globalScope != NULL);
ROSE_ASSERT (isSgGlobal(globalScope) != NULL);
getTransformationOptions ( globalScope, generatedList, identifingTypeName );
break;
}
// Global Scope
case GLOBAL_STMT:
{
SgGlobal* globalScope = isSgGlobal(astNode);
ROSE_ASSERT (globalScope != NULL);
SgSymbolTable* symbolTable = globalScope->get_symbol_table();
ROSE_ASSERT (symbolTable != NULL);
getTransformationOptions ( symbolTable, generatedList, identifingTypeName );
// printf ("Processed global scope, exiting .. \n");
// ROSE_ABORT();
break;
}
case SymbolTableTag:
{
// List the variable in each scope
// printf ("List all the variables in this symbol table! \n");
SgSymbolTable* symbolTable = isSgSymbolTable(astNode);
ROSE_ASSERT (symbolTable != NULL);
bool foundTransformationOptimizationSpecifier = false;
// printf ("Now print out the information in the symbol table for this scope: \n");
// symbolTable->print();
#if 0
// I don't know when a SymbolTable is given a name!
printf ("SymbolTable has a name = %s \n",
(symbolTable->get_no_name()) ? "NO: it has no name" : "YES: it does have a name");
if (!symbolTable->get_no_name())
printf ("SymbolTable name = %s \n",symbolTable->get_name().str());
else
ROSE_ASSERT (symbolTable->get_name().str() == NULL);
#endif
if (symbolTable->get_table() != NULL)
{
SgSymbolTable::hash_iterator i = symbolTable->get_table()->begin();
int counter = 0;
while (i != symbolTable->get_table()->end())
{
ROSE_ASSERT ( isSgSymbol( (*i).second ) != NULL );
// printf ("Initial info: number: %d pair.first (SgName) = %s pair.second (SgSymbol) sage_class_name() = %s \n",
// counter,(*i).first.str(),(*i).second->sage_class_name());
SgSymbol* symbol = isSgSymbol((*i).second);
ROSE_ASSERT ( symbol != NULL );
SgType* type = symbol->get_type();
ROSE_ASSERT ( type != NULL );
SgNamedType* namedType = isSgNamedType(type);
string typeName;
if (namedType != NULL)
{
SgName n = namedType->get_name();
typeName = namedType->get_name().str();
// char* nameString = namedType->get_name().str();
// printf ("Type is: (named type) = %s \n",nameString);
ROSE_ASSERT (identifingTypeName.c_str() != NULL);
// ROSE_ASSERT (typeName != NULL);
// printf ("In getTransformationOptions(): typeName = %s identifingTypeName = %s \n",typeName.c_str(),identifingTypeName.c_str());
// if ( (typeName != NULL) && ( typeName == identifingTypeName) )
if ( typeName == identifingTypeName )
{
// Now look at the parameter list to the constructor and save the
// values into the list.
// printf ("Now save the constructor arguments! \n");
SgVariableSymbol* variableSymbol = isSgVariableSymbol(symbol);
if ( variableSymbol != NULL )
{
SgInitializedName* initializedNameDeclaration = variableSymbol->get_declaration();
ROSE_ASSERT (initializedNameDeclaration != NULL);
SgDeclarationStatement* declarationStatement = initializedNameDeclaration->get_declaration();
ROSE_ASSERT (declarationStatement != NULL);
SgVariableDeclaration* variableDeclaration = isSgVariableDeclaration(declarationStatement);
ROSE_ASSERT (variableDeclaration != NULL);
getTransformationOptionsFromVariableDeclarationConstructorArguments(variableDeclaration,generatedList);
foundTransformationOptimizationSpecifier = true;
// printf ("Exiting after saving the constructor arguments! \n");
// ROSE_ABORT();
}
else
{
#if 0
printf ("Not a SgVariableSymbol: symbol->sage_class_name() = %s \n",
symbol->sage_class_name());
#endif
}
}
else
{
#if 0
printf ("typeName != identifingTypeName : symbol->sage_class_name() = %s \n",
symbol->sage_class_name());
#endif
#if 0
// I don't think this should ever be NULL (but it is sometimes)
if (typeName != NULL)
printf ("typeName == NULL \n");
#endif
}
}
else
{
typeName = (char *)type->sage_class_name();
}
// printf ("In while loop at the base: counter = %d \n",counter);
i++;
counter++;
}
}
else
{
// printf ("Pointer to symbol table is NULL \n");
}
// printf ("foundTransformationOptimizationSpecifier = %s \n",foundTransformationOptimizationSpecifier ? "true" : "false");
// SgSymbolTable objects don't have a parent node (specifically they lack a get_parent
// member function in the interface)!
break;
}
case BASIC_BLOCK_STMT:
{
// List the variable in each scope
// printf ("List all the variables in this scope! \n");
SgBasicBlock* basicBlock = isSgBasicBlock(astNode);
ROSE_ASSERT (basicBlock != NULL);
SgSymbolTable* symbolTable = basicBlock->get_symbol_table();
ROSE_ASSERT (symbolTable != NULL);
getTransformationOptions ( symbolTable, generatedList, identifingTypeName );
// Next go (fall through this case) to the default case so that we traverse the parent
// of the SgBasicBlock.
// break;
}
default:
// Most cases will be the default (this is by design)
// printf ("default in switch found in globalQueryGetListOperandStringFunction() (sage_class_name = %s) \n",astNode->sage_class_name());
// Need to recursively backtrack through the parents until we reach the SgGlobal (global scope)
SgStatement* statement = isSgStatement(astNode);
if (statement != NULL)
{
SgNode* parentNode = statement->get_parent();
ROSE_ASSERT (parentNode != NULL);
// printf ("parent = %p parentNode->sage_class_name() = %s \n",parentNode,parentNode->sage_class_name());
SgStatement* parentStatement = isSgStatement(parentNode);
if (parentStatement == NULL)
{
printf ("parentStatement == NULL: statement (%p) is a %s \n",statement,statement->sage_class_name());
printf ("parentStatement == NULL: statement->get_file_info()->get_filename() = %s \n",statement->get_file_info()->get_filename());
printf ("parentStatement == NULL: statement->get_file_info()->get_line() = %d \n",statement->get_file_info()->get_line());
}
ROSE_ASSERT (parentStatement != NULL);
// Call this function recursively (directly rather than through the query mechanism)
getTransformationOptions ( parentStatement, generatedList, identifingTypeName );
}
else
{
// printf ("astNode is not a SgStatement! \n");
}
break;
}
#if 0
printf ("At BASE of getTransformationOptions(): astNode->sage_class_name() = %s size of generatedList = %d \n",
astNode->sage_class_name(),generatedList.size());
#endif
// printf ("######################### END OF TRANSFORMATION OPTION QUERY ######################## \n");
}