Alexander_KS/SAPFOR
4
2
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

added method for unparsing an expression in Fortran or C

Browse Source
This commit is contained in:
ALEXks
2024-04-09 10:36:46 +03:00
parent aa0a464ead
commit 82de4d6f03
7 changed files with 40 additions and 72 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
dvm/fdvm/trunk/Sage/lib/include/ext_low.h
View File

@@ -263,6 +263,7 @@ extern void updateTypeAndSymbolInStmts();
extern void updateTypesAndSymbolsInBodyOfRoutine();
extern PTR_SYMB duplicateSymbolOfRoutine();
extern char* UnparseBif_Char();
char *UnparseLLnode_Char();
extern void UnparseProgram_ThroughAllocBuffer();

1
dvm/fdvm/trunk/Sage/lib/include/extcxx_low.h
View File

@@ -267,5 +267,6 @@ extern "C" {
void updateTypesAndSymbolsInBodyOfRoutine(...);
char* UnparseBif_Char(...);
char *UnparseLLND_Char(...);
char *UnparseLLnode_Char(...);
void UnparseProgram_ThroughAllocBuffer(...);
}

6
dvm/fdvm/trunk/Sage/lib/include/libSage++.h
View File

@@ -382,6 +382,7 @@ public:
inline SgExpression &copy();
inline SgExpression *copyPtr();
char *unparse();
inline char *unparse(int lang); //0 - Fortran, 1 - C
std::string sunparse();
inline void unparsestdout();
inline SgExpression *IsSymbolInExpression(SgSymbol &symbol);
@@ -3819,6 +3820,11 @@ inline char* SgExpression::unparse()
{
return UnparseLLND_Char(thellnd);
}
// podd 08.04.24
inline char* SgExpression::unparse(int lang) //0 - Fortran, 1 - C
{
return UnparseLLnode_Char(thellnd,lang);
}
inline void SgExpression::unparsestdout()
{

23
dvm/fdvm/trunk/Sage/lib/newsrc/low_level.c
View File

@@ -1051,6 +1051,29 @@ char *UnparseBif_Char(bif,lang)
return(s);
}
/* podd 08.04.24 */
char *UnparseLLnode_Char(llnd,lang)
PTR_LLND llnd;
int lang; /* ForSrc=0 - Fortran language, CSrc=1 - C language */
{
char *s;
/* PTR_BLOB b, bl;
*/ /* podd 15.03.99*/
if (Check_Lang_Fortran(cur_proj) && lang != CSrc) /*podd 16.12.11*/
{
Init_Unparser();
s = filter(Tool_Unparse2_LLnode(llnd));
} else
{ if(lang == CSrc)
Set_Function_Language(CSrc);
Init_Unparser();
s = Tool_Unparse2_LLnode(llnd);
if(lang == CSrc)
Unset_Function_Language();
}
return(s);
}
/* Kataev N.A. 03.09.2013 base on UnparseBif_Char with change podd 16.12.11
Kataev N.A. 19.10.2013 fix
*/

69
dvm/fdvm/trunk/fdvm/acc_f2c.cpp
View File

