added method for unparsing an expression in Fortran or C

dvm/fdvm/trunk/Sage/lib/include/ext_low.h

@@ -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();
 
 

dvm/fdvm/trunk/Sage/lib/include/extcxx_low.h

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

dvm/fdvm/trunk/Sage/lib/include/libSage++.h

@@ -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()
 { 

dvm/fdvm/trunk/Sage/lib/newsrc/low_level.c

@@ -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
 */

dvm/fdvm/trunk/fdvm/acc_f2c.cpp

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

dvm/fdvm/trunk/fdvm/dvm.cpp

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

sapfor/experts/Sapfor_2017/_src/Utils/version.h

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