@@ -3438,7 +3438,7 @@ SgSymbol *hasSameNameAsSource(SgSymbol *symb)
return el->lhs()->symbol();
if (el=isInUsesListByChar(symb->identifier()))
return el->lhs()->symbol();
for (el = dvm_parallel_dir->expr(2); el; el = el->rhs())
for (el = dvm_parallel_dir ? dvm_parallel_dir->expr(2) : NULL; el; el = el->rhs())
if (!strcmp(el->lhs()->symbol()->identifier(), symb->identifier()))
return el->lhs()->symbol();
reduction_operation_list *rl;
@@ -3451,69 +3451,6 @@ SgSymbol *hasSameNameAsSource(SgSymbol *symb)
}
return NULL;
}
/*
void RenamingCudaFunctionVariables(SgStatement *first, SgStatement *last, SgSymbol *k_symb)
{ // replacing kernel names to avoid conflicts with C language keywords and intrinsic function names
SgSymbol *sl;
for (sl=k_symb->next(); sl; sl=sl->next())
{
SgSymbol *s_symb = hasSameNameAsSource(sl);
if (s_symb)
{
replaceSymbInStmts(first->thebif, last->thebif, s_symb->thesymb, sl->thesymb);
ChangeSymbolName(sl);
}
}
}
void ReplacingVariablesInTranslatedCode(SgStatement *first, SgSymbol *k_symb)
{ // replacing source symbols by kernel symbols of the same name
SgSymbol *sl;
for (sl=k_symb->next(); sl; sl=sl->next())
{
if (sl->scope() != kernel_st || sl->variant() != VARIABLE_NAME)
continue;
SgSymbol *s_symb = hasSameNameAsSource(sl);
if (s_symb)
{ //printf("::: %s id:%d variant:%d\n",sl->identifier(), sl->id(), sl->variant());
//replaceSymbInStmtsSameName(first->thebif, last->thebif, s_symb->thesymb, sl->thesymb);
first->replaceSymbBySymbSameName(s_symb,sl);
}
}
}
void RenamingCudaFunctionVariables(SgStatement *first, SgStatement *first_body, SgSymbol *k_symb, int replace_flag)
{ // replacing kernel names to avoid conflicts with C language keywords and intrinsic function names
if (first_body)
ReplacingVariablesInTranslatedCode(first_body, k_symb);
for (sl=k_symb->next(); sl; sl=sl->next())
{
if (sl->scope() != kernel_st || sl->variant() != VARIABLE_NAME)
continue;
SgSymbol *s_symb = hasSameNameAsSource(sl);
if (s_symb)
{
if (replace_flag)
first->replaceSymbBySymb(s_symb,sl);
//replaceSymbInStmts(first->thebif, last->thebif, s_symb->thesymb, sl->thesymb);
ChangeSymbolName(sl);
}
}
}
int isCudaVariable(SgSymbol *symb)
{
if(!strcmp(symb->identifier(), "blocks")) return 1;
if(!strcmp(symb->identifier(), "threads")) return 1;
if(!strcmp(symb->identifier(), "threadIdx")) return 1;
if(!strcmp(symb->identifier(), "blockIdx")) return 1;
if(!strcmp(symb->identifier(), "blockDim")) return 1;
if(!strcmp(symb->identifier(), "gridDim")) return 1;
return 0;
}
*/
int sameVariableName(SgSymbol *symb1, SgSymbol *symb2)
{
@@ -3530,8 +3467,6 @@ void replaceSymbolSameNameInExpr(SgExpression *expr, SgSymbol *symb, SgSymbol *s
//SgRecordRefExp *re;
if (!expr || !symb || !s_new)
return;
//if (isSgRecordRefExp(expr)) //&& isCudaVariable(re->recordName()))
// replaceSymbolSameNameInExpr(expr->lhs(), symb, s_new);
if (expr->symbol())
if (sameVariableName(expr->symbol(), symb))
expr->setSymbol(s_new);
@@ -3567,8 +3502,6 @@ void RenamingCudaFunctionVariables(SgStatement *first, SgSymbol *k_symb, int rep
{
if (replace_flag)
replaceVariableSymbSameNameInStatements(first,first->lastNodeOfStmt(), s_symb, sl, replace_flag);
// first->replaceSymbBySymb(s_symb,sl);
//replaceSymbInStmts(first->thebif, last->thebif, s_symb->thesymb, sl->thesymb);
ChangeSymbolName(sl);
}
}

4
dvm/fdvm/trunk/fdvm/dvm.cpp
View File

@@ -9163,10 +9163,12 @@ int TestType_RTS2(SgType *type)
switch(type->variant()) {
case T_BOOL: if (len == 4) return(rt_LOGICAL);
else if(len == 2) return(rt_USHORT);
else if(len == 1) return(rt_CHAR);
else return(rt_UNKNOWN);
case T_INT: if (len == 4) return(rt_INT);
else if(len == 2) return(rt_SHORT);
else if(len == 1) return(rt_CHAR);
else return(rt_UNKNOWN);
case T_FLOAT: if (len == 8) return(rt_DOUBLE);
@@ -9194,10 +9196,12 @@ int TestType_RTS2(SgType *type)
case T_BOOL: if (len == 8) return(rt_ULONG);
else if(len == 4) return(rt_LOGICAL);
else if(len == 2) return(rt_USHORT);
else if(len == 1) return(rt_CHAR);
else return(rt_UNKNOWN);
case T_INT: if (len == 8) return(rt_LONG);
else if(len == 4) return(rt_INT);
else if(len == 2) return(rt_SHORT);
else if(len == 1) return(rt_CHAR);
else return(rt_UNKNOWN);
case T_FLOAT: if (len == 8) return(rt_DOUBLE);
else if(len == 4) return(rt_FLOAT);

2
sapfor/experts/Sapfor_2017/_src/Utils/version.h
View File

@@ -1,3 +1,3 @@
#pragma once
#define VERSION_SPF "2305"
#define VERSION_SPF "2307"